--- loncom/interface/loncommon.pm 2014/06/24 00:31:38 1.1075.2.80
+++ loncom/interface/loncommon.pm 2015/04/06 19:06:45 1.1075.2.91
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1075.2.80 2014/06/24 00:31:38 raeburn Exp $
+# $Id: loncommon.pm,v 1.1075.2.91 2015/04/06 19:06:45 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) {
@@ -3716,13 +3721,18 @@ sub get_previous_attempt {
my %lasthash=();
my $version;
for ($version=1;$version<=$returnhash{'version'};$version++) {
- foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
- $lasthash{$key}=$returnhash{$version.':'.$key};
+ foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
+ if ($key =~ /\.rawrndseed$/) {
+ my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
+ $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
+ } else {
+ $lasthash{$key}=$returnhash{$version.':'.$key};
+ }
}
}
$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 +3749,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 +3772,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 .= ''.
+ ' '.
+ &mt('Hide').' ';
+ }
+ $prevattempts .= ' ';
if (@hidden) {
foreach my $key (sort(keys(%lasthash))) {
next if ($key =~ /\.foilorder$/);
@@ -3782,9 +3847,15 @@ sub get_previous_attempt {
}
} else {
if ($key =~ /\./) {
- my $value = &format_previous_attempt_value($key,
- $returnhash{$version.':'.$key});
- $prevattempts.=''.$value.' ';
+ my $value = $returnhash{$version.':'.$key};
+ if ($key =~ /\.rndseed$/) {
+ my ($id) = ($key =~ /^(.+)\.rndseed$/);
+ if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
+ $value = $returnhash{$version.':'.$id.'.rawrndseed'};
+ }
+ }
+ $prevattempts.=''.&format_previous_attempt_value($key,$value).
+ ' ';
} else {
$prevattempts.=' ';
}
@@ -3793,9 +3864,15 @@ sub get_previous_attempt {
} else {
foreach my $key (sort(keys(%lasthash))) {
next if ($key =~ /\.foilorder$/);
- my $value = &format_previous_attempt_value($key,
- $returnhash{$version.':'.$key});
- $prevattempts.=''.$value.' ';
+ my $value = $returnhash{$version.':'.$key};
+ if ($key =~ /\.rndseed$/) {
+ my ($id) = ($key =~ /^(.+)\.rndseed$/);
+ if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
+ $value = $returnhash{$version.':'.$id.'.rawrndseed'};
+ }
+ }
+ $prevattempts.=''.&format_previous_attempt_value($key,$value).
+ ' ';
}
}
$prevattempts.=&end_data_table_row();
@@ -4695,23 +4772,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'};
+ }
}
}
}
@@ -6611,6 +6693,10 @@ fieldset {
/* overflow: hidden; */
}
+article.geogebraweb div {
+ margin: 0;
+}
+
fieldset > legend {
font-weight: bold;
padding: 0 5px 0 5px;
@@ -7346,6 +7432,79 @@ sub headtag {
ADDMETA
+ } else {
+ unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
+ my $requrl = $env{'request.uri'};
+ if ($requrl eq '') {
+ $requrl = $ENV{'REQUEST_URI'};
+ $requrl =~ s/\?.+$//;
+ }
+ unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
+ (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
+ ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
+ my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
+ unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
+ my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
+ if (ref($domdefs{'offloadnow'}) eq 'HASH') {
+ my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
+ if ($domdefs{'offloadnow'}{$lonhost}) {
+ 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".
+ &mt('your session will be transferred to a different server, after you click "Roles".');
+ } else {
+ if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
+ $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
+ }
+ $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'}) {
+ $newurl .= '&symb='.$env{'request.symb'};
+ } else {
+ $newurl .= '&origurl='.$requrl;
+ }
+ }
+ $result.=<
+
+OFFLOAD
+ }
+ }
+ }
+ }
+ }
+ }
}
if (!defined($title)) {
$title = 'The LearningOnline Network with CAPA';
@@ -7672,10 +7831,12 @@ function set_wishlistlink(title, path) {
title = title.replace(/^LON-CAPA /,'');
}
title = encodeURIComponent(title);
+ title = title.replace("'","\\\'");
if (!path) {
path = location.pathname;
}
path = encodeURIComponent(path);
+ path = path.replace("'","\\\'");
Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
'wishlistNewLink','width=560,height=350,scrollbars=0');
}
@@ -7718,12 +7879,13 @@ var modalWindow = {
};
var openMyModal = function(source,width,height,scrolling,transparency,style)
{
+ source = source.replace("'","'");
modalWindow.windowId = "myModal";
modalWindow.width = width;
modalWindow.height = height;
modalWindow.content = "";
modalWindow.open();
- };
+ };
// END LON-CAPA Internal -->
// ]]>
@@ -8325,7 +8487,7 @@ role status: active, previous or future.
sub check_user_status {
my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
- my @uroles = keys %userinfo;
+ my @uroles = keys(%userinfo);
my $srchstr;
my $active_chk = 'none';
my $now = time;
@@ -11070,7 +11232,7 @@ sub decompress_form {
"$topdir/media/player.swf",
"$topdir/media/swfobject.js",
"$topdir/media/expressInstall.swf");
- my @camtasia8 = ("$topdir/","$topdir/$topdir.html",
+ my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
"$topdir/$topdir.mp4",
"$topdir/$topdir\_config.xml",
"$topdir/$topdir\_controller.swf",
@@ -11092,13 +11254,36 @@ sub decompress_form {
"$topdir/skins/express_show/",
"$topdir/skins/express_show/player-min.css",
"$topdir/skins/express_show/spritesheet.png");
+ my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
+ "$topdir/$topdir.mp4",
+ "$topdir/$topdir\_config.xml",
+ "$topdir/$topdir\_controller.swf",
+ "$topdir/$topdir\_embed.css",
+ "$topdir/$topdir\_First_Frame.png",
+ "$topdir/$topdir\_player.html",
+ "$topdir/$topdir\_Thumbnails.png",
+ "$topdir/playerProductInstall.swf",
+ "$topdir/scripts/",
+ "$topdir/scripts/config_xml.js",
+ "$topdir/scripts/techsmith-smart-player.min.js",
+ "$topdir/skins/",
+ "$topdir/skins/configuration_express.xml",
+ "$topdir/skins/express_show/",
+ "$topdir/skins/express_show/spritesheet.min.css",
+ "$topdir/skins/express_show/spritesheet.png",
+ "$topdir/skins/express_show/techsmith-smart-player.min.css");
my @diffs = &compare_arrays(\@paths,\@camtasia6);
if (@diffs == 0) {
$is_camtasia = 6;
} else {
- @diffs = &compare_arrays(\@paths,\@camtasia8);
+ @diffs = &compare_arrays(\@paths,\@camtasia8_1);
if (@diffs == 0) {
$is_camtasia = 8;
+ } else {
+ @diffs = &compare_arrays(\@paths,\@camtasia8_4);
+ if (@diffs == 0) {
+ $is_camtasia = 8;
+ }
}
}
}
@@ -14465,7 +14650,7 @@ sub escape_url {
my ($url) = @_;
my @urlslices = split(/\//, $url,-1);
my $lastitem = &escape(pop(@urlslices));
- return join('/',@urlslices).'/'.$lastitem;
+ return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
}
sub compare_arrays {
@@ -14523,6 +14708,17 @@ sub init_user_environment {
}
}
closedir(DIR);
+# If there is a undeleted lockfile for the user's paste buffer remove it.
+ my $namespace = 'nohist_courseeditor';
+ my $lockingkey = 'paste'."\0".'locked_num';
+ my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
+ $domain,$username);
+ if (exists($lockhash{$lockingkey})) {
+ my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
+ unless ($delresult eq 'ok') {
+ &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
+ }
+ }
}
# Give them a new cookie
my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
@@ -14941,7 +15137,12 @@ sub build_filters {
$output .= ' '."\n".
' '."\n";
- } elsif ($formname ne 'quotacheck') {
+ } elsif ($formname eq 'quotacheck') {
+ $output .= qq|
+
+
+|;
+ } else {
my $name_input;
if ($cnameelement ne '') {
$name_input = ' '.&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) = @_;