[LON-CAPA-cvs] cvs: loncom /interface domainprefs.pm loncommon.pm /lonnet/perl lonnet.pm

raeburn raeburn at source.lon-capa.org
Wed Apr 1 19:22:14 EDT 2015


raeburn		Wed Apr  1 23:22:14 2015 EDT

  Modified files:              
    /loncom/interface	domainprefs.pm loncommon.pm 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Bug 6771
    Domain configuration to switch active users from a server in the domain.
    - When the page has loaded on the session hosting server, javascript will
      cause display of an alert and will switch user's session to another server 
      in the domain, after 5s. Submit buttons for homewrk problems disabled for
      those 5s.    
  
  
-------------- next part --------------
Index: loncom/interface/domainprefs.pm
diff -u loncom/interface/domainprefs.pm:1.260 loncom/interface/domainprefs.pm:1.261
--- loncom/interface/domainprefs.pm:1.260	Wed Apr  1 23:02:44 2015
+++ loncom/interface/domainprefs.pm	Wed Apr  1 23:22:10 2015
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Handler to set domain-wide configuration settings
 #
-# $Id: domainprefs.pm,v 1.260 2015/04/01 23:02:44 raeburn Exp $
+# $Id: domainprefs.pm,v 1.261 2015/04/01 23:22:10 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3299,7 +3299,13 @@
     if ($position eq 'top') {
         if (keys(%serverhomes) > 1) {
             my %spareid = &current_offloads_to($dom,$settings,\%servers);
-            $datatable .= &spares_row($dom,\%servers,\%spareid,\%serverhomes,\%altids,$rowtotal);
+            my $curroffloadnow;
+            if (ref($settings) eq 'HASH') {
+                if (ref($settings->{'offloadnow'}) eq 'HASH') {
+                    $curroffloadnow = $settings->{'offloadnow'};
+                }
+            }
+            $datatable .= &spares_row($dom,\%servers,\%spareid,\%serverhomes,\%altids,$curroffloadnow,$rowtotal);
         } else {
             $datatable .= '<tr'.$css_class.'><td colspan="2">'.
                           &mt('Nothing to set here, as the cluster to which this domain belongs only contains one server.');
@@ -3549,7 +3555,7 @@
 }
 
 sub spares_row {
-    my ($dom,$servers,$spareid,$serverhomes,$altids,$rowtotal) = @_;
+    my ($dom,$servers,$spareid,$serverhomes,$altids,$curroffloadnow,$rowtotal) = @_;
     my $css_class;
     my $numinrow = 4;
     my $itemcount = 1;
@@ -3569,12 +3575,21 @@
                 }
             }
             next unless (ref($spareid->{$server}) eq 'HASH');
+            my $checkednow;
+            if (ref($curroffloadnow) eq 'HASH') {
+                if ($curroffloadnow->{$server}) {
+                    $checkednow = ' checked="checked"';
+                }
+            }
             $css_class = $itemcount%2 ? ' class="LC_odd_row"' : '';
             $datatable .= '<tr'.$css_class.'>
                            <td rowspan="2">
                             <span class="LC_nobreak">'.
                           &mt('[_1] when busy, offloads to:'
-                              ,'<b>'.$server.'</b>').
+                              ,'<b>'.$server.'</b>').'</span><br />'.
+                          '<span class="LC_nobreak">'."\n". 
+                          '<label><input type="checkbox" name="offloadnow" value="'.$server.'"'.$checkednow.' />'.
+                          ' '.&mt('Switch active users on next access').'</label></span>'.
                           "\n";
             my (%current,%canselect);
             my @choices = 
@@ -10933,7 +10948,23 @@
             $changes{'spares'}{$lonhost} = \%spareschg;
         }
     }
-
+    $defaultshash{'usersessions'}{'offloadnow'} = {};
+    my @offloadnow = &Apache::loncommon::get_env_multiple('form.offloadnow');
+    my @okoffload;
+    if (@offloadnow) {
+        foreach my $server (@offloadnow) {
+            if (&Apache::lonnet::hostname($server) ne '') {
+                unless (grep(/^\Q$server\E$/, at okoffload)) {
+                    push(@okoffload,$server);
+                }
+            }
+        }
+        if (@okoffload) {
+            foreach my $lonhost (@okoffload) {
+                $defaultshash{'usersessions'}{'offloadnow'}{$lonhost} = 1;
+            }
+        }
+    }
     if (ref($domconfig{'usersessions'}) eq 'HASH') {
         if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') {
             if (ref($changes{'spares'}) eq 'HASH') {
@@ -10944,8 +10975,27 @@
         } else {
             $savespares = 1;
         }
+        if (ref($domconfig{'usersessions'}{'offloadnow'}) eq 'HASH') {
+            foreach my $lonhost (keys(%{$domconfig{'usersessions'}{'offloadnow'}})) {
+                unless ($defaultshash{'usersessions'}{'offloadnow'}{$lonhost}) {
+                    $changes{'offloadnow'} = 1;
+                    last;
+                }
+            }
+            unless ($changes{'offloadnow'}) {
+                foreach my $lonhost (keys(%{$defaultshash{'usersessions'}{'offloadnow'}})) { 
+                    unless ($domconfig{'usersessions'}{'offloadnow'}{$lonhost}) {
+                        $changes{'offloadnow'} = 1;
+                        last;
+                    }
+                }
+            }
+        } elsif (@okoffload) {
+            $changes{'offloadnow'} = 1;
+        }
+    } elsif (@okoffload) {
+        $changes{'offloadnow'} = 1;
     }
