|
version 1.1250, 2016/07/18 19:28:58
|
version 1.1297, 2017/10/13 20:37:35
|
|
Line 71 use Apache::lonuserutils();
|
Line 71 use Apache::lonuserutils();
|
| use Apache::lonuserstate(); |
use Apache::lonuserstate(); |
| use Apache::courseclassifier(); |
use Apache::courseclassifier(); |
| use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
| |
use LONCAPA::LWPReq; |
| use DateTime::TimeZone; |
use DateTime::TimeZone; |
| use DateTime::Locale; |
use DateTime::Locale; |
| use Encode(); |
use Encode(); |
|
Line 83 use Crypt::DES;
|
Line 84 use Crypt::DES;
|
| use DynaLoader; # for Crypt::DES version |
use DynaLoader; # for Crypt::DES version |
| use MIME::Lite; |
use MIME::Lite; |
| use MIME::Types; |
use MIME::Types; |
| |
use File::Copy(); |
| |
use File::Path::Tiny(); |
| |
|
| # ---------------------------------------------- Designs |
# ---------------------------------------------- Designs |
| use vars qw(%defaultdesign); |
use vars qw(%defaultdesign); |
|
Line 267 BEGIN {
|
Line 270 BEGIN {
|
| next if ($line =~ /^\#/); |
next if ($line =~ /^\#/); |
| chomp($line); |
chomp($line); |
| my ($extension,$category)=(split(/\s+/,$line,2)); |
my ($extension,$category)=(split(/\s+/,$line,2)); |
| push @{$category_extensions{lc($category)}},$extension; |
push(@{$category_extensions{lc($category)}},$extension); |
| } |
} |
| close($fh); |
close($fh); |
| } |
} |
|
Line 943 ENDSCRT
|
Line 946 ENDSCRT
|
| } |
} |
| |
|
| sub select_timezone { |
sub select_timezone { |
| my ($name,$selected,$onchange,$includeempty)=@_; |
my ($name,$selected,$onchange,$includeempty,$disabled)=@_; |
| my $output='<select name="'.$name.'" '.$onchange.'>'."\n"; |
my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n"; |
| if ($includeempty) { |
if ($includeempty) { |
| $output .= '<option value=""'; |
$output .= '<option value=""'; |
| if (($selected eq '') || ($selected eq 'local')) { |
if (($selected eq '') || ($selected eq 'local')) { |
|
Line 965 sub select_timezone {
|
Line 968 sub select_timezone {
|
| } |
} |
| |
|
| sub select_datelocale { |
sub select_datelocale { |
| my ($name,$selected,$onchange,$includeempty)=@_; |
my ($name,$selected,$onchange,$includeempty,$disabled)=@_; |
| my $output='<select name="'.$name.'" '.$onchange.'>'."\n"; |
my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n"; |
| if ($includeempty) { |
if ($includeempty) { |
| $output .= '<option value=""'; |
$output .= '<option value=""'; |
| if ($selected eq '') { |
if ($selected eq '') { |
|
Line 1018 sub select_datelocale {
|
Line 1021 sub select_datelocale {
|
| } |
} |
| |
|
| sub select_language { |
sub select_language { |
| my ($name,$selected,$includeempty) = @_; |
my ($name,$selected,$includeempty,$noedit) = @_; |
| my %langchoices; |
my %langchoices; |
| if ($includeempty) { |
if ($includeempty) { |
| %langchoices = ('' => 'No language preference'); |
%langchoices = ('' => 'No language preference'); |
|
Line 1030 sub select_language {
|
Line 1033 sub select_language {
|
| } |
} |
| } |
} |
| %langchoices = &Apache::lonlocal::texthash(%langchoices); |
%langchoices = &Apache::lonlocal::texthash(%langchoices); |
| return &select_form($selected,$name,\%langchoices); |
return &select_form($selected,$name,\%langchoices,undef,$noedit); |
| } |
} |
| |
|
| =pod |
=pod |
|
Line 1054 sub list_languages {
|
Line 1057 sub list_languages {
|
| if ($code) { |
if ($code) { |
| my $selector = $supported_codes{$id}; |
my $selector = $supported_codes{$id}; |
| my $description = &plainlanguagedescription($id); |
my $description = &plainlanguagedescription($id); |
| push (@lang_choices, [$selector, $description]); |
push(@lang_choices, [$selector, $description]); |
| } |
} |
| } |
} |
| return \@lang_choices; |
return \@lang_choices; |
|
Line 1176 sub linked_select_forms {
|
Line 1179 sub linked_select_forms {
|
| $result.="select2data${suffix}['d_$s1'].texts = new Array("; |
$result.="select2data${suffix}['d_$s1'].texts = new Array("; |
| my @s2texts; |
my @s2texts; |
| foreach my $value (@s2values) { |
foreach my $value (@s2values) { |
| push @s2texts, $hashref->{$s1}->{'select2'}->{$value}; |
push(@s2texts, $hashref->{$s1}->{'select2'}->{$value}); |
| } |
} |
| $result.="\"@s2texts\");\n"; |
$result.="\"@s2texts\");\n"; |
| } |
} |
|
Line 2185 sub crsauthor_url {
|
Line 2188 sub crsauthor_url {
|
| } |
} |
| |
|
| sub import_crsauthor_form { |
sub import_crsauthor_form { |
| my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix) = @_; |
my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_; |
| return (0) unless ($env{'request.course.id'}); |
return (0) unless ($env{'request.course.id'}); |
| my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; |
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; |
| my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
|
Line 2476 sub create_text_file {
|
Line 2479 sub create_text_file {
|
| # ------------------------------------------ |
# ------------------------------------------ |
| |
|
| sub domain_select { |
sub domain_select { |
| my ($name,$value,$multiple)=@_; |
my ($name,$value,$multiple,$incdoms,$excdoms)=@_; |
| |
my @possdoms; |
| |
if (ref($incdoms) eq 'ARRAY') { |
| |
@possdoms = @{$incdoms}; |
| |
} else { |
| |
@possdoms = &Apache::lonnet::all_domains(); |
| |
} |
| |
|
| my %domains=map { |
my %domains=map { |
| $_ => $_.' '. &Apache::lonnet::domain($_,'description') |
$_ => $_.' '. &Apache::lonnet::domain($_,'description') |
| } &Apache::lonnet::all_domains(); |
} @possdoms; |
| |
|
| |
if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) { |
| |
foreach my $dom (@{$excdoms}) { |
| |
delete($domains{$dom}); |
| |
} |
| |
} |
| |
|
| if ($multiple) { |
if ($multiple) { |
| $domains{''}=&mt('Any domain'); |
$domains{''}=&mt('Any domain'); |
| $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))]; |
$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))]; |
|
Line 2548 sub multiple_select_form {
|
Line 2565 sub multiple_select_form {
|
| |
|
| =pod |
=pod |
| |
|
| =item * &select_form($defdom,$name,$hashref,$onchange) |
=item * &select_form($defdom,$name,$hashref,$onchange,$readonly) |
| |
|
| Returns a string containing a <select name='$name' size='1'> form to |
Returns a string containing a <select name='$name' size='1'> form to |
| allow a user to select options from a ref to a hash containing: |
allow a user to select options from a ref to a hash containing: |
| option_name => displayed text. An optional $onchange can include |
option_name => displayed text. An optional $onchange can include |
| a javascript onchange item, e.g., onchange="this.form.submit();" |
a javascript onchange item, e.g., onchange="this.form.submit();". |
| |
An optional arg -- $readonly -- if true will cause the select form |
| |
to be disabled, e.g., for the case where an instructor has a section- |
| |
specific role, and is viewing/modifying parameters. |
| |
|
| See lonrights.pm for an example invocation and use. |
See lonrights.pm for an example invocation and use. |
| |
|
|
Line 2739 sub select_level_form {
|
Line 2759 sub select_level_form {
|
| |
|
| =pod |
=pod |
| |
|
| =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) |
=item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) |
| |
|
| Returns a string containing a <select name='$name' size='1'> form to |
Returns a string containing a <select name='$name' size='1'> form to |
| allow a user to select the domain to preform an operation in. |
allow a user to select the domain to preform an operation in. |
|
Line 2756 The optional $incdoms is a reference to
|
Line 2776 The optional $incdoms is a reference to
|
| |
|
| The optional $excdoms is a reference to an array of domains which will be excluded from the available options. |
The optional $excdoms is a reference to an array of domains which will be excluded from the available options. |
| |
|
| |
The optional $disabled argument, if true, adds the disabled attribute to the select tag. |
| |
|
| =cut |
=cut |
| |
|
| #------------------------------------------- |
#------------------------------------------- |
| sub select_dom_form { |
sub select_dom_form { |
| my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_; |
my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_; |
| if ($onchange) { |
if ($onchange) { |
| $onchange = ' onchange="'.$onchange.'"'; |
$onchange = ' onchange="'.$onchange.'"'; |
| } |
} |
| |
if ($disabled) { |
| |
$disabled = ' disabled="disabled"'; |
| |
} |
| my (@domains,%exclude); |
my (@domains,%exclude); |
| if (ref($incdoms) eq 'ARRAY') { |
if (ref($incdoms) eq 'ARRAY') { |
| @domains = sort {lc($a) cmp lc($b)} (@{$incdoms}); |
@domains = sort {lc($a) cmp lc($b)} (@{$incdoms}); |
|
Line 2774 sub select_dom_form {
|
Line 2799 sub select_dom_form {
|
| if (ref($excdoms) eq 'ARRAY') { |
if (ref($excdoms) eq 'ARRAY') { |
| map { $exclude{$_} = 1; } @{$excdoms}; |
map { $exclude{$_} = 1; } @{$excdoms}; |
| } |
} |
| my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n"; |
my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n"; |
| foreach my $dom (@domains) { |
foreach my $dom (@domains) { |
| next if ($exclude{$dom}); |
next if ($exclude{$dom}); |
| $selectdomain.="<option value=\"$dom\" ". |
$selectdomain.="<option value=\"$dom\" ". |
|
Line 3150 sub authform_kerberos {
|
Line 3175 sub authform_kerberos {
|
| @_, |
@_, |
| ); |
); |
| my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype, |
my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype, |
| $autharg,$jscall); |
$autharg,$jscall,$disabled); |
| my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); |
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); |
| if ($in{'kerb_def_auth'} eq 'krb5') { |
if ($in{'kerb_def_auth'} eq 'krb5') { |
| $check5 = ' checked="checked"'; |
$check5 = ' checked="checked"'; |
| } else { |
} else { |
| $check4 = ' checked="checked"'; |
$check4 = ' checked="checked"'; |
| } |
} |
| |
if ($in{'readonly'}) { |
| |
$disabled = ' disabled="disabled"'; |
| |
} |
| $krbarg = $in{'kerb_def_dom'}; |
$krbarg = $in{'kerb_def_dom'}; |
| if (defined($in{'curr_authtype'})) { |
if (defined($in{'curr_authtype'})) { |
| if ($in{'curr_authtype'} eq 'krb') { |
if ($in{'curr_authtype'} eq 'krb') { |
|
Line 3201 sub authform_kerberos {
|
Line 3229 sub authform_kerberos {
|
| if (defined($in{'mode'})) { |
if (defined($in{'mode'})) { |
| if ($in{'mode'} eq 'modifycourse') { |
if ($in{'mode'} eq 'modifycourse') { |
| if ($authnum == 1) { |
if ($authnum == 1) { |
| $authtype = '<input type="radio" name="login" value="krb" />'; |
$authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />'; |
| } |
} |
| } |
} |
| } |
} |
|
Line 3210 sub authform_kerberos {
|
Line 3238 sub authform_kerberos {
|
| if ($authtype eq '') { |
if ($authtype eq '') { |
| $authtype = '<input type="radio" name="login" value="krb" '. |
$authtype = '<input type="radio" name="login" value="krb" '. |
| 'onclick="'.$jscall.'" onchange="'.$jscall.'"'. |
'onclick="'.$jscall.'" onchange="'.$jscall.'"'. |
| $krbcheck.' />'; |
$krbcheck.$disabled.' />'; |
| } |
} |
| if (($can_assign{'krb4'} && $can_assign{'krb5'}) || |
if (($can_assign{'krb4'} && $can_assign{'krb5'}) || |
| ($can_assign{'krb4'} && !$can_assign{'krb5'} && |
($can_assign{'krb4'} && !$can_assign{'krb5'} && |
|
Line 3223 sub authform_kerberos {
|
Line 3251 sub authform_kerberos {
|
| '<label>'.$authtype, |
'<label>'.$authtype, |
| '</label><input type="text" size="10" name="krbarg" '. |
'</label><input type="text" size="10" name="krbarg" '. |
| 'value="'.$krbarg.'" '. |
'value="'.$krbarg.'" '. |
| 'onchange="'.$jscall.'" />', |
'onchange="'.$jscall.'"'.$disabled.' />', |
| '<label><input type="radio" name="krbver" value="4" '.$check4.' />', |
'<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />', |
| '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />', |
'</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />', |
| '</label>'); |
'</label>'); |
| } elsif ($can_assign{'krb4'}) { |
} elsif ($can_assign{'krb4'}) { |
| $result .= &mt |
$result .= &mt |
|
Line 3234 sub authform_kerberos {
|
Line 3262 sub authform_kerberos {
|
| '<label>'.$authtype, |
'<label>'.$authtype, |
| '</label><input type="text" size="10" name="krbarg" '. |
'</label><input type="text" size="10" name="krbarg" '. |
| 'value="'.$krbarg.'" '. |
'value="'.$krbarg.'" '. |
| 'onchange="'.$jscall.'" />', |
'onchange="'.$jscall.'"'.$disabled.' />', |
| '<label><input type="hidden" name="krbver" value="4" />', |
'<label><input type="hidden" name="krbver" value="4" />', |
| '</label>'); |
'</label>'); |
| } elsif ($can_assign{'krb5'}) { |
} elsif ($can_assign{'krb5'}) { |
|
Line 3244 sub authform_kerberos {
|
Line 3272 sub authform_kerberos {
|
| '<label>'.$authtype, |
'<label>'.$authtype, |
| '</label><input type="text" size="10" name="krbarg" '. |
'</label><input type="text" size="10" name="krbarg" '. |
| 'value="'.$krbarg.'" '. |
'value="'.$krbarg.'" '. |
| 'onchange="'.$jscall.'" />', |
'onchange="'.$jscall.'"'.$disabled.' />', |
| '<label><input type="hidden" name="krbver" value="5" />', |
'<label><input type="hidden" name="krbver" value="5" />', |
| '</label>'); |
'</label>'); |
| } |
} |
|
Line 3257 sub authform_internal {
|
Line 3285 sub authform_internal {
|
| kerb_def_dom => 'MSU.EDU', |
kerb_def_dom => 'MSU.EDU', |
| @_, |
@_, |
| ); |
); |
| my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall); |
my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled); |
| my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); |
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); |
| |
if ($in{'readonly'}) { |
| |
$disabled = ' disabled="disabled"'; |
| |
} |
| if (defined($in{'curr_authtype'})) { |
if (defined($in{'curr_authtype'})) { |
| if ($in{'curr_authtype'} eq 'int') { |
if ($in{'curr_authtype'} eq 'int') { |
| if ($can_assign{'int'}) { |
if ($can_assign{'int'}) { |
|
Line 3287 sub authform_internal {
|
Line 3318 sub authform_internal {
|
| if (defined($in{'mode'})) { |
if (defined($in{'mode'})) { |
| if ($in{'mode'} eq 'modifycourse') { |
if ($in{'mode'} eq 'modifycourse') { |
| if ($authnum == 1) { |
if ($authnum == 1) { |
| $authtype = '<input type="radio" name="login" value="int" />'; |
$authtype = '<input type="radio" name="login" value="int"'.$disabled.' />'; |
| } |
} |
| } |
} |
| } |
} |
|
Line 3295 sub authform_internal {
|
Line 3326 sub authform_internal {
|
| $jscall = "javascript:changed_radio('int',$in{'formname'});"; |
$jscall = "javascript:changed_radio('int',$in{'formname'});"; |
| if ($authtype eq '') { |
if ($authtype eq '') { |
| $authtype = '<input type="radio" name="login" value="int" '.$intcheck. |
$authtype = '<input type="radio" name="login" value="int" '.$intcheck. |
| ' onchange="'.$jscall.'" onclick="'.$jscall.'" />'; |
' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />'; |
| } |
} |
| $autharg = '<input type="password" size="10" name="intarg" value="'. |
$autharg = '<input type="password" size="10" name="intarg" value="'. |
| $intarg.'" onchange="'.$jscall.'" />'; |
$intarg.'" onchange="'.$jscall.'"'.$disabled.' />'; |
| $result = &mt |
$result = &mt |
| ('[_1] Internally authenticated (with initial password [_2])', |
('[_1] Internally authenticated (with initial password [_2])', |
| '<label>'.$authtype,'</label>'.$autharg); |
'<label>'.$authtype,'</label>'.$autharg); |
| $result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>'; |
$result.='<label><input type="checkbox" name="visible" onclick="if (this.checked) { this.form.intarg.type='."'text'".' } else { this.form.intarg.type='."'password'".' }"'.$disabled.' />'.&mt('Visible input').'</label>'; |
| return $result; |
return $result; |
| } |
} |
| |
|
|
Line 3312 sub authform_local {
|
Line 3343 sub authform_local {
|
| kerb_def_dom => 'MSU.EDU', |
kerb_def_dom => 'MSU.EDU', |
| @_, |
@_, |
| ); |
); |
| my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall); |
my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled); |
| my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); |
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); |
| |
if ($in{'readonly'}) { |
| |
$disabled = ' disabled="disabled"'; |
| |
} |
| if (defined($in{'curr_authtype'})) { |
if (defined($in{'curr_authtype'})) { |
| if ($in{'curr_authtype'} eq 'loc') { |
if ($in{'curr_authtype'} eq 'loc') { |
| if ($can_assign{'loc'}) { |
if ($can_assign{'loc'}) { |
|
Line 3342 sub authform_local {
|
Line 3376 sub authform_local {
|
| if (defined($in{'mode'})) { |
if (defined($in{'mode'})) { |
| if ($in{'mode'} eq 'modifycourse') { |
if ($in{'mode'} eq 'modifycourse') { |
| if ($authnum == 1) { |
if ($authnum == 1) { |
| $authtype = '<input type="radio" name="login" value="loc" />'; |
$authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />'; |
| } |
} |
| } |
} |
| } |
} |
|
Line 3351 sub authform_local {
|
Line 3385 sub authform_local {
|
| if ($authtype eq '') { |
if ($authtype eq '') { |
| $authtype = '<input type="radio" name="login" value="loc" '. |
$authtype = '<input type="radio" name="login" value="loc" '. |
| $loccheck.' onchange="'.$jscall.'" onclick="'. |
$loccheck.' onchange="'.$jscall.'" onclick="'. |
| $jscall.'" />'; |
$jscall.'"'.$disabled.' />'; |
| } |
} |
| $autharg = '<input type="text" size="10" name="locarg" value="'. |
$autharg = '<input type="text" size="10" name="locarg" value="'. |
| $locarg.'" onchange="'.$jscall.'" />'; |
$locarg.'" onchange="'.$jscall.'"'.$disabled.' />'; |
| $result = &mt('[_1] Local Authentication with argument [_2]', |
$result = &mt('[_1] Local Authentication with argument [_2]', |
| '<label>'.$authtype,'</label>'.$autharg); |
'<label>'.$authtype,'</label>'.$autharg); |
| return $result; |
return $result; |
|
Line 3366 sub authform_filesystem {
|
Line 3400 sub authform_filesystem {
|
| kerb_def_dom => 'MSU.EDU', |
kerb_def_dom => 'MSU.EDU', |
| @_, |
@_, |
| ); |
); |
| my ($fsyscheck,$result,$authtype,$autharg,$jscall); |
my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled); |
| my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); |
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); |
| |
if ($in{'readonly'}) { |
| |
$disabled = ' disabled="disabled"'; |
| |
} |
| if (defined($in{'curr_authtype'})) { |
if (defined($in{'curr_authtype'})) { |
| if ($in{'curr_authtype'} eq 'fsys') { |
if ($in{'curr_authtype'} eq 'fsys') { |
| if ($can_assign{'fsys'}) { |
if ($can_assign{'fsys'}) { |
|
Line 3380 sub authform_filesystem {
|
Line 3417 sub authform_filesystem {
|
| } else { |
} else { |
| $result = &mt('Currently Filesystem Authenticated.'); |
$result = &mt('Currently Filesystem Authenticated.'); |
| return $result; |
return $result; |
| } |
} |
| } |
} |
| } else { |
} else { |
| if ($authnum == 1) { |
if ($authnum == 1) { |
|
Line 3393 sub authform_filesystem {
|
Line 3430 sub authform_filesystem {
|
| if (defined($in{'mode'})) { |
if (defined($in{'mode'})) { |
| if ($in{'mode'} eq 'modifycourse') { |
if ($in{'mode'} eq 'modifycourse') { |
| if ($authnum == 1) { |
if ($authnum == 1) { |
| $authtype = '<input type="radio" name="login" value="fsys" />'; |
$authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />'; |
| } |
} |
| } |
} |
| } |
} |
|
Line 3402 sub authform_filesystem {
|
Line 3439 sub authform_filesystem {
|
| if ($authtype eq '') { |
if ($authtype eq '') { |
| $authtype = '<input type="radio" name="login" value="fsys" '. |
$authtype = '<input type="radio" name="login" value="fsys" '. |
| $fsyscheck.' onchange="'.$jscall.'" onclick="'. |
$fsyscheck.' onchange="'.$jscall.'" onclick="'. |
| $jscall.'" />'; |
$jscall.'"'.$disabled.' />'; |
| } |
} |
| $autharg = '<input type="text" size="10" name="fsysarg" value=""'. |
$autharg = '<input type="text" size="10" name="fsysarg" value=""'. |
| ' onchange="'.$jscall.'" />'; |
' onchange="'.$jscall.'"'.$disabled.' />'; |
| $result = &mt |
$result = &mt |
| ('[_1] Filesystem Authenticated (with initial password [_2])', |
('[_1] Filesystem Authenticated (with initial password [_2])', |
| '<label><input type="radio" name="login" value="fsys" '. |
'<label><input type="radio" name="login" value="fsys" '. |
| $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />', |
$fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />', |
| '</label><input type="password" size="10" name="fsysarg" value="" '. |
'</label><input type="password" size="10" name="fsysarg" value="" '. |
| 'onchange="'.$jscall.'" />'); |
'onchange="'.$jscall.'"'.$disabled.' />'); |
| return $result; |
return $result; |
| } |
} |
| |
|
|
Line 3433 sub get_assignable_auth {
|
Line 3470 sub get_assignable_auth {
|
| my $context; |
my $context; |
| if ($env{'request.role'} =~ /^au/) { |
if ($env{'request.role'} =~ /^au/) { |
| $context = 'author'; |
$context = 'author'; |
| } elsif ($env{'request.role'} =~ /^dc/) { |
} elsif ($env{'request.role'} =~ /^(dc|dh)/) { |
| $context = 'domain'; |
$context = 'domain'; |
| } elsif ($env{'request.course.id'}) { |
} elsif ($env{'request.course.id'}) { |
| $context = 'course'; |
$context = 'course'; |
|
Line 4971 sub blockcheck {
|
Line 5008 sub blockcheck {
|
| # boards, chat or groups, check for blocking in current course only. |
# boards, chat or groups, check for blocking in current course only. |
| |
|
| if (($activity eq 'boards' || $activity eq 'chat' || |
if (($activity eq 'boards' || $activity eq 'chat' || |
| $activity eq 'groups' || $activity eq 'printout') && |
$activity eq 'groups' || $activity eq 'printout' || |
| |
$activity eq 'reinit' || $activity eq 'alert') && |
| ($env{'request.course.id'})) { |
($env{'request.course.id'})) { |
| foreach my $key (keys(%live_courses)) { |
foreach my $key (keys(%live_courses)) { |
| if ($key ne $env{'request.course.id'}) { |
if ($key ne $env{'request.course.id'}) { |
|
Line 5055 sub blockcheck {
|
Line 5093 sub blockcheck {
|
| $tdom,$spec,$trest,$area); |
$tdom,$spec,$trest,$area); |
| } |
} |
| } |
} |
| my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles); |
my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles); |
| if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) { |
if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) { |
| if ($1) { |
if ($1) { |
| $no_userblock = 1; |
$no_userblock = 1; |
|
Line 5079 sub blockcheck {
|
Line 5117 sub blockcheck {
|
| |
|
| # Retrieve blocking times and identity of locker for course |
# Retrieve blocking times and identity of locker for course |
| # of specified user, unless user has 'evb' privilege. |
# of specified user, unless user has 'evb' privilege. |
| |
|
| my ($start,$end,$trigger) = |
my ($start,$end,$trigger) = |
| &get_blocks($setters,$activity,$cdom,$cnum,$url); |
&get_blocks($setters,$activity,$cdom,$cnum,$url); |
| if (($start != 0) && |
if (($start != 0) && |
|
Line 5166 sub get_blocks {
|
Line 5204 sub get_blocks {
|
| my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; |
my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; |
| if ($start && $end) { |
if ($start && $end) { |
| if (($start <= time) && ($end >= time)) { |
if (($start <= time) && ($end >= time)) { |
| unless (grep(/^\Q$block\E$/,@blockers)) { |
if (ref($commblocks{$block}) eq 'HASH') { |
| push(@blockers,$block); |
if (ref($commblocks{$block}{'blocks'}) eq 'HASH') { |
| $triggered{$block} = { |
if ($commblocks{$block}{'blocks'}{$activity} eq 'on') { |
| start => $start, |
unless(grep(/^\Q$block\E$/,@blockers)) { |
| end => $end, |
push(@blockers,$block); |
| type => $type, |
$triggered{$block} = { |
| }; |
start => $start, |
| |
end => $end, |
| |
type => $type, |
| |
}; |
| |
} |
| |
} |
| |
} |
| } |
} |
| } |
} |
| } |
} |
|
Line 5282 END_MYBLOCK
|
Line 5326 END_MYBLOCK
|
| $text = &mt('Printing Blocked'); |
$text = &mt('Printing Blocked'); |
| } elsif ($activity eq 'passwd') { |
} elsif ($activity eq 'passwd') { |
| $text = &mt('Password Changing Blocked'); |
$text = &mt('Password Changing Blocked'); |
| |
} elsif ($activity eq 'alert') { |
| |
$text = &mt('Checking Critical Messages Blocked'); |
| |
} elsif ($activity eq 'reinit') { |
| |
$text = &mt('Checking Course Update Blocked'); |
| } |
} |
| $output .= <<"END_BLOCK"; |
$output .= <<"END_BLOCK"; |
| <div class='$class'> |
<div class='$class'> |
|
Line 5306 sub check_ip_acc {
|
Line 5354 sub check_ip_acc {
|
| return 1; |
return 1; |
| } |
} |
| my $allowed; |
my $allowed; |
| my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip; |
my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'}; |
| |
|
| my $name; |
my $name; |
| my %access = ( |
my %access = ( |
|
Line 5789 Inputs:
|
Line 5837 Inputs:
|
| |
|
| =item * $args, optional argument valid values are |
=item * $args, optional argument valid values are |
| no_auto_mt_title -> prevents &mt()ing the title arg |
no_auto_mt_title -> prevents &mt()ing the title arg |
| |
use_absolute -> for external resource or syllabus, this will |
| |
contain https://<hostname> if server uses |
| |
https (as per hosts.tab), but request is for http |
| |
hostname -> hostname, from $r->hostname(). |
| |
|
| =item * $advtoolsref, optional argument, ref to an array containing |
=item * $advtoolsref, optional argument, ref to an array containing |
| inlineremote items to be added in "Functions" menu below |
inlineremote items to be added in "Functions" menu below |
|
Line 5814 sub bodytag {
|
Line 5866 sub bodytag {
|
| } |
} |
| if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); } |
if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); } |
| my $httphost = $args->{'use_absolute'}; |
my $httphost = $args->{'use_absolute'}; |
| |
my $hostname = $args->{'hostname'}; |
| |
|
| $function = &get_users_function() if (!$function); |
$function = &get_users_function() if (!$function); |
| my $img = &designparm($function.'.img',$domain); |
my $img = &designparm($function.'.img',$domain); |
|
Line 5841 sub bodytag {
|
Line 5894 sub bodytag {
|
| if ($env{'request.course.id'}) { |
if ($env{'request.course.id'}) { |
| if ($env{'request.role'} !~ /^cr/) { |
if ($env{'request.role'} !~ /^cr/) { |
| $role = &Apache::lonnet::plaintext($role,&course_type()); |
$role = &Apache::lonnet::plaintext($role,&course_type()); |
| |
} elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) { |
| |
if ($env{'request.role.desc'}) { |
| |
$role = $env{'request.role.desc'}; |
| |
} else { |
| |
$role = &mt('Helpdesk[_1]',' '.$2); |
| |
} |
| |
} else { |
| |
$role = (split(/\//,$role,4))[-1]; |
| } |
} |
| if ($env{'request.course.sec'}) { |
if ($env{'request.course.sec'}) { |
| $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'}; |
$role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'}; |
|
Line 5934 sub bodytag {
|
Line 5995 sub bodytag {
|
| $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); |
$bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); |
| if ($env{'request.state'} eq 'construct') { |
if ($env{'request.state'} eq 'construct') { |
| $bodytag .= &Apache::lonmenu::innerregister($forcereg, |
$bodytag .= &Apache::lonmenu::innerregister($forcereg, |
| $args->{'bread_crumbs'}); |
$args->{'bread_crumbs'},'','',$hostname); |
| } elsif ($forcereg) { |
} elsif ($forcereg) { |
| $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef, |
$bodytag .= &Apache::lonmenu::innerregister($forcereg,undef, |
| $args->{'group'}); |
$args->{'group'}, |
| |
$args->{'hide_buttons'}, |
| |
$hostname); |
| } else { |
} else { |
| $bodytag .= |
$bodytag .= |
| &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, |
&Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, |
| $forcereg,$args->{'group'}, |
$forcereg,$args->{'group'}, |
| $args->{'bread_crumbs'}, |
$args->{'bread_crumbs'}, |
| $advtoolsref); |
$advtoolsref,'',$hostname); |
| } |
} |
| }else{ |
}else{ |
| # this is to seperate menu from content when there's no secondary |
# this is to seperate menu from content when there's no secondary |
|
Line 6405 td.LC_menubuttons_text {
|
Line 6468 td.LC_menubuttons_text {
|
| background: $tabbg; |
background: $tabbg; |
| } |
} |
| |
|
| |
td.LC_zero_height { |
| |
line-height: 0; |
| |
cellpadding: 0; |
| |
} |
| |
|
| table.LC_data_table { |
table.LC_data_table { |
| border: 1px solid #000000; |
border: 1px solid #000000; |
| border-collapse: separate; |
border-collapse: separate; |
|
Line 6726 td.LC_parm_overview_restrictions {
|
Line 6794 td.LC_parm_overview_restrictions {
|
| border-collapse: collapse; |
border-collapse: collapse; |
| } |
} |
| |
|
| |
span.LC_parm_recursive, |
| |
td.LC_parm_recursive { |
| |
font-weight: bold; |
| |
font-size: smaller; |
| |
} |
| |
|
| table.LC_parm_overview_restrictions td { |
table.LC_parm_overview_restrictions td { |
| border-width: 1px 4px 1px 4px; |
border-width: 1px 4px 1px 4px; |
| border-style: solid; |
border-style: solid; |
|
Line 7077 table.LC_data_table tr > td.LC_docs_entr
|
Line 7151 table.LC_data_table tr > td.LC_docs_entr
|
| color: #990000; |
color: #990000; |
| } |
} |
| |
|
| |
.LC_docs_alias { |
| |
color: #440055; |
| |
} |
| |
|
| |
.LC_domprefs_email, |
| |
.LC_docs_alias_name, |
| .LC_docs_reinit_warn, |
.LC_docs_reinit_warn, |
| .LC_docs_ext_edit { |
.LC_docs_ext_edit { |
| font-size: x-small; |
font-size: x-small; |
|
Line 8097 section.role-warning>h1:before {
|
Line 8177 section.role-warning>h1:before {
|
| content:url('/adm/daxe/images/section_icons/warning.png'); |
content:url('/adm/daxe/images/section_icons/warning.png'); |
| } |
} |
| |
|
| |
#LC_minitab_header { |
| |
float:left; |
| |
width:100%; |
| |
background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom; |
| |
font-size:93%; |
| |
line-height:normal; |
| |
margin: 0.5em 0 0.5em 0; |
| |
} |
| |
#LC_minitab_header ul { |
| |
margin:0; |
| |
padding:10px 10px 0; |
| |
list-style:none; |
| |
} |
| |
#LC_minitab_header li { |
| |
float:left; |
| |
background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top; |
| |
margin:0; |
| |
padding:0 0 0 9px; |
| |
} |
| |
#LC_minitab_header a { |
| |
display:block; |
| |
background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top; |
| |
padding:5px 15px 4px 6px; |
| |
} |
| |
#LC_minitab_header #LC_current_minitab { |
| |
background-image:url("/res/adm/pages/minitabmenu_left_on.gif"); |
| |
} |
| |
#LC_minitab_header #LC_current_minitab a { |
| |
background-image:url("/res/adm/pages/minitabmenu_right_on.gif"); |
| |
padding-bottom:5px; |
| |
} |
| |
|
| |
|
| END |
END |
| } |
} |
| |
|
|
Line 8289 OFFLOAD
|
Line 8402 OFFLOAD
|
| <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0"> |
<meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0"> |
| <meta name="apple-mobile-web-app-capable" content="yes" />'; |
<meta name="apple-mobile-web-app-capable" content="yes" />'; |
| } |
} |
| |
$result .= '<meta name="google" content="notranslate" />'."\n"; |
| return $result.'</head>'; |
return $result.'</head>'; |
| } |
} |
| |
|
|
Line 8468 $args - additional optional args support
|
Line 8582 $args - additional optional args support
|
| no_auto_mt_title -> prevent &mt()ing the title arg |
no_auto_mt_title -> prevent &mt()ing the title arg |
| bread_crumbs -> Array containing breadcrumbs |
bread_crumbs -> Array containing breadcrumbs |
| bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs |
bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs |
| |
bread_crumbs_nomenu -> if true will pass false as the value of $menulink |
| |
to lonhtmlcommon::breadcrumbs |
| group -> includes the current group, if page is for a |
group -> includes the current group, if page is for a |
| specific group |
specific group |
| |
use_absolute -> for request for external resource or syllabus, this |
| |
will contain https://<hostname> if server uses |
| |
https (as per hosts.tab), but request is for http |
| |
hostname -> hostname, originally from $r->hostname(), (optional). |
| |
|
| =back |
=back |
| |
|
|
Line 8533 sub start_page {
|
Line 8653 sub start_page {
|
| if (@advtools > 0) { |
if (@advtools > 0) { |
| &Apache::lonmenu::advtools_crumbs(@advtools); |
&Apache::lonmenu::advtools_crumbs(@advtools); |
| } |
} |
| |
my $menulink; |
| |
# if arg: bread_crumbs_nomenu is true pass 0 as $menulink item. |
| |
if ((exists($args->{'bread_crumbs_nomenu'})) || |
| |
((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) && |
| |
($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) && |
| |
(!$env{'request.role.adv'}))) { |
| |
$menulink = 0; |
| |
} else { |
| |
undef($menulink); |
| |
} |
| #if bread_crumbs_component exists show it as headline else show only the breadcrumbs |
#if bread_crumbs_component exists show it as headline else show only the breadcrumbs |
| if(exists($args->{'bread_crumbs_component'})){ |
if(exists($args->{'bread_crumbs_component'})){ |
| $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'}); |
$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink); |
| } elsif ($args->{'crstype'} eq 'Placement') { |
|
| $result .= &Apache::lonhtmlcommon::breadcrumbs('','','','','','','','','', |
|
| $args->{'crstype'}); |
|
| } else { |
} else { |
| $result .= &Apache::lonhtmlcommon::breadcrumbs(); |
$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink); |
| } |
} |
| } |
} |
| return $result; |
return $result; |
|
Line 8638 var modalWindow = {
|
Line 8764 var modalWindow = {
|
| }; |
}; |
| var openMyModal = function(source,width,height,scrolling,transparency,style) |
var openMyModal = function(source,width,height,scrolling,transparency,style) |
| { |
{ |
| source = source.replace("'","'"); |
source = source.replace(/'/g,"'"); |
| modalWindow.windowId = "myModal"; |
modalWindow.windowId = "myModal"; |
| modalWindow.width = width; |
modalWindow.width = width; |
| modalWindow.height = height; |
modalWindow.height = height; |
|
Line 9957 sub get_secgrprole_info {
|
Line 10083 sub get_secgrprole_info {
|
| } |
} |
| |
|
| sub user_picker { |
sub user_picker { |
| my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_; |
my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_; |
| my $currdom = $dom; |
my $currdom = $dom; |
| |
my @alldoms = &Apache::lonnet::all_domains(); |
| |
if (@alldoms == 1) { |
| |
my %domsrch = &Apache::lonnet::get_dom('configuration', |
| |
['directorysrch'],$alldoms[0]); |
| |
my $domdesc = &Apache::lonnet::domain($alldoms[0],'description'); |
| |
my $showdom = $domdesc; |
| |
if ($showdom eq '') { |
| |
$showdom = $dom; |
| |
} |
| |
if (ref($domsrch{'directorysrch'}) eq 'HASH') { |
| |
if ((!$domsrch{'directorysrch'}{'available'}) && |
| |
($domsrch{'directorysrch'}{'lcavailable'} eq '0')) { |
| |
return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0); |
| |
} |
| |
} |
| |
} |
| my %curr_selected = ( |
my %curr_selected = ( |
| srchin => 'dom', |
srchin => 'dom', |
| srchby => 'lastname', |
srchby => 'lastname', |
|
Line 10005 sub user_picker {
|
Line 10147 sub user_picker {
|
| ); |
); |
| &html_escape(\%html_lt); |
&html_escape(\%html_lt); |
| &js_escape(\%js_lt); |
&js_escape(\%js_lt); |
| my $domform = &select_dom_form($currdom,'srchdomain',1,1); |
my $domform; |
| |
my $allow_blank = 1; |
| |
if ($fixeddom) { |
| |
$allow_blank = 0; |
| |
$domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]); |
| |
} else { |
| |
my $defdom = $env{'request.role.domain'}; |
| |
my ($trusted,$untrusted); |
| |
if (($context eq 'requestcrs') || ($context eq 'course')) { |
| |
($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom); |
| |
} elsif ($context eq 'author') { |
| |
($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom); |
| |
} elsif ($context eq 'domain') { |
| |
($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom); |
| |
} |
| |
$domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted); |
| |
} |
| my $srchinsel = ' <select name="srchin">'; |
my $srchinsel = ' <select name="srchin">'; |
| |
|
| my @srchins = ('crs','dom','alc','instd'); |
my @srchins = ('crs','dom','alc','instd'); |
|
Line 10017 sub user_picker {
|
Line 10175 sub user_picker {
|
| next if ($option eq 'alc'); |
next if ($option eq 'alc'); |
| next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs')); |
next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs')); |
| next if ($option eq 'crs' && !$env{'request.course.id'}); |
next if ($option eq 'crs' && !$env{'request.course.id'}); |
| |
next if (($option eq 'instd') && ($noinstd)); |
| if ($curr_selected{'srchin'} eq $option) { |
if ($curr_selected{'srchin'} eq $option) { |
| $srchinsel .= ' |
$srchinsel .= ' |
| <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>'; |
<option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>'; |
|
Line 10199 END_BLOCK
|
Line 10358 END_BLOCK
|
| &Apache::lonhtmlcommon::row_closure(1). |
&Apache::lonhtmlcommon::row_closure(1). |
| &Apache::lonhtmlcommon::end_pick_box(). |
&Apache::lonhtmlcommon::end_pick_box(). |
| '<br />'; |
'<br />'; |
| return $output; |
return ($output,1); |
| } |
} |
| |
|
| sub user_rule_check { |
sub user_rule_check { |
|
Line 10514 sub get_institutional_codes {
|
Line 10673 sub get_institutional_codes {
|
| foreach (@currxlists) { |
foreach (@currxlists) { |
| if (m/^([^:]+):(\w*)$/) { |
if (m/^([^:]+):(\w*)$/) { |
| unless (grep/^$1$/,@{$allcourses}) { |
unless (grep/^$1$/,@{$allcourses}) { |
| push @{$allcourses},$1; |
push(@{$allcourses},$1); |
| $$LC_code{$1} = $2; |
$$LC_code{$1} = $2; |
| } |
} |
| } |
} |
|
Line 10527 sub get_institutional_codes {
|
Line 10686 sub get_institutional_codes {
|
| my $sec = $coursecode.$1; |
my $sec = $coursecode.$1; |
| my $lc_sec = $2; |
my $lc_sec = $2; |
| unless (grep/^$sec$/,@{$allcourses}) { |
unless (grep/^$sec$/,@{$allcourses}) { |
| push @{$allcourses},$sec; |
push(@{$allcourses},$sec); |
| $$LC_code{$sec} = $lc_sec; |
$$LC_code{$sec} = $lc_sec; |
| } |
} |
| } |
} |
|
Line 12437 sub decompress_uploaded_file {
|
Line 12596 sub decompress_uploaded_file {
|
| |
|
| sub process_decompression { |
sub process_decompression { |
| my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_; |
my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_; |
| |
unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) { |
| |
return '<p class="LC_error">'.&mt('Not extracted.').'<br />'. |
| |
&mt('Unexpected file path.').'</p>'."\n"; |
| |
} |
| |
unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) { |
| |
return '<p class="LC_error">'.&mt('Not extracted.').'<br />'. |
| |
&mt('Unexpected course context.').'</p>'."\n"; |
| |
} |
| |
unless ($file eq &Apache::lonnet::clean_filename($file)) { |
| |
return '<p class="LC_error">'.&mt('Not extracted.').'<br />'. |
| |
&mt('Filename contained unexpected characters.').'</p>'."\n"; |
| |
} |
| my ($dir,$error,$warning,$output); |
my ($dir,$error,$warning,$output); |
| if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) { |
if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) { |
| $error = &mt('Filename not a supported archive file type.'). |
$error = &mt('Filename not a supported archive file type.'). |
|
Line 12471 sub process_decompression {
|
Line 12642 sub process_decompression {
|
| } |
} |
| } |
} |
| my $numskip = scalar(@to_skip); |
my $numskip = scalar(@to_skip); |
| if (($numskip > 0) && |
my $numoverwrite = scalar(@to_overwrite); |
| ($numskip == $env{'form.archive_itemcount'})) { |
if (($numskip) && (!$numoverwrite)) { |
| $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.'); |
$warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.'); |
| } elsif ($dir eq '') { |
} elsif ($dir eq '') { |
| $error = &mt('Directory containing archive file unavailable.'); |
$error = &mt('Directory containing archive file unavailable.'); |
| } elsif (!$error) { |
} elsif (!$error) { |
| my ($decompressed,$display); |
my ($decompressed,$display); |
| if ($numskip > 0) { |
if (($numskip) || ($numoverwrite)) { |
| my $tempdir = time.'_'.$$.int(rand(10000)); |
my $tempdir = time.'_'.$$.int(rand(10000)); |
| mkdir("$dir/$tempdir",0755); |
mkdir("$dir/$tempdir",0755); |
| system("mv $dir/$file $dir/$tempdir/$file"); |
if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) { |
| ($decompressed,$display) = |
($decompressed,$display) = |
| &decompress_uploaded_file($file,"$dir/$tempdir"); |
&decompress_uploaded_file($file,"$dir/$tempdir"); |
| foreach my $item (@to_skip) { |
foreach my $item (@to_skip) { |
| if (($item ne '') && ($item !~ /\.\./)) { |
if (($item ne '') && ($item !~ /\.\./)) { |
| if (-f "$dir/$tempdir/$item") { |
if (-f "$dir/$tempdir/$item") { |
| unlink("$dir/$tempdir/$item"); |
unlink("$dir/$tempdir/$item"); |
| } elsif (-d "$dir/$tempdir/$item") { |
} elsif (-d "$dir/$tempdir/$item") { |
| system("rm -rf $dir/$tempdir/$item"); |
&File::Path::Tiny::rm("$dir/$tempdir/$item"); |
| |
} |
| } |
} |
| } |
} |
| |
foreach my $item (@to_overwrite) { |
| |
if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) { |
| |
if (($item ne '') && ($item !~ /\.\./)) { |
| |
if (-f "$dir/$item") { |
| |
unlink("$dir/$item"); |
| |
} elsif (-d "$dir/$item") { |
| |
&File::Path::Tiny::rm("$dir/$item"); |
| |
} |
| |
&File::Copy::move("$dir/$tempdir/$item","$dir/$item"); |
| |
} |
| |
} |
| |
} |
| |
if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) { |
| |
&File::Path::Tiny::rm("$dir/$tempdir"); |
| |
} |
| } |
} |
| system("mv $dir/$tempdir/* $dir"); |
|
| rmdir("$dir/$tempdir"); |
|
| } else { |
} else { |
| ($decompressed,$display) = |
($decompressed,$display) = |
| &decompress_uploaded_file($file,$dir); |
&decompress_uploaded_file($file,$dir); |
|
Line 12512 sub process_decompression {
|
Line 12697 sub process_decompression {
|
| if (ref($newdirlistref) eq 'ARRAY') { |
if (ref($newdirlistref) eq 'ARRAY') { |
| foreach my $dir_line (@{$newdirlistref}) { |
foreach my $dir_line (@{$newdirlistref}) { |
| my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); |
my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); |
| unless (($item =~ /^\.+$/) || ($item eq $file) || |
unless (($item =~ /^\.+$/) || ($item eq $file)) { |
| ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) { |
|
| push(@newitems,$item); |
push(@newitems,$item); |
| if ($dirptr&$testdir) { |
if ($dirptr&$testdir) { |
| $is_dir{$item} = 1; |
$is_dir{$item} = 1; |
|
Line 12998 END
|
Line 13182 END
|
| sub process_extracted_files { |
sub process_extracted_files { |
| my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_; |
my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_; |
| my $numitems = $env{'form.archive_count'}; |
my $numitems = $env{'form.archive_count'}; |
| return unless ($numitems); |
return if ((!$numitems) || ($numitems =~ /\D/)); |
| my @ids=&Apache::lonnet::current_machine_ids(); |
my @ids=&Apache::lonnet::current_machine_ids(); |
| my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir, |
my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir, |
| %folders,%containers,%mapinner,%prompttofetch); |
%folders,%containers,%mapinner,%prompttofetch); |
|
Line 13011 sub process_extracted_files {
|
Line 13195 sub process_extracted_files {
|
| } else { |
} else { |
| $prefix = $Apache::lonnet::perlvar{'lonDocRoot'}; |
$prefix = $Apache::lonnet::perlvar{'lonDocRoot'}; |
| $pathtocheck = "$dir_root/$docudom/$docuname/$destination"; |
$pathtocheck = "$dir_root/$docudom/$docuname/$destination"; |
| $dir = "$dir_root/$docudom/$docuname"; |
$dir = "$dir_root/$docudom/$docuname"; |
| } |
} |
| my $currdir = "$dir_root/$destination"; |
my $currdir = "$dir_root/$destination"; |
| (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/}); |
(my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/}); |
|
Line 13100 sub process_extracted_files {
|
Line 13284 sub process_extracted_files {
|
| '.'.$containers{$outer},1,1); |
'.'.$containers{$outer},1,1); |
| $newseqid{$i} = $newidx; |
$newseqid{$i} = $newidx; |
| unless ($errtext) { |
unless ($errtext) { |
| $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n"; |
$result .= '<li>'.&mt('Folder: [_1] added to course', |
| |
&HTML::Entities::encode($docstitle,'<>&"')). |
| |
'</li>'."\n"; |
| } |
} |
| } |
} |
| } else { |
} else { |
|
Line 13109 sub process_extracted_files {
|
Line 13295 sub process_extracted_files {
|
| my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'. |
my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'. |
| $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'. |
$docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'. |
| $title; |
$title; |
| if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") { |
if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) { |
| mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755); |
if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") { |
| } |
mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755); |
| if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { |
|
| mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx"); |
|
| } |
|
| if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { |
|
| system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title"); |
|
| $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx"; |
|
| unless ($ishome) { |
|
| my $fetch = "$newdest{$i}/$title"; |
|
| $fetch =~ s/^\Q$prefix$dir\E//; |
|
| $prompttofetch{$fetch} = 1; |
|
| } |
} |
| } |
if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { |
| $LONCAPA::map::resources[$newidx]= |
mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx"); |
| $docstitle.':'.$url.':false:normal:res'; |
} |
| push(@LONCAPA::map::order, $newidx); |
if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { |
| my ($outtext,$errtext)= |
if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) { |
| &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. |
$newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx"; |
| $docuname.'/'.$folders{$outer}. |
unless ($ishome) { |
| '.'.$containers{$outer},1,1); |
my $fetch = "$newdest{$i}/$title"; |
| unless ($errtext) { |
$fetch =~ s/^\Q$prefix$dir\E//; |
| if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") { |
$prompttofetch{$fetch} = 1; |
| $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n"; |
} |
| |
} |
| } |
} |
| |
$LONCAPA::map::resources[$newidx]= |
| |
$docstitle.':'.$url.':false:normal:res'; |
| |
push(@LONCAPA::map::order, $newidx); |
| |
my ($outtext,$errtext)= |
| |
&LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. |
| |
$docuname.'/'.$folders{$outer}. |
| |
'.'.$containers{$outer},1,1); |
| |
unless ($errtext) { |
| |
if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") { |
| |
$result .= '<li>'.&mt('File: [_1] added to course', |
| |
&HTML::Entities::encode($docstitle,'<>&"')). |
| |
'</li>'."\n"; |
| |
} |
| |
} |
| |
} else { |
| |
$warning .= &mt('Item extracted from archive: [_1] has unexpected path.', |
| |
&HTML::Entities::encode($path,'<>&"')).'<br />'; |
| } |
} |
| } |
} |
| } |
} |
| } |
} |
| } else { |
} else { |
| $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; |
$warning .= &mt('Item extracted from archive: [_1] has unexpected path.', |
| |
&HTML::Entities::encode($path,'<>&"')).'<br />'; |
| } |
} |
| } |
} |
| for (my $i=1; $i<=$numitems; $i++) { |
for (my $i=1; $i<=$numitems; $i++) { |
|
Line 13201 sub process_extracted_files {
|
Line 13396 sub process_extracted_files {
|
| } |
} |
| if ($fullpath ne '') { |
if ($fullpath ne '') { |
| if (-e "$prefix$path") { |
if (-e "$prefix$path") { |
| system("mv $prefix$path $fullpath/$title"); |
unless (rename("$prefix$path","$fullpath/$title")) { |
| |
$warning .= &mt('Failed to rename dependency').'<br />'; |
| |
} |
| } |
} |
| if (-e "$fullpath/$title") { |
if (-e "$fullpath/$title") { |
| my $showpath; |
my $showpath; |
|
Line 13210 sub process_extracted_files {
|
Line 13407 sub process_extracted_files {
|
| } else { |
} else { |
| $showpath = "/$title"; |
$showpath = "/$title"; |
| } |
} |
| $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n"; |
$result .= '<li>'.&mt('[_1] included as a dependency', |
| } |
&HTML::Entities::encode($showpath,'<>&"')). |
| unless ($ishome) { |
'</li>'."\n"; |
| my $fetch = "$fullpath/$title"; |
unless ($ishome) { |
| $fetch =~ s/^\Q$prefix$dir\E//; |
my $fetch = "$fullpath/$title"; |
| $prompttofetch{$fetch} = 1; |
$fetch =~ s/^\Q$prefix$dir\E//; |
| |
$prompttofetch{$fetch} = 1; |
| |
} |
| } |
} |
| } |
} |
| } |
} |
| } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') { |
} elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') { |
| $warning .= &mt('[_1] is a dependency of [_2], which was discarded.', |
$warning .= &mt('[_1] is a dependency of [_2], which was discarded.', |
| $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />'; |
&HTML::Entities::encode($path,'<>&"'), |
| |
&HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')). |
| |
'<br />'; |
| } |
} |
| } else { |
} else { |
| $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; |
$warning .= &mt('Item extracted from archive: [_1] has unexpected path.', |
| |
&HTML::Entities::encode($path)).'<br />'; |
| } |
} |
| } |
} |
| if (keys(%todelete)) { |
if (keys(%todelete)) { |
|
Line 13513 sub upfile_store {
|
Line 13715 sub upfile_store {
|
| |
|
| =pod |
=pod |
| |
|
| =item * &load_tmp_file($r) |
=item * &load_tmp_file($r,$datatoken) |
| |
|
| Load uploaded file from tmp, $r should be the HTTP Request object, |
Load uploaded file from tmp, $r should be the HTTP Request object, |
| needs $env{'form.datatoken'}, |
$datatoken is the name to assign to the temporary file. |
| sets $env{'form.upfile'} to the contents of the file |
sets $env{'form.upfile'} to the contents of the file |
| |
|
| =cut |
=cut |
| |
|
| sub load_tmp_file { |
sub load_tmp_file { |
| my $r=shift; |
my ($r,$datatoken) = @_; |
| |
return if ($datatoken eq ''); |
| my @studentdata=(); |
my @studentdata=(); |
| { |
{ |
| my $studentfile = $r->dir_config('lonDaemons'). |
my $studentfile = $r->dir_config('lonDaemons'). |
| '/tmp/'.$env{'form.datatoken'}.'.tmp'; |
'/tmp/'.$datatoken.'.tmp'; |
| if ( open(my $fh,"<$studentfile") ) { |
if ( open(my $fh,"<$studentfile") ) { |
| @studentdata=<$fh>; |
@studentdata=<$fh>; |
| close($fh); |
close($fh); |
|
Line 13535 sub load_tmp_file {
|
Line 13738 sub load_tmp_file {
|
| $env{'form.upfile'}=join('',@studentdata); |
$env{'form.upfile'}=join('',@studentdata); |
| } |
} |
| |
|
| |
sub valid_datatoken { |
| |
my ($datatoken) = @_; |
| |
if ($datatoken =~ /^$match_username\_$match_domain\_enroll_$match_domain\_$match_courseid\_\d+_\d+$/) { |
| |
return $datatoken; |
| |
} |
| |
return; |
| |
} |
| |
|
| =pod |
=pod |
| |
|
| =item * &upfile_record_sep() |
=item * &upfile_record_sep() |
|
Line 13975 sub DrawBarGraph {
|
Line 14186 sub DrawBarGraph {
|
| @Labels = @$labels; |
@Labels = @$labels; |
| } else { |
} else { |
| for (my $i=0;$i<@{$Values[0]};$i++) { |
for (my $i=0;$i<@{$Values[0]};$i++) { |
| push (@Labels,$i+1); |
push(@Labels,$i+1); |
| } |
} |
| } |
} |
| # |
# |
|
Line 14421 requestsmail, updatesmail, or idconflict
|
Line 14632 requestsmail, updatesmail, or idconflict
|
| defdom (domain for which to retrieve configuration settings), |
defdom (domain for which to retrieve configuration settings), |
| |
|
| origmail (scalar - email address of recipient from loncapa.conf, |
origmail (scalar - email address of recipient from loncapa.conf, |
| i.e., predates configuration by DC via domainprefs.pm |
i.e., predates configuration by DC via domainprefs.pm |
| |
|
| |
$requname username of requester (if mailing type is helpdeskmail) |
| |
|
| |
$requdom domain of requester (if mailing type is helpdeskmail) |
| |
|
| |
$reqemail e-mail address of requester (if mailing type is helpdeskmail) |
| |
|
| |
|
| Returns: comma separated list of addresses to which to send e-mail. |
Returns: comma separated list of addresses to which to send e-mail. |
| |
|
|
Line 14432 Returns: comma separated list of address
|
Line 14650 Returns: comma separated list of address
|
| ############################################################ |
############################################################ |
| ############################################################ |
############################################################ |
| sub build_recipient_list { |
sub build_recipient_list { |
| my ($defmail,$mailing,$defdom,$origmail) = @_; |
my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_; |
| my @recipients; |
my @recipients; |
| my $otheremails; |
my ($otheremails,$lastresort,$allbcc,$addtext); |
| my %domconfig = |
my %domconfig = |
| &Apache::lonnet::get_dom('configuration',['contacts'],$defdom); |
&Apache::lonnet::get_dom('configuration',['contacts'],$defdom); |
| if (ref($domconfig{'contacts'}) eq 'HASH') { |
if (ref($domconfig{'contacts'}) eq 'HASH') { |
| if (exists($domconfig{'contacts'}{$mailing})) { |
if (exists($domconfig{'contacts'}{$mailing})) { |
| if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') { |
if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') { |
|
Line 14448 sub build_recipient_list {
|
Line 14666 sub build_recipient_list {
|
| push(@recipients,$addr); |
push(@recipients,$addr); |
| } |
} |
| } |
} |
| $otheremails = $domconfig{'contacts'}{$mailing}{'others'}; |
} |
| |
$otheremails = $domconfig{'contacts'}{$mailing}{'others'}; |
| |
if ($mailing eq 'helpdeskmail') { |
| |
if ($domconfig{'contacts'}{$mailing}{'bcc'}) { |
| |
my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'}); |
| |
my @ok_bccs; |
| |
foreach my $bcc (@bccs) { |
| |
$bcc =~ s/^\s+//g; |
| |
$bcc =~ s/\s+$//g; |
| |
if ($bcc =~ m/^[^\@]+\@[^\@]+$/) { |
| |
if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) { |
| |
push(@ok_bccs,$bcc); |
| |
} |
| |
} |
| |
} |
| |
if (@ok_bccs > 0) { |
| |
$allbcc = join(', ',@ok_bccs); |
| |
} |
| |
} |
| |
$addtext = $domconfig{'contacts'}{$mailing}{'include'}; |
| } |
} |
| } |
} |
| } elsif ($origmail ne '') { |
} elsif ($origmail ne '') { |
| push(@recipients,$origmail); |
$lastresort = $origmail; |
| |
} |
| |
if ($mailing eq 'helpdeskmail') { |
| |
if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') && |
| |
(keys(%{$domconfig{'contacts'}{'overrides'}}))) { |
| |
my ($inststatus,$inststatus_checked); |
| |
if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') && |
| |
($env{'user.domain'} ne 'public')) { |
| |
$inststatus_checked = 1; |
| |
$inststatus = $env{'environment.inststatus'}; |
| |
} |
| |
unless ($inststatus_checked) { |
| |
if (($requname ne '') && ($requdom ne '')) { |
| |
if (($requname =~ /^$match_username$/) && |
| |
($requdom =~ /^$match_domain$/) && |
| |
(&Apache::lonnet::domain($requdom))) { |
| |
my $requhome = &Apache::lonnet::homeserver($requname, |
| |
$requdom); |
| |
unless ($requhome eq 'no_host') { |
| |
my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus'); |
| |
$inststatus = $userenv{'inststatus'}; |
| |
$inststatus_checked = 1; |
| |
} |
| |
} |
| |
} |
| |
} |
| |
unless ($inststatus_checked) { |
| |
if ($reqemail =~ /^[^\@]+\@[^\@]+$/) { |
| |
my %srch = (srchby => 'email', |
| |
srchdomain => $defdom, |
| |
srchterm => $reqemail, |
| |
srchtype => 'exact'); |
| |
my %srch_results = &Apache::lonnet::usersearch(\%srch); |
| |
foreach my $uname (keys(%srch_results)) { |
| |
if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') { |
| |
$inststatus = join(',',@{$srch_results{$uname}{'inststatus'}}); |
| |
$inststatus_checked = 1; |
| |
last; |
| |
} |
| |
} |
| |
unless ($inststatus_checked) { |
| |
my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch); |
| |
if ($dirsrchres eq 'ok') { |
| |
foreach my $uname (keys(%srch_results)) { |
| |
if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') { |
| |
$inststatus = join(',',@{$srch_results{$uname}{'inststatus'}}); |
| |
$inststatus_checked = 1; |
| |
last; |
| |
} |
| |
} |
| |
} |
| |
} |
| |
} |
| |
} |
| |
if ($inststatus ne '') { |
| |
foreach my $status (split(/\:/,$inststatus)) { |
| |
if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') { |
| |
my @contacts = ('adminemail','supportemail'); |
| |
foreach my $item (@contacts) { |
| |
if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) { |
| |
my $addr = $domconfig{'contacts'}{'overrides'}{$status}; |
| |
if (!grep(/^\Q$addr\E$/,@recipients)) { |
| |
push(@recipients,$addr); |
| |
} |
| |
} |
| |
} |
| |
$otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'}; |
| |
if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) { |
| |
my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'}); |
| |
my @ok_bccs; |
| |
foreach my $bcc (@bccs) { |
| |
$bcc =~ s/^\s+//g; |
| |
$bcc =~ s/\s+$//g; |
| |
if ($bcc =~ m/^[^\@]+\@[^\@]+$/) { |
| |
if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) { |
| |
push(@ok_bccs,$bcc); |
| |
} |
| |
} |
| |
} |
| |
if (@ok_bccs > 0) { |
| |
$allbcc = join(', ',@ok_bccs); |
| |
} |
| |
} |
| |
$addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'}; |
| |
last; |
| |
} |
| |
} |
| |
} |
| |
} |
| } |
} |
| } elsif ($origmail ne '') { |
} elsif ($origmail ne '') { |
| push(@recipients,$origmail); |
$lastresort = $origmail; |
| |
} |
| |
if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) { |
| |
unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) { |
| |
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; |
| |
my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'}; |
| |
my %what = ( |
| |
perlvar => 1, |
| |
); |
| |
my $primary = &Apache::lonnet::domain($defdom,'primary'); |
| |
if ($primary) { |
| |
my $gotaddr; |
| |
my ($result,$returnhash) = |
| |
&Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 }); |
| |
if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) { |
| |
if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) { |
| |
$lastresort = $returnhash->{'lonSupportEMail'}; |
| |
$gotaddr = 1; |
| |
} |
| |
} |
| |
unless ($gotaddr) { |
| |
my $uintdom = &Apache::lonnet::internet_dom($primary); |
| |
my $intdom = &Apache::lonnet::internet_dom($lonhost); |
| |
unless ($uintdom eq $intdom) { |
| |
my %domconfig = |
| |
&Apache::lonnet::get_dom('configuration',['contacts'],$machinedom); |
| |
if (ref($domconfig{'contacts'}) eq 'HASH') { |
| |
if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') { |
| |
my @contacts = ('adminemail','supportemail'); |
| |
foreach my $item (@contacts) { |
| |
if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) { |
| |
my $addr = $domconfig{'contacts'}{$item}; |
| |
if (!grep(/^\Q$addr\E$/,@recipients)) { |
| |
push(@recipients,$addr); |
| |
} |
| |
} |
| |
} |
| |
if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) { |
| |
$otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'}; |
| |
} |
| |
if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) { |
| |
my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'}); |
| |
my @ok_bccs; |
| |
foreach my $bcc (@bccs) { |
| |
$bcc =~ s/^\s+//g; |
| |
$bcc =~ s/\s+$//g; |
| |
if ($bcc =~ m/^[^\@]+\@[^\@]+$/) { |
| |
if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) { |
| |
push(@ok_bccs,$bcc); |
| |
} |
| |
} |
| |
} |
| |
if (@ok_bccs > 0) { |
| |
$allbcc = join(', ',@ok_bccs); |
| |
} |
| |
} |
| |
$addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'}; |
| |
} |
| |
} |
| |
} |
| |
} |
| |
} |
| |
} |
| } |
} |
| if (defined($defmail)) { |
if (defined($defmail)) { |
| if ($defmail ne '') { |
if ($defmail ne '') { |
|
Line 14475 sub build_recipient_list {
|
Line 14862 sub build_recipient_list {
|
| } |
} |
| } |
} |
| } |
} |
| my $recipientlist = join(',',@recipients); |
if ($mailing eq 'helpdesk') { |
| return $recipientlist; |
if ((!@recipients) && ($lastresort ne '')) { |
| |
push(@recipients,$lastresort); |
| |
} |
| |
} elsif ($lastresort ne '') { |
| |
if (!grep(/^\Q$lastresort\E$/,@recipients)) { |
| |
push(@recipients,$lastresort); |
| |
} |
| |
} |
| |
my $recipientlist = join(',',@recipients); |
| |
if (wantarray) { |
| |
return ($recipientlist,$allbcc,$addtext); |
| |
} else { |
| |
return $recipientlist; |
| |
} |
| } |
} |
| |
|
| ############################################################ |
############################################################ |
|
Line 14783 currcat - scalar with an & separated lis
|
Line 15183 currcat - scalar with an & separated lis
|
| |
|
| type - scalar contains course type (Course or Community). |
type - scalar contains course type (Course or Community). |
| |
|
| |
disabled - scalar (optional) contains disabled="disabled" if input elements are |
| |
to be readonly (e.g., Domain Helpdesk role viewing course settings). |
| |
|
| Returns: $output (markup to be displayed) |
Returns: $output (markup to be displayed) |
| |
|
| =cut |
=cut |
| |
|
| sub assign_categories_table { |
sub assign_categories_table { |
| my ($cathash,$currcat,$type) = @_; |
my ($cathash,$currcat,$type,$disabled) = @_; |
| my $output; |
my $output; |
| if (ref($cathash) eq 'HASH') { |
if (ref($cathash) eq 'HASH') { |
| my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth); |
my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth); |
|
Line 14828 sub assign_categories_table {
|
Line 15231 sub assign_categories_table {
|
| } |
} |
| $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'. |
$table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'. |
| '<input type="checkbox" name="usecategory" value="'. |
'<input type="checkbox" name="usecategory" value="'. |
| $item.'"'.$checked.' />'.$parent_title.'</span>'. |
$item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'. |
| '<input type="hidden" name="catname" value="'.$parent.'" /></td>'; |
'<input type="hidden" name="catname" value="'.$parent.'" /></td>'; |
| my $depth = 1; |
my $depth = 1; |
| push(@path,$parent); |
push(@path,$parent); |
| $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories); |
$table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled); |
| pop(@path); |
pop(@path); |
| $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>'; |
$table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>'; |
| $itemcount ++; |
$itemcount ++; |
|
Line 14871 path - Array containing all categories b
|
Line 15274 path - Array containing all categories b
|
| |
|
| currcategories - reference to array of current categories assigned to the course |
currcategories - reference to array of current categories assigned to the course |
| |
|
| |
disabled - scalar (optional) contains disabled="disabled" if input elements are |
| |
to be readonly (e.g., Domain Helpdesk role viewing course settings). |
| |
|
| Returns: $output (markup to be displayed). |
Returns: $output (markup to be displayed). |
| |
|
| =cut |
=cut |
| |
|
| sub assign_category_rows { |
sub assign_category_rows { |
| my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_; |
my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_; |
| my ($text,$name,$item,$chgstr); |
my ($text,$name,$item,$chgstr); |
| if (ref($cats) eq 'ARRAY') { |
if (ref($cats) eq 'ARRAY') { |
| my $maxdepth = scalar(@{$cats}); |
my $maxdepth = scalar(@{$cats}); |
|
Line 14899 sub assign_category_rows {
|
Line 15305 sub assign_category_rows {
|
| } |
} |
| $text .= '<tr><td><span class="LC_nobreak"><label>'. |
$text .= '<tr><td><span class="LC_nobreak"><label>'. |
| '<input type="checkbox" name="usecategory" value="'. |
'<input type="checkbox" name="usecategory" value="'. |
| $item.'"'.$checked.' />'.$name.'</label></span>'. |
$item.'"'.$checked.$disabled.' />'.$name.'</label></span>'. |
| '<input type="hidden" name="catname" value="'.$name.'" />'. |
'<input type="hidden" name="catname" value="'.$name.'" />'. |
| '</td><td>'; |
'</td><td>'; |
| if (ref($path) eq 'ARRAY') { |
if (ref($path) eq 'ARRAY') { |
| push(@{$path},$name); |
push(@{$path},$name); |
| $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories); |
$text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled); |
| pop(@{$path}); |
pop(@{$path}); |
| } |
} |
| $text .= '</td></tr>'; |
$text .= '</td></tr>'; |
|
Line 15131 sub check_clone {
|
Line 15537 sub check_clone {
|
| my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1}); |
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1}); |
| if ($args->{'crstype'} eq 'Community') { |
if ($args->{'crstype'} eq 'Community') { |
| if ($clonedesc{'type'} ne 'Community') { |
if ($clonedesc{'type'} ne 'Community') { |
| $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); |
$clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); |
| return ($can_clone, $clonemsg, $cloneid, $clonehome); |
return ($can_clone, $clonemsg, $cloneid, $clonehome); |
| } |
} |
| } |
} |
| if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && |
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && |
| (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) { |
(&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) { |
| $can_clone = 1; |
$can_clone = 1; |
| } else { |
} else { |
|
Line 15232 sub check_clone {
|
Line 15638 sub check_clone {
|
| } |
} |
| |
|
| sub construct_course { |
sub construct_course { |
| my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_; |
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, |
| |
$cnum,$category,$coderef) = @_; |
| my $outcome; |
my $outcome; |
| my $linefeed = '<br />'."\n"; |
my $linefeed = '<br />'."\n"; |
| if ($context eq 'auto') { |
if ($context eq 'auto') { |
|
Line 15385 sub construct_course {
|
Line 15792 sub construct_course {
|
| my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'}); |
my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'}); |
| $cenv{'internal.sectionnums'} .= $item.','; |
$cenv{'internal.sectionnums'} .= $item.','; |
| unless ($addcheck eq 'ok') { |
unless ($addcheck eq 'ok') { |
| push @badclasses, $class; |
push(@badclasses,$class); |
| } |
} |
| } |
} |
| $cenv{'internal.sectionnums'} =~ s/,$//; |
$cenv{'internal.sectionnums'} =~ s/,$//; |
|
Line 15413 sub construct_course {
|
Line 15820 sub construct_course {
|
| my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'}); |
my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'}); |
| $cenv{'internal.crosslistings'} .= $item.','; |
$cenv{'internal.crosslistings'} .= $item.','; |
| unless ($addcheck eq 'ok') { |
unless ($addcheck eq 'ok') { |
| push @badclasses, $xl; |
push(@badclasses,$xl); |
| } |
} |
| } |
} |
| $cenv{'internal.crosslistings'} =~ s/,$//; |
$cenv{'internal.crosslistings'} =~ s/,$//; |
|
Line 15448 sub construct_course {
|
Line 15855 sub construct_course {
|
| } |
} |
| if (@badclasses > 0) { |
if (@badclasses > 0) { |
| my %lt=&Apache::lonlocal::texthash( |
my %lt=&Apache::lonlocal::texthash( |
| 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course. However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course', |
'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.', |
| 'dnhr' => 'does not have rights to access enrollment in these classes', |
'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.', |
| 'adby' => 'as determined by the policies of your institution on access to official classlists' |
'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.', |
| ); |
); |
| my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}. |
my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed. |
| ' ('.$lt{'adby'}.')'; |
&mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'}; |
| if ($context eq 'auto') { |
if ($context eq 'auto') { |
| $outcome .= $badclass_msg.$linefeed; |
$outcome .= $badclass_msg.$linefeed; |
| |
} else { |
| $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n"; |
$outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n"; |
| foreach my $item (@badclasses) { |
} |
| if ($context eq 'auto') { |
foreach my $item (@badclasses) { |
| $outcome .= " - $item\n"; |
|
| } else { |
|
| $outcome .= "<li>$item</li>\n"; |
|
| } |
|
| } |
|
| if ($context eq 'auto') { |
if ($context eq 'auto') { |
| $outcome .= $linefeed; |
$outcome .= " - $item\n"; |
| } else { |
} else { |
| $outcome .= "</ul><br /><br /></div>\n"; |
$outcome .= "<li>$item</li>\n"; |
| } |
} |
| |
} |
| |
if ($context eq 'auto') { |
| |
$outcome .= $linefeed; |
| |
} else { |
| |
$outcome .= "</ul><br /><br /></div>\n"; |
| } |
} |
| } |
} |
| if ($args->{'no_end_date'}) { |
if ($args->{'no_end_date'}) { |
|
Line 15501 sub construct_course {
|
Line 15909 sub construct_course {
|
| if ($args->{'setcontent'}) { |
if ($args->{'setcontent'}) { |
| $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'}; |
$cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'}; |
| } |
} |
| |
if ($args->{'setcomment'}) { |
| |
$cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'}; |
| |
} |
| } |
} |
| if ($args->{'reshome'}) { |
if ($args->{'reshome'}) { |
| $cenv{'reshome'}=$args->{'reshome'}.'/'; |
$cenv{'reshome'}=$args->{'reshome'}.'/'; |
|
Line 15808 sub init_user_environment {
|
Line 16219 sub init_user_environment {
|
| |
|
| my $public=($username eq 'public' && $domain eq 'public'); |
my $public=($username eq 'public' && $domain eq 'public'); |
| |
|
| # See if old ID present, if so, remove |
|
| |
|
| my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv); |
my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv); |
| my $now=time; |
my $now=time; |
| |
|
|
Line 15831 sub init_user_environment {
|
Line 16240 sub init_user_environment {
|
| } |
} |
| if (!$cookie) { $cookie="publicuser_$oldest"; } |
if (!$cookie) { $cookie="publicuser_$oldest"; } |
| } else { |
} else { |
| # if this isn't a robot, kill any existing non-robot sessions |
# See if old ID present, if so, remove if this isn't a robot, |
| |
# killing any existing non-robot sessions |
| if (!$args->{'robot'}) { |
if (!$args->{'robot'}) { |
| opendir(DIR,$lonids); |
opendir(DIR,$lonids); |
| while ($filename=readdir(DIR)) { |
while ($filename=readdir(DIR)) { |
| if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) { |
if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) { |
| unlink($lonids.'/'.$filename); |
if ($ENV{'SERVER_PORT'} == 443) { |
| |
my $linkedfile; |
| |
if (tie(my %oldenv,'GDBM_File',"$lonids/$cookie.id", |
| |
&GDBM_READER(),0640)) { |
| |
if (exists($oldenv{'user.linkedenv'})) { |
| |
$linkedfile = $oldenv{'user.linkedenv'}; |
| |
} |
| |
untie(%oldenv); |
| |
} |
| |
if (unlink($lonids.'/'.$filename)) { |
| |
if ($linkedfile =~ /^[a-f0-9]+_linked\.id$/) { |
| |
unlink($lonids.'/'.$linkedfile); |
| |
} |
| |
} |
| |
} else { |
| |
unlink($lonids.'/'.$filename); |
| |
} |
| } |
} |
| } |
} |
| closedir(DIR); |
closedir(DIR); |
|
Line 15871 sub init_user_environment {
|
Line 16297 sub init_user_environment {
|
| |
|
| my %userenv = &Apache::lonnet::dump('environment',$domain,$username); |
my %userenv = &Apache::lonnet::dump('environment',$domain,$username); |
| my ($tmp) = keys(%userenv); |
my ($tmp) = keys(%userenv); |
| if ($tmp !~ /^(con_lost|error|no_such_host)/i) { |
if ($tmp =~ /^(con_lost|error|no_such_host)/i) { |
| } else { |
|
| undef(%userenv); |
undef(%userenv); |
| } |
} |
| if (($userenv{'interface'}) && (!$form->{'interface'})) { |
if (($userenv{'interface'}) && (!$form->{'interface'})) { |
|
Line 15924 sub init_user_environment {
|
Line 16349 sub init_user_environment {
|
| $env{'user.noloadbalance'} = $lonhost; |
$env{'user.noloadbalance'} = $lonhost; |
| } |
} |
| |
|
| my %is_adv = ( is_adv => $env{'user.adv'} ); |
if ($form->{'noloadbalance'}) { |
| my %domdef; |
my @hosts = &Apache::lonnet::current_machine_ids(); |
| unless ($domain eq 'public') { |
my $hosthere = $form->{'noloadbalance'}; |
| %domdef = &Apache::lonnet::get_domain_defaults($domain); |
if (grep(/^\Q$hosthere\E$/,@hosts)) { |
| |
$initial_env{"user.noloadbalance"} = $hosthere; |
| |
$env{'user.noloadbalance'} = $hosthere; |
| |
} |
| } |
} |
| |
|
| foreach my $tool ('aboutme','blog','webdav','portfolio') { |
unless ($domain eq 'public') { |
| $userenv{'availabletools.'.$tool} = |
my %is_adv = ( is_adv => $env{'user.adv'} ); |
| &Apache::lonnet::usertools_access($username,$domain,$tool,'reload', |
my %domdef = &Apache::lonnet::get_domain_defaults($domain); |
| undef,\%userenv,\%domdef,\%is_adv); |
|
| } |
|
| |
|
| foreach my $crstype ('official','unofficial','community','textbook','placement') { |
foreach my $tool ('aboutme','blog','webdav','portfolio') { |
| $userenv{'canrequest.'.$crstype} = |
$userenv{'availabletools.'.$tool} = |
| &Apache::lonnet::usertools_access($username,$domain,$crstype, |
&Apache::lonnet::usertools_access($username,$domain,$tool,'reload', |
| 'reload','requestcourses', |
undef,\%userenv,\%domdef,\%is_adv); |
| \%userenv,\%domdef,\%is_adv); |
} |
| } |
|
| |
|
| $userenv{'canrequest.author'} = |
foreach my $crstype ('official','unofficial','community','textbook','placement') { |
| &Apache::lonnet::usertools_access($username,$domain,'requestauthor', |
$userenv{'canrequest.'.$crstype} = |
| 'reload','requestauthor', |
&Apache::lonnet::usertools_access($username,$domain,$crstype, |
| \%userenv,\%domdef,\%is_adv); |
'reload','requestcourses', |
| my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'], |
\%userenv,\%domdef,\%is_adv); |
| $domain,$username); |
|
| my $reqstatus = $reqauthor{'author_status'}; |
|
| if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { |
|
| if (ref($reqauthor{'author'}) eq 'HASH') { |
|
| $userenv{'requestauthorqueued'} = $reqstatus.':'. |
|
| $reqauthor{'author'}{'timestamp'}; |
|
| } |
} |
| } |
|
| |
|
| |
$userenv{'canrequest.author'} = |
| |
&Apache::lonnet::usertools_access($username,$domain,'requestauthor', |
| |
'reload','requestauthor', |
| |
\%userenv,\%domdef,\%is_adv); |
| |
my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'], |
| |
$domain,$username); |
| |
my $reqstatus = $reqauthor{'author_status'}; |
| |
if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { |
| |
if (ref($reqauthor{'author'}) eq 'HASH') { |
| |
$userenv{'requestauthorqueued'} = $reqstatus.':'. |
| |
$reqauthor{'author'}{'timestamp'}; |
| |
} |
| |
} |
| |
my ($types,$typename) = &course_types(); |
| |
if (ref($types) eq 'ARRAY') { |
| |
my @options = ('approval','validate','autolimit'); |
| |
my $optregex = join('|',@options); |
| |
my (%willtrust,%trustchecked); |
| |
foreach my $type (@{$types}) { |
| |
my $dom_str = $env{'environment.reqcrsotherdom.'.$type}; |
| |
if ($dom_str ne '') { |
| |
my $updatedstr = ''; |
| |
my @possdomains = split(',',$dom_str); |
| |
foreach my $entry (@possdomains) { |
| |
my ($extdom,$extopt) = split(':',$entry); |
| |
unless ($trustchecked{$extdom}) { |
| |
$willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom); |
| |
$trustchecked{$extdom} = 1; |
| |
} |
| |
if ($willtrust{$extdom}) { |
| |
$updatedstr .= $entry.','; |
| |
} |
| |
} |
| |
$updatedstr =~ s/,$//; |
| |
if ($updatedstr) { |
| |
$userenv{'reqcrsotherdom.'.$type} = $updatedstr; |
| |
} else { |
| |
delete($userenv{'reqcrsotherdom.'.$type}); |
| |
} |
| |
} |
| |
} |
| |
} |
| |
} |
| $env{'user.environment'} = "$lonids/$cookie.id"; |
$env{'user.environment'} = "$lonids/$cookie.id"; |
| |
|
| if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id", |
if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id", |
|
Line 16573 sub search_courses {
|
Line 17034 sub search_courses {
|
| if (ref($courses{$cid}) eq 'HASH') { |
if (ref($courses{$cid}) eq 'HASH') { |
| if (ref($courses{$cid}{roles}) eq 'ARRAY') { |
if (ref($courses{$cid}{roles}) eq 'ARRAY') { |
| if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) { |
if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) { |
| push (@{$courses{$cid}{roles}},$courserole); |
push(@{$courses{$cid}{roles}},$courserole); |
| } |
} |
| } else { |
} else { |
| $courses{$cid}{roles} = [$courserole]; |
$courses{$cid}{roles} = [$courserole]; |
|
Line 16769 sub needs_coursereinit {
|
Line 17230 sub needs_coursereinit {
|
| $interval = 600; |
$interval = 600; |
| } |
} |
| if (($now-$env{'request.course.timechecked'})>$interval) { |
if (($now-$env{'request.course.timechecked'})>$interval) { |
| my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum); |
|
| &Apache::lonnet::appenv({'request.course.timechecked'=>$now}); |
&Apache::lonnet::appenv({'request.course.timechecked'=>$now}); |
| |
my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1); |
| |
if ($blocked) { |
| |
return (); |
| |
} |
| |
my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum); |
| if ($lastchange > $env{'request.course.tied'}) { |
if ($lastchange > $env{'request.course.tied'}) { |
| my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); |
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); |
| if ($curr_reqd_hash{'internal.releaserequired'} ne '') { |
if ($curr_reqd_hash{'internal.releaserequired'} ne '') { |
|
Line 16903 sub recurse_supplemental {
|
Line 17368 sub recurse_supplemental {
|
| } |
} |
| |
|
| sub symb_to_docspath { |
sub symb_to_docspath { |
| my ($symb) = @_; |
my ($symb,$navmapref) = @_; |
| return unless ($symb); |
return unless ($symb && ref($navmapref)); |
| my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb); |
my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb); |
| if ($resurl=~/\.(sequence|page)$/) { |
if ($resurl=~/\.(sequence|page)$/) { |
| $mapurl=$resurl; |
$mapurl=$resurl; |
|
Line 16912 sub symb_to_docspath {
|
Line 17377 sub symb_to_docspath {
|
| $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'}; |
$mapurl=$env{'course.'.$env{'request.course.id'}.'.url'}; |
| } |
} |
| my $mapresobj; |
my $mapresobj; |
| my $navmap = Apache::lonnavmaps::navmap->new(); |
unless (ref($$navmapref)) { |
| if (ref($navmap)) { |
$$navmapref = Apache::lonnavmaps::navmap->new(); |
| $mapresobj = $navmap->getResourceByUrl($mapurl); |
} |
| |
if (ref($$navmapref)) { |
| |
$mapresobj = $$navmapref->getResourceByUrl($mapurl); |
| } |
} |
| $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1}; |
$mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1}; |
| my $type=$2; |
my $type=$2; |
|
Line 16924 sub symb_to_docspath {
|
Line 17391 sub symb_to_docspath {
|
| if ($pcslist ne '') { |
if ($pcslist ne '') { |
| foreach my $pc (split(/,/,$pcslist)) { |
foreach my $pc (split(/,/,$pcslist)) { |
| next if ($pc <= 1); |
next if ($pc <= 1); |
| my $res = $navmap->getByMapPc($pc); |
my $res = $$navmapref->getByMapPc($pc); |
| if (ref($res)) { |
if (ref($res)) { |
| my $thisurl = $res->src(); |
my $thisurl = $res->src(); |
| $thisurl=~s{^.*/([^/]+)\.\w+$}{$1}; |
$thisurl=~s{^.*/([^/]+)\.\w+$}{$1}; |
|
Line 17133 sub check_recaptcha {
|
Line 17600 sub check_recaptcha {
|
| my ($privkey,$version) = @_; |
my ($privkey,$version) = @_; |
| my $captcha_chk; |
my $captcha_chk; |
| if ($version >= 2) { |
if ($version >= 2) { |
| my $ua = LWP::UserAgent->new; |
|
| $ua->timeout(10); |
|
| my %info = ( |
my %info = ( |
| secret => $privkey, |
secret => $privkey, |
| response => $env{'form.g-recaptcha-response'}, |
response => $env{'form.g-recaptcha-response'}, |
| remoteip => $ENV{'REMOTE_ADDR'}, |
remoteip => $ENV{'REMOTE_ADDR'}, |
| ); |
); |
| my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info); |
my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify'); |
| |
$request->content(join('&',map { |
| |
my $name = escape($_); |
| |
"$name=" . ( ref($info{$_}) eq 'ARRAY' |
| |
? join("&$name=", map {escape($_) } @{$info{$_}}) |
| |
: &escape($info{$_}) ); |
| |
} keys(%info))); |
| |
my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1); |
| if ($response->is_success) { |
if ($response->is_success) { |
| my $data = JSON::DWIW->from_json($response->decoded_content); |
my $data = JSON::DWIW->from_json($response->decoded_content); |
| if (ref($data) eq 'HASH') { |
if (ref($data) eq 'HASH') { |
|
Line 17203 sub cleanup_html {
|
Line 17675 sub cleanup_html {
|
| |
|
| # Checks for critical messages and returns a redirect url if one exists. |
# Checks for critical messages and returns a redirect url if one exists. |
| # $interval indicates how often to check for messages. |
# $interval indicates how often to check for messages. |
| |
# $context is the calling context -- roles, grades, contents, menu or flip. |
| sub critical_redirect { |
sub critical_redirect { |
| my ($interval) = @_; |
my ($interval,$context) = @_; |
| if ((time-$env{'user.criticalcheck.time'})>$interval) { |
if ((time-$env{'user.criticalcheck.time'})>$interval) { |
| |
if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) { |
| |
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
| |
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; |
| |
my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1); |
| |
if ($blocked) { |
| |
my $checkrole = "cm./$cdom/$cnum"; |
| |
if ($env{'request.course.sec'} ne '') { |
| |
$checkrole .= "/$env{'request.course.sec'}"; |
| |
} |
| |
unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) && |
| |
($env{'request.role'} !~ m{^st\./$cdom/$cnum})) { |
| |
return; |
| |
} |
| |
} |
| |
} |
| my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, |
my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, |
| $env{'user.name'}); |
$env{'user.name'}); |
| &Apache::lonnet::appenv({'user.criticalcheck.time'=>time}); |
&Apache::lonnet::appenv({'user.criticalcheck.time'=>time}); |
![[BACK]](/icons/back.gif){kind=icon}
Return to loncommon.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface