'."\n";
}
sub end_data_table_header_row {
@@ -9428,8 +11028,8 @@ sub simple_error_page {
}
sub data_table_caption {
- my $caption = shift;
- return "$caption ";
+ my ($caption,$css_class) = @_;
+ return "$caption ";
}
}
@@ -9533,6 +11133,16 @@ Scalar: 1 if 'Course' to be used, 0 othe
###############################################
sub show_course {
+ my ($udom,$uname) = @_;
+ if (($udom ne '') && ($uname ne '')) {
+ if (($udom ne $env{'user.domain'}) || ($uname ne $env{'user.name'})) {
+ if (&Apache::lonnet::is_advanced_user($udom,$uname)) {
+ return 0;
+ } else {
+ return 1;
+ }
+ }
+ }
my $course = !$env{'user.adv'};
if (!$env{'user.adv'}) {
foreach my $env (keys(%env)) {
@@ -10850,11 +12460,15 @@ sub sorted_inst_types {
}
sub get_institutional_codes {
- my ($settings,$allcourses,$LC_code) = @_;
+ my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
# Get complete list of course sections to update
my @currsections = ();
my @currxlists = ();
+ my (%unclutteredsec,%unclutteredlcsec);
my $coursecode = $$settings{'internal.coursecode'};
+ my $crskey = $crs.':'.$coursecode;
+ @{$unclutteredsec{$crskey}} = ();
+ @{$unclutteredlcsec{$crskey}} = ();
if ($$settings{'internal.sectionnums'} ne '') {
@currsections = split(/,/,$$settings{'internal.sectionnums'});
@@ -10865,8 +12479,8 @@ sub get_institutional_codes {
}
if (@currxlists > 0) {
- foreach (@currxlists) {
- if (m/^([^:]+):(\w*)$/) {
+ foreach my $xl (@currxlists) {
+ if ($xl =~ /^([^:]+):(\w*)$/) {
unless (grep/^$1$/,@{$allcourses}) {
push(@{$allcourses},$1);
$$LC_code{$1} = $2;
@@ -10874,15 +12488,28 @@ sub get_institutional_codes {
}
}
}
-
+
if (@currsections > 0) {
- foreach (@currsections) {
- if (m/^(\w+):(\w*)$/) {
- my $sec = $coursecode.$1;
+ foreach my $sec (@currsections) {
+ if ($sec =~ m/^(\w+):(\w*)$/ ) {
+ my $instsec = $1;
my $lc_sec = $2;
- unless (grep/^$sec$/,@{$allcourses}) {
+ unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
+ push(@{$unclutteredsec{$crskey}},$instsec);
+ push(@{$unclutteredlcsec{$crskey}},$lc_sec);
+ }
+ }
+ }
+ }
+
+ if (@{$unclutteredsec{$crskey}} > 0) {
+ my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
+ if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
+ for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
+ my $sec = $coursecode.$formattedsec{$crskey}[$i];
+ unless (grep/^\Q$sec\E$/,@{$allcourses}) {
push(@{$allcourses},$sec);
- $$LC_code{$sec} = $lc_sec;
+ $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
}
}
}
@@ -13490,7 +15117,9 @@ sub process_extracted_files {
my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
$docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
$title;
- if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
+ if (($outer !~ /\D/) &&
+ (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) &&
+ ($newidx !~ /\D/)) {
if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
}
@@ -14070,12 +15699,12 @@ sub upfile_select_html {
tab => &mt('Tabulator separated'),
# xml => &mt('HTML/XML'),
);
- my $Str = '';
+ my $Str = ''.&mt('Type').': ';
foreach my $type (sort(keys(%Types))) {
$Str .= ''.$Types{$type}." \n";
}
- $Str .= " \n";
+ $Str .= " \n";
return $Str;
}
@@ -14159,9 +15788,9 @@ sub csv_print_select_table {
&end_data_table_header_row()."\n");
foreach my $array_ref (@$d) {
my ($value,$display,$defaultcol)=@{ $array_ref };
- $r->print(&start_data_table_row().''.$display.' ');
+ $r->print(&start_data_table_row().''.$display.' print('');
$r->print('');
+ ' onchange="javascript:flip(this.form,'.$i.');" aria-label="'.$labeltext.'">');
foreach my $option (@$d) {
my ($value,$display,$defaultcol)=@{ $option };
$r->print('new(
From => $from,
To => $to,
@@ -15131,6 +16763,9 @@ sub mime_email {
Type =>'TEXT',
Data => $body,
);
+ if ($replyto ne '') {
+ $msg->add("Reply-To" => $replyto);
+ }
if ($cc_string ne '') {
$msg->add("Cc" => $cc_string);
}
@@ -15541,27 +17176,33 @@ sub assign_category_rows {
sub commit_customrole {
- my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
+ my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context,$othdomby,$requester) = @_;
+ my $result = &Apache::lonnet::assigncustomrole(
+ $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,
+ $context,$othdomby,$requester);
my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
($start?', '.&mt('starting').' '.localtime($start):'').
- ($end?', ending '.localtime($end):'').': '.
- &Apache::lonnet::assigncustomrole(
- $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
- ' '.$result.' '.$result.' '.$linefeed;
}
}
- return $output;
+ if (wantarray) {
+ return ($output,$result);
+ } else {
+ return $output;
+ }
}
sub commit_studentrole {
my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
- $credits) = @_;
+ $credits,$othdomby,$requester) = @_;
my ($result,$linefeed,$oldsecurl,$newsecurl);
if ($context eq 'auto') {
$linefeed = "\n";
@@ -15617,8 +17263,9 @@ sub commit_studentrole {
}
$oldsecurl = $uurl;
$expire_role_result =
- &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
- if ($env{'request.course.sec'} ne '') {
+ &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,
+ '','','',$context,$othdomby,$requester);
+ if ($env{'request.course.sec'} ne '') {
if ($expire_role_result eq 'refused') {
my @roles = ('st');
my @statuses = ('previous');
@@ -15644,7 +17291,8 @@ sub commit_studentrole {
&Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
undef,undef,undef,$sec,
$end,$start,'','',$cid,
- '',$context,$credits);
+ '',$context,$credits,'',
+ $othdomby,$requester);
if ($modify_section_result =~ /^ok/) {
if ($secchange == 1) {
if ($sec eq '') {
@@ -15729,7 +17377,8 @@ sub check_clone {
my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
- my $clonemsg;
+ my $clonetitle;
+ my @clonemsg;
my $can_clone = 0;
my $lctype = lc($args->{'crstype'});
if ($lctype ne 'community') {
@@ -15737,16 +17386,38 @@ sub check_clone {
}
if ($clonehome eq 'no_host') {
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 {
- $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 {
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
+ $clonetitle = $clonedesc{'description'};
if ($args->{'crstype'} eq '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'});
- return ($can_clone, $clonemsg, $cloneid, $clonehome);
+ 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 course not a community.',
+ args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
+ }));
+ return ($can_clone,\@clonemsg,$cloneid,$clonehome);
}
}
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
@@ -15835,20 +17506,34 @@ sub check_clone {
}
unless ($can_clone) {
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 {
- $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 {
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
- $cnum,$category,$coderef) = @_;
- my $outcome;
+ $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
+ my ($outcome,$msgref,$clonemsgref);
my $linefeed = ''.$clonemsg.' ';
- }
- }
- $outcome .= $clonemsg.$linefeed;
-
+ ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
if (!$can_clone) {
- return (0,$outcome);
+ return (0,$outcome,$clonemsgref);
}
}
@@ -15891,15 +17569,20 @@ sub construct_course {
$args->{'ccuname'}.':'.
$args->{'ccdomain'},
$args->{'crstype'},
- $cnum,$context,$category);
+ $cnum,$context,$category,
+ $callercontext);
# Note: The testing routines depend on this being output; see
# Utils::Course. This needs to at least be output as a comment
# if anyone ever decides to not show this, and Utils::Course::new
# 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:/) {
- return (0,$outcome);
+ return (0,$outcome,$clonemsgref);
}
#
@@ -15908,23 +17591,37 @@ sub construct_course {
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
if ($crsuhome eq 'no_host') {
- $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
- return (0,$outcome);
+ if (($callercontext eq 'auto') && ($user_lh ne '')) {
+ $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;
#
# Do the cloning
#
+ my @clonemsg;
if ($can_clone && $cloneid) {
- $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome);
- if ($context ne 'auto') {
- $clonemsg = ''.$clonemsg.' ';
- }
- $outcome .= $clonemsg.$linefeed;
+ push(@clonemsg,
+ {
+ mt => 'Created [_1] by cloning from [_2]',
+ args => [$showncrstype,$clonetitle],
+ });
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
# 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
$cenv{'url'}=$oldcenv{'url'};
# Restore title
@@ -15949,8 +17646,7 @@ sub construct_course {
'plc.users.denied',
'hidefromcat',
'checkforpriv',
- 'categories',
- 'internal.uniquecode'],
+ 'categories'],
$$crsudom,$$crsunum);
if ($args->{'textbook'}) {
$cenv{'internal.textbook'} = $args->{'textbook'};
@@ -15965,6 +17661,9 @@ sub construct_course {
if ($args->{'crstype'}) {
$cenv{'type'}=$args->{'crstype'};
}
+ if ($args->{'lti'}) {
+ $cenv{'internal.lti'}=$args->{'lti'};
+ }
if ($args->{'crsid'}) {
$cenv{'courseid'}=$args->{'crsid'};
}
@@ -15986,6 +17685,7 @@ sub construct_course {
$cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
}
my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
+ my @oklcsecs = (); # Used to accumulate LON-CAPA sections for validated institutional sections.
if ($args->{'crssections'}) {
$cenv{'internal.sectionnums'} = '';
if ($args->{'crssections'} =~ m/,/) {
@@ -15999,7 +17699,11 @@ sub construct_course {
my $class = $args->{'crscode'}.$sec;
my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
$cenv{'internal.sectionnums'} .= $item.',';
- unless ($addcheck eq 'ok') {
+ if ($addcheck eq 'ok') {
+ unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
+ push(@oklcsecs,$gp);
+ }
+ } else {
push(@badclasses,$class);
}
}
@@ -16027,7 +17731,11 @@ sub construct_course {
my ($xl,$gp) = split/:/,$item;
my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
$cenv{'internal.crosslistings'} .= $item.',';
- unless ($addcheck eq 'ok') {
+ if ($addcheck eq 'ok') {
+ unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
+ push(@oklcsecs,$gp);
+ }
+ } else {
push(@badclasses,$xl);
}
}
@@ -16090,6 +17798,36 @@ sub construct_course {
if ($args->{'no_end_date'}) {
$args->{'endaccess'} = 0;
}
+# If an official course with institutional sections is created by cloning
+# an existing course, section-specific hiding of course totals in student's
+# view of grades as copied from cloned course, will be checked for valid
+# sections.
+ if (($can_clone && $cloneid) &&
+ ($cenv{'internal.coursecode'} ne '') &&
+ ($cenv{'grading'} eq 'standard') &&
+ ($cenv{'hidetotals'} ne '') &&
+ ($cenv{'hidetotals'} ne 'all')) {
+ my @hidesecs;
+ my $deletehidetotals;
+ if (@oklcsecs) {
+ foreach my $sec (split(/,/,$cenv{'hidetotals'})) {
+ if (grep(/^\Q$sec$/,@oklcsecs)) {
+ push(@hidesecs,$sec);
+ }
+ }
+ if (@hidesecs) {
+ $cenv{'hidetotals'} = join(',',@hidesecs);
+ } else {
+ $deletehidetotals = 1;
+ }
+ } else {
+ $deletehidetotals = 1;
+ }
+ if ($deletehidetotals) {
+ delete($cenv{'hidetotals'});
+ &Apache::lonnet::del('environment',['hidetotals'],$$crsudom,$$crsunum);
+ }
+ }
$cenv{'internal.autostart'}=$args->{'enrollstart'};
$cenv{'internal.autoend'}=$args->{'enrollend'};
$cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
@@ -16191,19 +17929,23 @@ sub construct_course {
# Open all assignments
#
if ($args->{'openall'}) {
+ my $opendate = time;
+ if ($args->{'openallfrom'} =~ /^\d+$/) {
+ $opendate = $args->{'openallfrom'};
+ }
my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
- my %storecontent = ($storeunder => time,
+ my %storecontent = ($storeunder => $opendate,
$storeunder.'.type' => 'date_start');
-
- $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
- ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
+ $outcome .= &mt('All assignments open starting [_1]',
+ &Apache::lonlocal::locallocaltime($opendate)).': '.
+ &Apache::lonnet::cput
+ ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
}
#
# Set first page
#
unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
|| ($cloneid)) {
- use LONCAPA::map;
$outcome .= &mt('Setting first resource').': ';
my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
@@ -16250,7 +17992,7 @@ sub construct_course {
('resourcedata',\%storecontent,$$crsudom,$$crsunum);
}
- return (1,$outcome);
+ return (1,$outcome,\@clonemsg);
}
sub make_unique_code {
@@ -16446,7 +18188,8 @@ sub init_user_environment {
my $public=($username eq 'public' && $domain eq 'public');
- my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
+ my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv,
+ $coauthorenv);
my $now=time;
if ($public) {
@@ -16512,7 +18255,7 @@ sub init_user_environment {
# Initialize roles
- ($userroles,$firstaccenv,$timerintenv) =
+ ($userroles,$firstaccenv,$timerintenv,$coauthorenv) =
&Apache::lonnet::rolesinit($domain,$username,$authhost);
}
# ------------------------------------ Check browser type and MathML capability
@@ -16539,6 +18282,7 @@ sub init_user_environment {
# --------------------------------------------------------- Write first profile
{
+ my $ip = &Apache::lonnet::get_requestor_ip($r);
my %initial_env =
("user.name" => $username,
"user.domain" => $domain,
@@ -16557,7 +18301,7 @@ sub init_user_environment {
"request.course.sec" => '',
"request.role" => 'cm',
"request.role.adv" => $env{'user.adv'},
- "request.host" => $ENV{'REMOTE_ADDR'},);
+ "request.host" => $ip,);
if ($form->{'localpath'}) {
$initial_env{"browser.localpath"} = $form->{'localpath'};
@@ -16589,8 +18333,8 @@ sub init_user_environment {
my %is_adv = ( is_adv => $env{'user.adv'} );
my %domdef = &Apache::lonnet::get_domain_defaults($domain);
- foreach my $tool ('aboutme','blog','webdav','portfolio') {
- $userenv{'availabletools.'.$tool} =
+ foreach my $tool ('aboutme','blog','webdav','portfolio','portaccess','timezone') {
+ $userenv{'availabletools.'.$tool} =
&Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
undef,\%userenv,\%domdef,\%is_adv);
}
@@ -16602,6 +18346,23 @@ sub init_user_environment {
\%userenv,\%domdef,\%is_adv);
}
+ if ((ref($userroles) eq 'HASH') && ($userroles->{'user.author'}) &&
+ (exists($userroles->{"user.role.au./$domain/"}))) {
+ if ($userenv{'authoreditors'}) {
+ $userenv{'editors'} = $userenv{'authoreditors'};
+ } elsif ($domdef{'editors'} ne '') {
+ $userenv{'editors'} = $domdef{'editors'};
+ } else {
+ $userenv{'editors'} = 'edit,xml';
+ }
+ if ($userenv{'authorarchive'}) {
+ $userenv{'canarchive'} = 1;
+ } elsif (($userenv{'authorarchive'} eq '') &&
+ ($domdef{'archive'})) {
+ $userenv{'canarchive'} = 1;
+ }
+ }
+
$userenv{'canrequest.author'} =
&Apache::lonnet::usertools_access($username,$domain,'requestauthor',
'reload','requestauthor',
@@ -16658,6 +18419,11 @@ sub init_user_environment {
if (ref($timerintenv) eq 'HASH') {
&_add_to_env(\%disk_env,$timerintenv);
}
+ if (ref($coauthorenv) eq 'HASH') {
+ if (keys(%{$coauthorenv})) {
+ &_add_to_env(\%disk_env,$coauthorenv);
+ }
+ }
if (ref($args->{'extra_env'})) {
&_add_to_env(\%disk_env,$args->{'extra_env'});
}
@@ -17383,7 +19149,7 @@ Returns: HTML to display with informatio
sub check_release_result {
my ($switchwarning,$switchserver) = @_;
my $output = &start_page('Selected course unavailable on this server').
- '';
+ '
'.&end_page();
return $output;
}
@@ -17458,34 +19224,58 @@ sub needs_coursereinit {
}
if (($now-$env{'request.course.timechecked'})>$interval) {
&Apache::lonnet::appenv({'request.course.timechecked'=>$now});
- my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
+ my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
if ($blocked) {
return ();
}
- my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
- if ($lastchange > $env{'request.course.tied'}) {
- my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
- if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
- my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
- if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
- &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
- $curr_reqd_hash{'internal.releaserequired'}});
- my ($switchserver,$switchwarning) =
- &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
- $curr_reqd_hash{'internal.releaserequired'});
- if ($switchwarning ne '' || $switchserver ne '') {
- return ('switch',$switchwarning,$switchserver);
- }
+ my $update;
+ my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
+ my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum);
+ if ($lastmainchange > $env{'request.course.tied'}) {
+ my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
+ if ($needswitch) {
+ return ('switch',$switchwarning,$switchserver);
+ }
+ $update = 'main';
+ }
+ if ($lastsuppchange > $env{'request.course.suppupdated'}) {
+ if ($update) {
+ $update = 'both';
+ } else {
+ my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
+ if ($needswitch) {
+ return ('switch',$switchwarning,$switchserver);
+ } else {
+ $update = 'supp';
}
}
- return ('update');
+ }
+ return ($update);
+ }
+ return ();
+}
+
+sub switch_for_update {
+ my ($loncaparev,$cdom,$cnum) = @_;
+ my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
+ if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
+ my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
+ if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
+ &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
+ $curr_reqd_hash{'internal.releaserequired'}});
+ my ($switchserver,$switchwarning) =
+ &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
+ $curr_reqd_hash{'internal.releaserequired'});
+ if ($switchwarning ne '' || $switchserver ne '') {
+ return ('switch',$switchwarning,$switchserver);
+ }
}
}
return ();
}
sub update_content_constraints {
- my ($cdom,$cnum,$chome,$cid,$keeporder) = @_;
+ my ($cdom,$cnum,$chome,$cid) = @_;
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
my (%checkresponsetypes,%checkcrsrestypes);
@@ -17533,25 +19323,7 @@ sub update_content_constraints {
}
undef($navmap);
}
- my (@resources,@order,@resparms,@zombies);
- if ($keeporder) {
- use LONCAPA::map;
- @resources = @LONCAPA::map::resources;
- @order = @LONCAPA::map::order;
- @resparms = @LONCAPA::map::resparms;
- @zombies = @LONCAPA::map::zombies;
- }
- my $suppmap = 'supplemental.sequence';
- my ($suppcount,$supptools,$errors) = (0,0,0);
- ($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap,
- $suppcount,$supptools,$errors);
- if ($keeporder) {
- @LONCAPA::map::resources = @resources;
- @LONCAPA::map::order = @order;
- @LONCAPA::map::resparms = @resparms;
- @LONCAPA::map::zombies = @zombies;
- }
- if ($supptools) {
+ if (&Apache::lonnet::count_supptools($cnum,$cdom,1)) {
my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
($reqdmajor,$reqdminor) = ($major,$minor);
@@ -17577,7 +19349,7 @@ sub allmaps_incourse {
if ($lastchange > $env{'request.course.tied'}) {
my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
unless ($ferr) {
- &update_content_constraints($cdom,$cnum,$chome,$cid,1);
+ &update_content_constraints($cdom,$cnum,$chome,$cid);
}
}
my $navmap = Apache::lonnavmaps::navmap->new();
@@ -17603,8 +19375,10 @@ sub parse_supplemental_title {
my $name = &plainname($uname,$udom);
$name = &HTML::Entities::encode($name,'"<>&\'');
$renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
- $title=''.&Apache::lonlocal::locallocaltime($time).' '.
- $name.': '.&Apache::lonlocal::locallocaltime($time).' '.$name;
+ if ($foldertitle ne '') {
+ $title .= ': '.
+ ''.&mt('Type in the letters/numbers shown below').' '.
+ '
';
+ return '
'.
+ '
';
} else {
my $use_ssl;
if ($ENV{'SERVER_PORT'} == 443) {
@@ -17896,11 +19848,12 @@ sub create_recaptcha {
sub check_recaptcha {
my ($privkey,$version) = @_;
my $captcha_chk;
+ my $ip = &Apache::lonnet::get_requestor_ip();
if ($version >= 2) {
my %info = (
secret => $privkey,
response => $env{'form.g-recaptcha-response'},
- remoteip => $ENV{'REMOTE_ADDR'},
+ remoteip => $ip,
);
my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
$request->content(join('&',map {
@@ -17923,7 +19876,7 @@ sub check_recaptcha {
my $captcha_result =
$captcha->check_answer(
$privkey,
- $ENV{'REMOTE_ADDR'},
+ $ip,
$env{'form.recaptcha_challenge_field'},
$env{'form.recaptcha_response_field'},
);
@@ -17975,11 +19928,14 @@ sub cleanup_html {
# $context is the calling context -- roles, grades, contents, menu or flip.
sub critical_redirect {
my ($interval,$context) = @_;
+ unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
+ return ();
+ }
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);
+ my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
if ($blocked) {
my $checkrole = "cm./$cdom/$cnum";
if ($env{'request.course.sec'} ne '') {
@@ -17996,7 +19952,7 @@ sub critical_redirect {
&Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
my $redirecturl;
if ($what[0]) {
- if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
+ if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
$redirecturl='/adm/email?critical=display';
my $url=&Apache::lonnet::absolute_url().$redirecturl;
return (1, $url);
@@ -18056,24 +20012,37 @@ sub des_decrypt {
return $plaintext;
}
-sub make_short_symbs {
+sub get_requested_shorturls {
my ($cdom,$cnum,$navmap) = @_;
return unless (ref($navmap));
- my ($numnew,@errors);
+ my ($numnew,$errors);
my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
if (@toshorten) {
my (%maps,%resources,%titles);
&Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
'shorturls',$cdom,$cnum);
- my %tocreate;
if (keys(%resources)) {
+ my %tocreate;
foreach my $item (sort {$a <=> $b} (@toshorten)) {
my $symb = $resources{$item};
if ($symb) {
$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)) {
my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
my $su = Short::URL->new(no_vowels => 1);
@@ -18081,9 +20050,11 @@ sub make_short_symbs {
my (%newunique,%addcourse,%courseonly,%failed);
# get lock on tiny db
my $now = time;
+ if ($lockuser eq '') {
+ $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
+ }
my $lockhash = {
- "lock\0$now" => $env{'user.name'}.
- ':'.$env{'user.domain'},
+ "lock\0$now" => $lockuser,
};
my $tries = 0;
my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
@@ -18195,7 +20166,7 @@ sub shorten_symbs {
sub is_nonframeable {
my ($url,$absolute,$hostname,$ip,$nocache) = @_;
my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
- return if (($remprotocol eq '') || ($remhost eq ''));
+ return if (($remprotocol eq '') || ($remhost eq ''));
$remprotocol = lc($remprotocol);
$remhost = lc($remhost);
@@ -18203,7 +20174,7 @@ sub is_nonframeable {
if ($remprotocol eq 'https') {
$remport = 443;
}
- my ($result,$cached) = &Apache::lonnet::is_cached_new('exturlnoiframe',$remhost.':'.$remport);
+ my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
if ($cached) {
unless ($nocache) {
if ($result) {
@@ -18343,6 +20314,37 @@ sub is_nonframeable {
return $uselink;
}
+sub page_menu {
+ my ($menucolls,$menunum) = @_;
+ my %menu;
+ foreach my $item (split(/;/,$menucolls)) {
+ my ($num,$value) = split(/\%/,$item);
+ if ($num eq $menunum) {
+ my @entries = split(/\&/,$value);
+ foreach my $entry (@entries) {
+ my ($name,$fields) = split(/=/,$entry);
+ if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
+ $menu{$name} = $fields;
+ } else {
+ my @shown;
+ if ($fields =~ /,/) {
+ @shown = split(/,/,$fields);
+ } else {
+ @shown = ($fields);
+ }
+ if (@shown) {
+ foreach my $field (@shown) {
+ next if ($field eq '');
+ $menu{$field} = 1;
+ }
+ }
+ }
+ }
+ }
+ }
+ return %menu;
+}
+
1;
__END__;