-
     my $nochgmsg = &mt('No changes made to settings for user session hosting/offloading.');
     if ((keys(%changes) > 0) || ($savespares)) {
         my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash,
@@ -10958,6 +11008,9 @@
                 if (ref($defaultshash{'usersessions'}{'hosted'}) eq 'HASH') {
                     $domdefaults{'hostedsessions'} = $defaultshash{'usersessions'}{'hosted'};
                 }
+                if (ref($defaultshash{'usersessions'}{'offloadnow'}) eq 'HASH') {
+                    $domdefaults{'offloadnow'} = $defaultshash{'usersessions'}{'offloadnow'};
+                }
             }
             my $cachetime = 24*60*60;
             &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime);
@@ -11026,6 +11079,21 @@
                         $resulttext .= '</ul>';
                     }
                 }
+                if ($changes{'offloadnow'}) {
+                    if (ref($defaultshash{'usersessions'}{'offloadnow'}) eq 'HASH') {
+                        if (keys(%{$defaultshash{'usersessions'}{'offloadnow'}}) > 0) {
+                            $resulttext .= '<li>'.&mt('Switch active users on next access, for server(s):').'<ul>';
+                            foreach my $lonhost (sort(keys(%{$defaultshash{'usersessions'}{'offloadnow'}}))) {
+                                $resulttext .= '<li>'.$lonhost.'</li>';
+                            }
+                            $resulttext .= '</ul>';
+                        } else {
+                            $resulttext .= '<li>'.&mt('No servers now set to switch active users on next access.');
+                        }
+                    } else {
+                        $resulttext .= '<li>'.&mt('No servers now set to switch active users on next access.').'</li>';
+                    }
+                }
                 $resulttext .= '</ul>';
             } else {
                 $resulttext = $nochgmsg;
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1209 loncom/interface/loncommon.pm:1.1210
--- loncom/interface/loncommon.pm:1.1209	Mon Mar  9 19:09:34 2015
+++ loncom/interface/loncommon.pm	Wed Apr  1 23:22:10 2015
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1209 2015/03/09 19:09:34 raeburn Exp $
+# $Id: loncommon.pm,v 1.1210 2015/04/01 23:22:10 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -7700,6 +7700,79 @@
 <meta http-equiv="pragma" content="no-cache" />
 <meta http-equiv="Refresh" content="$time; url=$url" />
 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
+<meta http-equiv="pragma" content="no-cache" />
+<script type="text/javascript">
+function LC_Offload_Now() {
+    var dest = "$newurl";
+    if (dest != '') {
+        window.location.href="$newurl";
+    }
+}
+window.alert('$msg');
+if ($disable_submit) {
+    \$(document).ready(function () {
+        \$(".LC_hwk_submit").prop("disabled", true);
+        \$( ".LC_textline" ).prop( "readonly", "readonly");
+    });
+}
+setTimeout('LC_Offload_Now()', $timeout);
+</script>
+OFFLOAD
+                            }
+                        }
+                    }
+                }
+            }
+        }
     }
     if (!defined($title)) {
 	$title = 'The LearningOnline Network with CAPA';
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1278 loncom/lonnet/perl/lonnet.pm:1.1279
--- loncom/lonnet/perl/lonnet.pm:1.1278	Mon Mar 30 21:13:24 2015
+++ loncom/lonnet/perl/lonnet.pm	Wed Apr  1 23:22:13 2015
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1278 2015/03/30 21:13:24 raeburn Exp $
+# $Id: lonnet.pm,v 1.1279 2015/04/01 23:22:13 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -849,10 +849,8 @@
     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);
             }
@@ -863,10 +861,8 @@
         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);
                 }
@@ -1178,20 +1174,27 @@
 sub spare_can_host {
     my ($udom,$uint_dom,$remotesessions,$try_server)=@_;
     my $canhost=1;
-    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$/, at intdoms)) {
-        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);
-        my $remoterev = &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$/, at intdoms)) {
+            my $remoterev = &get_server_loncaparev(undef,$try_server);
+            $canhost = &can_host_session($udom,$try_server,$remoterev,
+                                         $remotesessions,
+                                         $defdomdefaults{'hostedsessions'});
+        }
     }
     return $canhost;
 }
@@ -2106,6 +2109,9 @@
         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') {


More information about the LON-CAPA-cvs mailing list