version 1.1333, 2019/08/25 02:42:56
|
version 1.1344, 2020/07/01 20:08:54
|
Line 80 use Text::Aspell;
|
Line 80 use Text::Aspell;
|
use Authen::Captcha; |
use Authen::Captcha; |
use Captcha::reCAPTCHA; |
use Captcha::reCAPTCHA; |
use JSON::DWIW; |
use JSON::DWIW; |
use LWP::UserAgent; |
|
use Crypt::DES; |
use Crypt::DES; |
use DynaLoader; # for Crypt::DES version |
use DynaLoader; # for Crypt::DES version |
use MIME::Lite; |
use MIME::Lite; |
Line 436 sub studentbrowser_javascript {
|
Line 435 sub studentbrowser_javascript {
|
<script type="text/javascript" language="Javascript"> |
<script type="text/javascript" language="Javascript"> |
// <![CDATA[ |
// <![CDATA[ |
var stdeditbrowser; |
var stdeditbrowser; |
function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) { |
function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) { |
var url = '/adm/pickstudent?'; |
var url = '/adm/pickstudent?'; |
var filter; |
var filter; |
if (!ignorefilter) { |
if (!ignorefilter) { |
Line 451 sub studentbrowser_javascript {
|
Line 450 sub studentbrowser_javascript {
|
'&udomelement='+udom+ |
'&udomelement='+udom+ |
'&clicker='+clicker; |
'&clicker='+clicker; |
if (roleflag) { url+="&roles=1"; } |
if (roleflag) { url+="&roles=1"; } |
if (courseadvonly) { url+="&courseadvonly=1"; } |
if (courseadv == 'condition') { |
|
if (document.getElementById('courseadv')) { |
|
courseadv = document.getElementById('courseadv').value; |
|
} |
|
} |
|
if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; } |
var title = 'Student_Browser'; |
var title = 'Student_Browser'; |
var options = 'scrollbars=1,resizable=1,menubar=0'; |
var options = 'scrollbars=1,resizable=1,menubar=0'; |
options += ',width=700,height=600'; |
options += ',width=700,height=600'; |
Line 483 ENDRESBRW
|
Line 487 ENDRESBRW
|
} |
} |
|
|
sub selectstudent_link { |
sub selectstudent_link { |
my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_; |
my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_; |
my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','". |
my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','". |
&Apache::lonhtmlcommon::entity_encode($unameele)."','". |
&Apache::lonhtmlcommon::entity_encode($unameele)."','". |
&Apache::lonhtmlcommon::entity_encode($udomele)."'"; |
&Apache::lonhtmlcommon::entity_encode($udomele)."'"; |
Line 494 sub selectstudent_link {
|
Line 498 sub selectstudent_link {
|
return ''; |
return ''; |
} |
} |
$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'"; |
$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'"; |
if ($courseadvonly) { |
if ($courseadv eq 'only') { |
$callargs .= ",'',1,1"; |
$callargs .= ",'',1,'$courseadv'"; |
|
} elsif ($courseadv eq 'none') { |
|
$callargs .= ",'','','$courseadv'"; |
|
} elsif ($courseadv eq 'condition') { |
|
$callargs .= ",'','','$courseadv'"; |
} |
} |
return '<span class="LC_nobreak">'. |
return '<span class="LC_nobreak">'. |
'<a href="javascript:openstdbrowser('.$callargs.');">'. |
'<a href="javascript:openstdbrowser('.$callargs.');">'. |
Line 3627 sub check_passwd_rules {
|
Line 3635 sub check_passwd_rules {
|
$rulenames{'min'} = &mt('Minimum password length: [_1]',$min); |
$rulenames{'min'} = &mt('Minimum password length: [_1]',$min); |
$rulenames{'max'} = &mt('Maximum password length: [_1]',$max); |
$rulenames{'max'} = &mt('Maximum password length: [_1]',$max); |
$warning = &mt('Password did not satisfy the following:').'<ul>'; |
$warning = &mt('Password did not satisfy the following:').'<ul>'; |
foreach my $rule ('min','max','uc','ls','num','spec') { |
foreach my $rule ('min','max','uc','lc','num','spec') { |
if (grep(/^$rule$/,@brokerule)) { |
if (grep(/^$rule$/,@brokerule)) { |
$warning .= '<li>'.$rulenames{$rule}.'</li>'; |
$warning .= '<li>'.$rulenames{$rule}.'</li>'; |
} |
} |
Line 5508 sub check_ip_acc {
|
Line 5516 sub check_ip_acc {
|
if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { |
if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { |
return 1; |
return 1; |
} |
} |
my $allowed; |
my ($ip,$allowed); |
my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'}; |
if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') || |
|
($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) { |
|
$ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip; |
|
} else { |
|
$ip = $ENV{'REMOTE_ADDR'} || $env{'request.host'} || $clientip; |
|
} |
|
|
my $name; |
my $name; |
my %access = ( |
my %access = ( |
Line 7258 table.LC_prior_tries td {
|
Line 7271 table.LC_prior_tries td {
|
padding: 6px; |
padding: 6px; |
} |
} |
|
|
.LC_answer_unknown { |
.LC_answer_unknown, |
|
.LC_answer_warning { |
background: orange; |
background: orange; |
color: black; |
color: black; |
padding: 6px; |
padding: 6px; |
Line 8254 ul.LC_funclist li {
|
Line 8268 ul.LC_funclist li {
|
cursor:pointer; |
cursor:pointer; |
} |
} |
|
|
|
pre.LC_wordwrap { |
|
white-space: pre-wrap; |
|
white-space: -moz-pre-wrap; |
|
white-space: -pre-wrap; |
|
white-space: -o-pre-wrap; |
|
word-wrap: break-word; |
|
} |
|
|
/* |
/* |
styles used for response display |
styles used for response display |
*/ |
*/ |
Line 8504 ADDMETA
|
Line 8526 ADDMETA
|
my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'}; |
my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'}; |
unless (&Apache::lonnet::allowed('mau',$dom_in_use)) { |
unless (&Apache::lonnet::allowed('mau',$dom_in_use)) { |
my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use); |
my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use); |
|
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; |
|
my $offload; |
if (ref($domdefs{'offloadnow'}) eq 'HASH') { |
if (ref($domdefs{'offloadnow'}) eq 'HASH') { |
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; |
|
if ($domdefs{'offloadnow'}{$lonhost}) { |
if ($domdefs{'offloadnow'}{$lonhost}) { |
my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use); |
$offload = 1; |
if (($newserver) && ($newserver ne $lonhost)) { |
} |
my $numsec = 5; |
} |
my $timeout = $numsec * 1000; |
unless ($offload) { |
my ($newurl,$locknum,%locks,$msg); |
if (ref($domdefs{'offloadoth'}) eq 'HASH') { |
if ($env{'request.role.adv'}) { |
if ($domdefs{'offloadoth'}{$lonhost}) { |
($locknum,%locks) = &Apache::lonnet::get_locks(); |
if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) && |
} |
(!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) { |
my $disable_submit = 0; |
unless (&Apache::lonnet::shared_institution($env{'user.domain'})) { |
if ($requrl =~ /$LONCAPA::assess_re/) { |
$offload = 1; |
$disable_submit = 1; |
$dom_in_use = $env{'user.domain'}; |
|
} |
} |
} |
if ($locknum) { |
} |
my @lockinfo = sort(values(%locks)); |
} |
$msg = &mt('Once the following tasks are complete: ')."\\n". |
} |
join(", ",sort(values(%locks)))."\\n". |
if ($offload) { |
&mt('your session will be transferred to a different server, after you click "Roles".'); |
my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use); |
|
if (($newserver) && ($newserver ne $lonhost)) { |
|
my $numsec = 5; |
|
my $timeout = $numsec * 1000; |
|
my ($newurl,$locknum,%locks,$msg); |
|
if ($env{'request.role.adv'}) { |
|
($locknum,%locks) = &Apache::lonnet::get_locks(); |
|
} |
|
my $disable_submit = 0; |
|
if ($requrl =~ /$LONCAPA::assess_re/) { |
|
$disable_submit = 1; |
|
} |
|
if ($locknum) { |
|
my @lockinfo = sort(values(%locks)); |
|
$msg = &mt('Once the following tasks are complete: ')."\n". |
|
join(", ",sort(values(%locks)))."\n"; |
|
if (&show_course()) { |
|
$msg .= &mt('your session will be transferred to a different server, after you click "Courses".'); |
} else { |
} else { |
if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) { |
$msg .= &mt('your session will be transferred to a different server, after you click "Roles".'); |
$msg = &mt('Your LON-CAPA submission has been recorded')."\\n"; |
} |
} |
} else { |
$msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec); |
if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) { |
$newurl = '/adm/switchserver?otherserver='.$newserver; |
$msg = &mt('Your LON-CAPA submission has been recorded')."\n"; |
if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) { |
} |
$newurl .= '&role='.$env{'request.role'}; |
$msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec); |
|
$newurl = '/adm/switchserver?otherserver='.$newserver; |
|
if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) { |
|
$newurl .= '&role='.$env{'request.role'}; |
|
} |
|
if ($env{'request.symb'}) { |
|
my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'}); |
|
if ($shownsymb =~ m{^/enc/}) { |
|
my $reqdmajor = 2; |
|
my $reqdminor = 11; |
|
my $reqdsubminor = 3; |
|
my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver); |
|
my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver); |
|
my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/); |
|
if (($major eq '' && $minor eq '') || |
|
(($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) || |
|
(($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') || |
|
($reqdsubminor > $subminor))))) { |
|
undef($shownsymb); |
|
} |
} |
} |
if ($env{'request.symb'}) { |
if ($shownsymb) { |
$newurl .= '&symb='.$env{'request.symb'}; |
&js_escape(\$shownsymb); |
} else { |
$newurl .= '&symb='.$shownsymb; |
$newurl .= '&origurl='.$requrl; |
|
} |
} |
|
} else { |
|
my $shownurl = &Apache::lonenc::check_encrypt($requrl); |
|
&js_escape(\$shownurl); |
|
$newurl .= '&origurl='.$shownurl; |
} |
} |
&js_escape(\$msg); |
} |
$result.=<<OFFLOAD |
&js_escape(\$msg); |
|
$result.=<<OFFLOAD |
<meta http-equiv="pragma" content="no-cache" /> |
<meta http-equiv="pragma" content="no-cache" /> |
<script type="text/javascript"> |
<script type="text/javascript"> |
// <![CDATA[ |
// <![CDATA[ |
Line 8561 function LC_Offload_Now() {
|
Line 8625 function LC_Offload_Now() {
|
// ]]> |
// ]]> |
</script> |
</script> |
OFFLOAD |
OFFLOAD |
} |
|
} |
} |
} |
} |
} |
} |
Line 9010 sub modal_link {
|
Line 9073 sub modal_link {
|
$target_attr = 'target="'.$target.'"'; |
$target_attr = 'target="'.$target.'"'; |
} |
} |
return <<"ENDLINK"; |
return <<"ENDLINK"; |
<a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;"> |
<a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a> |
$linktext</a> |
|
ENDLINK |
ENDLINK |
} |
} |
|
|
Line 15167 Inputs:
|
Line 15229 Inputs:
|
|
|
from - Sender's email address |
from - Sender's email address |
|
|
|
replyto - Reply-To email address |
|
|
to - Email address of recipient |
to - Email address of recipient |
|
|
subject - Subject of email |
subject - Subject of email |
Line 15177 cc_string - Carbon copy email ad
|
Line 15241 cc_string - Carbon copy email ad
|
|
|
bcc - Blind carbon copy email address |
bcc - Blind carbon copy email address |
|
|
type - File type of attachment |
|
|
|
attachment_path - Path of file to be attached |
attachment_path - Path of file to be attached |
|
|
file_name - Name of file to be attached |
file_name - Name of file to be attached |
Line 15195 attachment_text - The body of an attac
|
Line 15257 attachment_text - The body of an attac
|
############################################################ |
############################################################ |
|
|
sub mime_email { |
sub mime_email { |
my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path, |
my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path, |
$file_name, $attachment_text) = @_; |
$file_name,$attachment_text) = @_; |
|
|
my $msg = MIME::Lite->new( |
my $msg = MIME::Lite->new( |
From => $from, |
From => $from, |
To => $to, |
To => $to, |
Line 15204 sub mime_email {
|
Line 15267 sub mime_email {
|
Type =>'TEXT', |
Type =>'TEXT', |
Data => $body, |
Data => $body, |
); |
); |
|
if ($replyto ne '') { |
|
$msg->add("Reply-To" => $replyto); |
|
} |
if ($cc_string ne '') { |
if ($cc_string ne '') { |
$msg->add("Cc" => $cc_string); |
$msg->add("Cc" => $cc_string); |
} |
} |
Line 15802 sub check_clone {
|
Line 15868 sub check_clone {
|
my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'}; |
my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'}; |
my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid); |
my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid); |
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom); |
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom); |
my $clonemsg; |
my $clonetitle; |
|
my @clonemsg; |
my $can_clone = 0; |
my $can_clone = 0; |
my $lctype = lc($args->{'crstype'}); |
my $lctype = lc($args->{'crstype'}); |
if ($lctype ne 'community') { |
if ($lctype ne 'community') { |
Line 15810 sub check_clone {
|
Line 15877 sub check_clone {
|
} |
} |
if ($clonehome eq 'no_host') { |
if ($clonehome eq 'no_host') { |
if ($args->{'crstype'} eq 'Community') { |
if ($args->{'crstype'} eq '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 non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); |
push(@clonemsg,({ |
|
mt => 'No new community created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.', |
|
args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}], |
|
})); |
} else { |
} else { |
$clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); |
push(@clonemsg,({ |
} |
mt => 'No new course created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.', |
|
args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}], |
|
})); |
|
} |
} else { |
} else { |
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1}); |
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1}); |
|
$clonetitle = $clonedesc{'description'}; |
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'}); |
push(@clonemsg,({ |
return ($can_clone, $clonemsg, $cloneid, $clonehome); |
mt => 'No new community created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.', |
|
args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}], |
|
})); |
|
return ($can_clone,\@clonemsg,$cloneid,$clonehome); |
} |
} |
} |
} |
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && |
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && |
Line 15908 sub check_clone {
|
Line 15997 sub check_clone {
|
} |
} |
unless ($can_clone) { |
unless ($can_clone) { |
if ($args->{'crstype'} eq 'Community') { |
if ($args->{'crstype'} eq 'Community') { |
$clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}); |
push(@clonemsg,({ |
|
mt => 'No new community created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).', |
|
args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}], |
|
})); |
} else { |
} else { |
$clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}); |
push(@clonemsg,({ |
|
mt => 'No new course created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).', |
|
args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}], |
|
})); |
} |
} |
} |
} |
} |
} |
} |
} |
return ($can_clone, $clonemsg, $cloneid, $clonehome); |
return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle); |
} |
} |
|
|
sub construct_course { |
sub construct_course { |
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, |
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, |
$cnum,$category,$coderef) = @_; |
$cnum,$category,$coderef,$callercontext,$user_lh) = @_; |
my $outcome; |
my ($outcome,$msgref,$clonemsgref); |
my $linefeed = '<br />'."\n"; |
my $linefeed = '<br />'."\n"; |
if ($context eq 'auto') { |
if ($context eq 'auto') { |
$linefeed = "\n"; |
$linefeed = "\n"; |
Line 15930 sub construct_course {
|
Line 16033 sub construct_course {
|
# |
# |
# Are we cloning? |
# Are we cloning? |
# |
# |
my ($can_clone, $clonemsg, $cloneid, $clonehome); |
my ($can_clone,$cloneid,$clonehome,$clonetitle); |
if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) { |
if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) { |
($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed); |
($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed); |
if ($context ne 'auto') { |
|
if ($clonemsg ne '') { |
|
$clonemsg = '<span class="LC_error">'.$clonemsg.'</span>'; |
|
} |
|
} |
|
$outcome .= $clonemsg.$linefeed; |
|
|
|
if (!$can_clone) { |
if (!$can_clone) { |
return (0,$outcome); |
return (0,$outcome,$clonemsgref); |
} |
} |
} |
} |
|
|
Line 15964 sub construct_course {
|
Line 16060 sub construct_course {
|
$args->{'ccuname'}.':'. |
$args->{'ccuname'}.':'. |
$args->{'ccdomain'}, |
$args->{'ccdomain'}, |
$args->{'crstype'}, |
$args->{'crstype'}, |
$cnum,$context,$category); |
$cnum,$context,$category, |
|
$callercontext); |
|
|
# Note: The testing routines depend on this being output; see |
# Note: The testing routines depend on this being output; see |
# Utils::Course. This needs to at least be output as a comment |
# Utils::Course. This needs to at least be output as a comment |
# if anyone ever decides to not show this, and Utils::Course::new |
# if anyone ever decides to not show this, and Utils::Course::new |
# will need to be suitably modified. |
# will need to be suitably modified. |
$outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed; |
if (($callercontext eq 'auto') && ($user_lh ne '')) { |
|
$outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed; |
|
} else { |
|
$outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed; |
|
} |
if ($$courseid =~ /^error:/) { |
if ($$courseid =~ /^error:/) { |
return (0,$outcome); |
return (0,$outcome,$clonemsgref); |
} |
} |
|
|
# |
# |
Line 15981 sub construct_course {
|
Line 16082 sub construct_course {
|
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid); |
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid); |
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom); |
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom); |
if ($crsuhome eq 'no_host') { |
if ($crsuhome eq 'no_host') { |
$outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed; |
if (($callercontext eq 'auto') && ($user_lh ne '')) { |
return (0,$outcome); |
$outcome .= &mt_user($user_lh, |
|
'Course creation failed, unrecognized course home server.'); |
|
} else { |
|
$outcome .= &mt('Course creation failed, unrecognized course home server.'); |
|
} |
|
$outcome .= $linefeed; |
|
return (0,$outcome,$clonemsgref); |
} |
} |
$outcome .= &mt('Created on').': '.$crsuhome.$linefeed; |
$outcome .= &mt('Created on').': '.$crsuhome.$linefeed; |
|
|
# |
# |
# Do the cloning |
# Do the cloning |
# |
# |
|
my @clonemsg; |
if ($can_clone && $cloneid) { |
if ($can_clone && $cloneid) { |
$clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome); |
push(@clonemsg, |
if ($context ne 'auto') { |
{ |
$clonemsg = '<span class="LC_success">'.$clonemsg.'</span>'; |
mt => 'Created [_1] by cloning from [_2]', |
} |
args => [$showncrstype,$clonetitle], |
$outcome .= $clonemsg.$linefeed; |
}); |
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); |
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); |
# Copy all files |
# Copy all files |
&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'}); |
my @info = |
|
&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'}, |
|
$args->{'dateshift'},$args->{'crscode'}, |
|
$args->{'ccuname'}.':'.$args->{'ccdomain'}, |
|
$args->{'tinyurls'}); |
|
if (@info) { |
|
push(@clonemsg,@info); |
|
} |
# Restore URL |
# Restore URL |
$cenv{'url'}=$oldcenv{'url'}; |
$cenv{'url'}=$oldcenv{'url'}; |
# Restore title |
# Restore title |
Line 16264 sub construct_course {
|
Line 16379 sub construct_course {
|
# Open all assignments |
# Open all assignments |
# |
# |
if ($args->{'openall'}) { |
if ($args->{'openall'}) { |
|
my $opendate = time; |
|
if ($args->{'openallfrom'} =~ /^\d+$/) { |
|
$opendate = $args->{'openallfrom'}; |
|
} |
my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate'; |
my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate'; |
my %storecontent = ($storeunder => time, |
my %storecontent = ($storeunder => $opendate, |
$storeunder.'.type' => 'date_start'); |
$storeunder.'.type' => 'date_start'); |
|
$outcome .= &mt('All assignments open starting [_1]', |
$outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput |
&Apache::lonlocal::locallocaltime($opendate)).': '. |
('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed; |
&Apache::lonnet::cput |
|
('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed; |
} |
} |
# |
# |
# Set first page |
# Set first page |
Line 16323 sub construct_course {
|
Line 16443 sub construct_course {
|
('resourcedata',\%storecontent,$$crsudom,$$crsunum); |
('resourcedata',\%storecontent,$$crsudom,$$crsunum); |
} |
} |
|
|
return (1,$outcome); |
return (1,$outcome,\@clonemsg); |
} |
} |
|
|
sub make_unique_code { |
sub make_unique_code { |
Line 18129 sub des_decrypt {
|
Line 18249 sub des_decrypt {
|
return $plaintext; |
return $plaintext; |
} |
} |
|
|
sub make_short_symbs { |
sub get_requested_shorturls { |
my ($cdom,$cnum,$navmap) = @_; |
my ($cdom,$cnum,$navmap) = @_; |
return unless (ref($navmap)); |
return unless (ref($navmap)); |
my ($numnew,@errors); |
my ($numnew,$errors); |
my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny'); |
my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny'); |
if (@toshorten) { |
if (@toshorten) { |
my (%maps,%resources,%titles); |
my (%maps,%resources,%titles); |
&Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles, |
&Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles, |
'shorturls',$cdom,$cnum); |
'shorturls',$cdom,$cnum); |
my %tocreate; |
|
if (keys(%resources)) { |
if (keys(%resources)) { |
|
my %tocreate; |
foreach my $item (sort {$a <=> $b} (@toshorten)) { |
foreach my $item (sort {$a <=> $b} (@toshorten)) { |
my $symb = $resources{$item}; |
my $symb = $resources{$item}; |
if ($symb) { |
if ($symb) { |
$tocreate{$cnum.'&'.$symb} = 1; |
$tocreate{$cnum.'&'.$symb} = 1; |
} |
} |
} |
} |
|
if (keys(%tocreate)) { |
|
($numnew,$errors) = &make_short_symbs($cdom,$cnum, |
|
\%tocreate); |
|
} |
} |
} |
|
} |
|
return ($numnew,$errors); |
|
} |
|
|
|
sub make_short_symbs { |
|
my ($cdom,$cnum,$tocreateref,$lockuser) = @_; |
|
my ($numnew,@errors); |
|
if (ref($tocreateref) eq 'HASH') { |
|
my %tocreate = %{$tocreateref}; |
if (keys(%tocreate)) { |
if (keys(%tocreate)) { |
my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum); |
my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum); |
my $su = Short::URL->new(no_vowels => 1); |
my $su = Short::URL->new(no_vowels => 1); |
Line 18154 sub make_short_symbs {
|
Line 18287 sub make_short_symbs {
|
my (%newunique,%addcourse,%courseonly,%failed); |
my (%newunique,%addcourse,%courseonly,%failed); |
# get lock on tiny db |
# get lock on tiny db |
my $now = time; |
my $now = time; |
|
if ($lockuser eq '') { |
|
$lockuser = $env{'user.name'}.':'.$env{'user.domain'}; |
|
} |
my $lockhash = { |
my $lockhash = { |
"lock\0$now" => $env{'user.name'}. |
"lock\0$now" => $lockuser, |
':'.$env{'user.domain'}, |
|
}; |
}; |
my $tries = 0; |
my $tries = 0; |
my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom); |
my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom); |