--- loncom/lonnet/perl/lonnet.pm 2014/12/21 19:56:46 1.1172.2.58 +++ loncom/lonnet/perl/lonnet.pm 2015/04/09 18:24:44 1.1172.2.64 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.58 2014/12/21 19:56:46 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.64 2015/04/09 18:24:44 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -844,10 +844,8 @@ sub spareserver { if (ref($spareshash) eq 'HASH') { if (ref($spareshash->{'primary'}) eq 'ARRAY') { foreach my $try_server (@{ $spareshash->{'primary'} }) { - if ($uint_dom) { - next unless (&spare_can_host($udom,$uint_dom,$remotesessions, - $try_server)); - } + next unless (&spare_can_host($udom,$uint_dom,$remotesessions, + $try_server)); ($spare_server, $lowest_load) = &compare_server_load($try_server, $spare_server, $lowest_load); } @@ -858,10 +856,8 @@ sub spareserver { if (!$found_server) { if (ref($spareshash->{'default'}) eq 'ARRAY') { foreach my $try_server (@{ $spareshash->{'default'} }) { - if ($uint_dom) { - next unless (&spare_can_host($udom,$uint_dom, - $remotesessions,$try_server)); - } + next unless (&spare_can_host($udom,$uint_dom, + $remotesessions,$try_server)); ($spare_server, $lowest_load) = &compare_server_load($try_server, $spare_server, $lowest_load); } @@ -1173,19 +1169,27 @@ sub can_host_session { sub spare_can_host { my ($udom,$uint_dom,$remotesessions,$try_server)=@_; my $canhost=1; - my @intdoms; - my $internet_names = &Apache::lonnet::get_internet_names($try_server); - if (ref($internet_names) eq 'ARRAY') { - @intdoms = @{$internet_names}; - } - unless (grep(/^\Q$uint_dom\E$/,@intdoms)) { - my $serverhomeID = &Apache::lonnet::get_server_homeID($try_server); - my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID); - my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom); - my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$try_server); - $canhost = &can_host_session($udom,$try_server,$remoterev, - $remotesessions, - $defdomdefaults{'hostedsessions'}); + my $try_server_hostname = &hostname($try_server); + my $serverhomeID = &get_server_homeID($try_server_hostname); + my $serverhomedom = &host_domain($serverhomeID); + my %defdomdefaults = &get_domain_defaults($serverhomedom); + if (ref($defdomdefaults{'offloadnow'}) eq 'HASH') { + if ($defdomdefaults{'offloadnow'}{$try_server}) { + $canhost = 0; + } + } + if (($canhost) && ($uint_dom)) { + my @intdoms; + my $internet_names = &get_internet_names($try_server); + if (ref($internet_names) eq 'ARRAY') { + @intdoms = @{$internet_names}; + } + unless (grep(/^\Q$uint_dom\E$/,@intdoms)) { + my $remoterev = &get_server_loncaparev(undef,$try_server); + $canhost = &can_host_session($udom,$try_server,$remoterev, + $remotesessions, + $defdomdefaults{'hostedsessions'}); + } } return $canhost; } @@ -2070,6 +2074,11 @@ sub get_domain_defaults { } } if (ref($domconfig{'coursedefaults'}) eq 'HASH') { + $domdefaults{'usejsme'} = $domconfig{'coursedefaults'}{'usejsme'}; + $domdefaults{'uselcmath'} = $domconfig{'coursedefaults'}{'uselcmath'}; + if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') { + $domdefaults{'postsubmit'} = $domconfig{'coursedefaults'}{'postsubmit'}{'client'}; + } foreach my $type (@coursetypes) { if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') { unless ($type eq 'community') { @@ -2079,6 +2088,12 @@ sub get_domain_defaults { if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') { $domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type}; } + if ($domdefaults{'postsubmit'} eq 'on') { + if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') { + $domdefaults{$type.'postsubtimeout'} = + $domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}{$type}; + } + } } } if (ref($domconfig{'usersessions'}) eq 'HASH') { @@ -2088,6 +2103,9 @@ sub get_domain_defaults { if (ref($domconfig{'usersessions'}{'hosted'}) eq 'HASH') { $domdefaults{'hostedsessions'} = $domconfig{'usersessions'}{'hosted'}; } + if (ref($domconfig{'usersessions'}{'offloadnow'}) eq 'HASH') { + $domdefaults{'offloadnow'} = $domconfig{'usersessions'}{'offloadnow'}; + } } if (ref($domconfig{'selfenrollment'}) eq 'HASH') { if (ref($domconfig{'selfenrollment'}{'admin'}) eq 'HASH') { @@ -4935,7 +4953,7 @@ sub tmprestore { # ----------------------------------------------------------------------- Store sub store { - my ($storehash,$symb,$namespace,$domain,$stuname) = @_; + my ($storehash,$symb,$namespace,$domain,$stuname,$laststore) = @_; my $home=''; if ($stuname) { $home=&homeserver($stuname,$domain); } @@ -4965,13 +4983,13 @@ sub store { } $namevalue=~s/\&$//; &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue); - return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home"); + return reply("store:$domain:$stuname:$namespace:$symb:$namevalue:$laststore","$home"); } # -------------------------------------------------------------- Critical Store sub cstore { - my ($storehash,$symb,$namespace,$domain,$stuname) = @_; + my ($storehash,$symb,$namespace,$domain,$stuname,$laststore) = @_; my $home=''; if ($stuname) { $home=&homeserver($stuname,$domain); } @@ -5002,7 +5020,7 @@ sub cstore { $namevalue=~s/\&$//; &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue); return critical - ("store:$domain:$stuname:$namespace:$symb:$namevalue","$home"); + ("store:$domain:$stuname:$namespace:$symb:$namevalue:$laststore","$home"); } # --------------------------------------------------------------------- Restore @@ -5898,7 +5916,7 @@ sub newput { # --------------------------------------------------------- putstore interface sub putstore { - my ($namespace,$symb,$version,$storehash,$udomain,$uname)=@_; + my ($namespace,$symb,$version,$storehash,$udomain,$uname,$tolog)=@_; if (!$udomain) { $udomain=$env{'user.domain'}; } if (!$uname) { $uname=$env{'user.name'}; } my $uhome=&homeserver($uname,$udomain); @@ -5912,6 +5930,17 @@ sub putstore { my $reply = &reply("putstore:$udomain:$uname:$namespace:$esc_symb:$esc_v:$items", $uhome); + if (($tolog) && ($reply eq 'ok')) { + my $namevalue=''; + foreach my $key (keys(%{$storehash})) { + $namevalue.=&escape($key).'='.&freeze_escape($storehash->{$key}).'&'; + } + $namevalue .= 'ip='.&escape($ENV{'REMOTE_ADDR'}). + '&host='.&escape($perlvar{'lonHostID'}). + '&version='.$esc_v. + '&by='.&escape($env{'user.name'}.':'.$env{'user.domain'}); + &Apache::lonnet::courselog($symb.':'.$uname.':'.$udomain.':PUTSTORE:'.$namevalue); + } if ($reply eq 'unknown_cmd') { # gfall back to way things use to be done return &old_putstore($namespace,$symb,$version,$storehash,$udomain, @@ -7302,13 +7331,15 @@ sub has_comm_blocking { if ($mapsymb) { if (ref($navmap)) { my $mapres = $navmap->getBySymb($mapsymb); - @to_test = $mapres->retrieveResources($mapres,undef,0,1); + @to_test = $mapres->retrieveResources($mapres); foreach my $res (@to_test) { my $symb = $res->symb(); next if ($symb eq $mapsymb); if ($symb ne '') { @interval=&EXT("resource.0.interval",$symb); - last; + if ($interval[1] eq 'map') { + last; + } } } } @@ -12669,7 +12700,7 @@ were new keys. I.E. 1:foo will become 1: Calling convention: my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname); - &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname); + &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname,$laststore); For more detailed information, see lonnet specific documentation. @@ -13306,15 +13337,21 @@ homeserver. =item * -store($storehash,$symb,$namespace,$udom,$uname) : stores hash permanently -for this url; hashref needs to be given and should be a \%hashname; the -remaining args aren't required and if they aren't passed or are '' they will -be derived from the env +store($storehash,$symb,$namespace,$udom,$uname,$laststore) : stores hash +permanently for this url; hashref needs to be given and should be a \%hashname; +the remaining args aren't required and if they aren't passed or are '' they will +be derived from the env (with the exception of $laststore, which is an +optional arg used when a user's submission is stored in grading). +$laststore is $version=$timestamp, where $version is the most recent version +number retrieved for the corresponding $symb in the $namespace db file, and +$timestamp is the timestamp for that transaction (UNIX time). +$laststore is currently only passed when cstore() is called by +structuretags::finalize_storage(). =item * -cstore($storehash,$symb,$namespace,$udom,$uname) : same as store but -uses critical subroutine +cstore($storehash,$symb,$namespace,$udom,$uname,$laststore) : same as store +but uses critical subroutine =item * @@ -13337,10 +13374,11 @@ $range should be either an integer '100' =item * -putstore($namespace,$symb,$version,$storehash,$udomain,$uname) : +putstore($namespace,$symb,$version,$storehash,$udomain,$uname,$tolog) : replaces a &store() version of data with a replacement set of data for a particular resource in a namespace passed in the $storehash hash -reference +reference. If $tolog is true, the transaction is logged in the courselog +with an action=PUTSTORE. =item *