--- loncom/interface/loncommon.pm 2014/12/21 17:29:44 1.1075.2.85 +++ loncom/interface/loncommon.pm 2015/03/11 01:55:41 1.1075.2.88 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.85 2014/12/21 17:29:44 raeburn Exp $ +# $Id: loncommon.pm,v 1.1075.2.88 2015/03/11 01:55:41 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3677,7 +3677,7 @@ sub user_lang { =over 4 =item * &get_previous_attempt($symb, $username, $domain, $course, - $getattempt, $regexp, $gradesub) + $getattempt, $regexp, $gradesub, $usec, $identifier) Return string with previous attempt on problem. Arguments: @@ -3699,6 +3699,11 @@ Return string with previous attempt on p =item * $gradesub: routine that processes the string if it matches $regexp +=item * $usec: section of the desired student + +=item * $identifier: counter for student (multiple students one problem) or + problem (one student; whole sequence). + =back The output string is a table containing all desired attempts, if any. @@ -3706,7 +3711,7 @@ The output string is a table containing =cut sub get_previous_attempt { - my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_; + my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_; my $prevattempts=''; no strict 'refs'; if ($symb) { @@ -3722,7 +3727,7 @@ sub get_previous_attempt { } $prevattempts=&start_data_table().&start_data_table_header_row(); $prevattempts.=''.&mt('History').''; - my (%typeparts,%lasthidden); + my (%typeparts,%lasthidden,%regraded,%hidestatus); my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'}); foreach my $key (sort(keys(%lasthash))) { my ($ign,@parts) = split(/\./,$key); @@ -3739,6 +3744,18 @@ sub get_previous_attempt { $lasthidden{$ign.'.'.$id} = 1; } } + if ($identifier ne '') { + my $id = join(',',@parts); + if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb, + $domain,$username,$usec,undef,$course) =~ /^no/) { + $hidestatus{$ign.'.'.$id} = 1; + } + } + } elsif ($data eq 'regrader') { + if (($identifier ne '') && (@parts)) { + my $id = join(',',@parts); + $regraded{$ign.'.'.$id} = 1; + } } } else { if ($#parts == 0) { @@ -3750,17 +3767,60 @@ sub get_previous_attempt { } $prevattempts.=&end_data_table_header_row(); if ($getattempt eq '') { + my (%solved,%resets,%probstatus); + if (($identifier ne '') && (keys(%regraded) > 0)) { + for ($version=1;$version<=$returnhash{'version'};$version++) { + foreach my $id (keys(%regraded)) { + if (($returnhash{$version.':'.$id.'.regrader'}) && + ($returnhash{$version.':'.$id.'.tries'} eq '') && + ($returnhash{$version.':'.$id.'.award'} eq '')) { + push(@{$resets{$id}},$version); + } + } + } + } for ($version=1;$version<=$returnhash{'version'};$version++) { - my @hidden; + my (@hidden,@unsolved); if (%typeparts) { foreach my $id (keys(%typeparts)) { - if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) { + if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || + ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) { push(@hidden,$id); + } elsif ($identifier ne '') { + unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') || + ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') || + ($hidestatus{$id})) { + next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}})); + if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') { + push(@{$solved{$id}},$version); + } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') && + (ref($solved{$id}) eq 'ARRAY')) { + my $skip; + if (ref($resets{$id}) eq 'ARRAY') { + foreach my $reset (@{$resets{$id}}) { + if ($reset > $solved{$id}[-1]) { + $skip=1; + last; + } + } + } + unless ($skip) { + my ($ign,$partslist) = split(/\./,$id,2); + push(@unsolved,$partslist); + } + } + } } } } $prevattempts.=&start_data_table_row(). - ''.&mt('Transaction [_1]',$version).''; + ''.&mt('Transaction [_1]',$version); + if (@unsolved) { + $prevattempts .= ''; + } + $prevattempts .= ''; if (@hidden) { foreach my $key (sort(keys(%lasthash))) { next if ($key =~ /\.foilorder$/); @@ -4695,23 +4755,28 @@ sub get_domainconf { if (keys(%{$domconfig{'login'}})) { foreach my $key (keys(%{$domconfig{'login'}})) { if (ref($domconfig{'login'}{$key}) eq 'HASH') { - if ($key eq 'loginvia') { - if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') { - foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) { - if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') { - if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) { - my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'}; - $designhash{$udom.'.login.loginvia'} = $server; - if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') { - - $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'}; - } else { - $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'}; + if (($key eq 'loginvia') || ($key eq 'headtag')) { + if (ref($domconfig{'login'}{$key}) eq 'HASH') { + foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) { + if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') { + if ($key eq 'loginvia') { + if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) { + my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'}; + $designhash{$udom.'.login.loginvia'} = $server; + if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') { + $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'}; + } else { + $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'}; + } } - if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) { - $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}; + } elsif ($key eq 'headtag') { + if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) { + $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'}; } } + if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) { + $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'}; + } } } } @@ -7726,7 +7791,7 @@ var modalWindow = { modalWindow.height = height; modalWindow.content = ""; modalWindow.open(); - }; + }; // END LON-CAPA Internal --> // ]]> @@ -15280,8 +15345,206 @@ sub search_courses { =back +=head1 Routines for version requirements for current course. + +=over 4 + +=item * &check_release_required() + +Compares required LON-CAPA version with version on server, and +if required version is newer looks for a server with the required version. + +Looks first at servers in user's owen domain; if none suitable, looks at +servers in course's domain are permitted to host sessions for user's domain. + +Inputs: + +$loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp) + +$courseid - Course ID of current course + +$rolecode - User's current role in course (for switchserver query string). + +$required - LON-CAPA version needed by course (format: Major.Minor). + + +Returns: + +$switchserver - query string tp append to /adm/switchserver call (if + current server's LON-CAPA version is too old. + +$warning - Message is displayed if no suitable server could be found. + =cut +sub check_release_required { + my ($loncaparev,$courseid,$rolecode,$required) = @_; + my ($switchserver,$warning); + if ($required ne '') { + my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/); + my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); + if ($reqdmajor ne '' && $reqdminor ne '') { + my $otherserver; + if (($major eq '' && $minor eq '') || + (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) { + my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1); + my $switchlcrev = + &Apache::lonnet::get_server_loncaparev($env{'user.domain'}, + $userdomserver); + my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); + if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) || + (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) { + my $cdom = $env{'course.'.$courseid.'.domain'}; + if ($cdom ne $env{'user.domain'}) { + my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1); + my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname); + my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID); + my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom); + my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'}); + my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver); + my $canhost = + &Apache::lonnet::can_host_session($env{'user.domain'}, + $coursedomserver, + $remoterev, + $udomdefaults{'remotesessions'}, + $defdomdefaults{'hostedsessions'}); + + if ($canhost) { + $otherserver = $coursedomserver; + } else { + $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'
'. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain."); + } + } else { + $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$courseid.'.internal.releaserequired'}).'
'.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain)."); + } + } else { + $otherserver = $userdomserver; + } + } + if ($otherserver ne '') { + $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode; + } + } + } + return ($switchserver,$warning); +} + +=pod + +=item * &check_release_result() + +Inputs: + +$switchwarning - Warning message if no suitable server found to host session. + +$switchserver - query string to append to /adm/switchserver containing lonHostID + and current role. + +Returns: HTML to display with information about requirement to switch server. + Either displaying warning with link to Roles/Courses screen or + display link to switchserver. + +=cut + +sub check_release_result { + my ($switchwarning,$switchserver) = @_; + my $output = &start_page('Selected course unavailable on this server'). + '

'; + if ($switchwarning) { + $output .= $switchwarning.'
'; + if (&show_course()) { + $output .= &mt('Display courses'); + } else { + $output .= &mt('Display roles'); + } + $output .= ''; + } elsif ($switchserver) { + $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.'). + '
'. + ''. + &mt('Switch Server'). + ''; + } + $output .= '

'.&end_page(); + return $output; +} + +=pod + +=item * &needs_coursereinit() + +Determine if course contents stored for user's session needs to be +refreshed, because content has changed since "Big Hash" last tied. + +Check for change is made if time last checked is more than 10 minutes ago +(by default). + +Inputs: + +$loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp) + +$interval (optional) - Time which may elapse (in s) between last check for content + change in current course. (default: 600 s). + +Returns: an array; first element is: + +=over 4 + +'switch' - if content updates mean user's session + needs to be switched to a server running a newer LON-CAPA version + +'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded) + on current server hosting user's session + +'' - if no action required. + +=back + +If first item element is 'switch': + +second item is $switchwarning - Warning message if no suitable server found to host session. + +third item is $switchserver - query string to append to /adm/switchserver containing lonHostID + and current role. + +otherwise: no other elements returned. + +=back + +=cut + +sub needs_coursereinit { + my ($loncaparev,$interval) = @_; + return() unless ($env{'request.course.id'} && $env{'request.course.tied'}); + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my $now = time; + if ($interval eq '') { + $interval = 600; + } + if (($now-$env{'request.course.timechecked'})>$interval) { + my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum); + &Apache::lonnet::appenv({'request.course.timechecked'=>$now}); + 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); + } + } + } + return ('update'); + } + } + return (); +} sub update_content_constraints { my ($cdom,$cnum,$chome,$cid) = @_;