--- loncom/interface/domainprefs.pm 2011/07/29 14:25:36 1.144 +++ loncom/interface/domainprefs.pm 2011/07/31 23:05:00 1.145 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: domainprefs.pm,v 1.144 2011/07/29 14:25:36 raeburn Exp $ +# $Id: domainprefs.pm,v 1.145 2011/07/31 23:05:00 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -352,9 +352,11 @@ sub handler { col2 => 'Value',}], }, 'usersessions' => - {text => 'User session hosting', + {text => 'User session hosting/offloading', help => 'Domain_Configuration_User_Sessions', - header => [{col1 => 'Hosting of users from other domains', + header => [{col1 => 'Domain server', + col2 => 'Servers to offload sessions to when busy'}, + {col1 => 'Hosting of users from other domains', col2 => 'Rules'}, {col1 => "Hosting domain's own users elsewhere", col2 => 'Rules'}], @@ -488,16 +490,20 @@ sub print_config_box { } if ($numheaders > 1) { my $colspan = ''; + my $rightcolspan = ''; if (($action eq 'rolecolors') || ($action eq 'coursecategories') || ($action eq 'helpsettings')) { $colspan = ' colspan="2"'; } + if ($action eq 'usersessions') { + $rightcolspan = ' colspan="3"'; + } $output .= ' - + '; $rowtotal ++; if ($action eq 'autoupdate') { @@ -583,7 +589,18 @@ sub print_config_box { } elsif ($action eq 'helpsettings') { $output .= &print_helpsettings('bottom',$dom,$confname,$settings,\$rowtotal); } elsif ($action eq 'usersessions') { - $output .= &print_usersessions('bottom',$dom,$settings,\$rowtotal); + $output .= &print_usersessions('middle',$dom,$settings,\$rowtotal).' +
'.&mt($item->{'header'}->[0]->{'col1'}).''.&mt($item->{'header'}->[0]->{'col2'}).''.&mt($item->{'header'}->[0]->{'col2'}).'
+ + + + + + + + '. + &print_usersessions('bottom',$dom,$settings,\$rowtotal); + $rowtotal ++; } elsif ($action eq 'coursedefaults') { $output .= &print_coursedefaults('bottom',$dom,$settings,\$rowtotal); } elsif ($action eq 'rolecolors') { @@ -2287,118 +2304,131 @@ sub print_usersessions { my ($css_class,$datatable,%checked,%choices); my (%by_ip,%by_location,@intdoms); &build_location_hashes(\@intdoms,\%by_ip,\%by_location); - if (keys(%by_location) == 0) { - if ($position eq 'top') { - $datatable .= ''; - $itemcount ++; } $$rowtotal += $itemcount; return $datatable; @@ -2452,6 +2482,156 @@ sub build_location_hashes { return; } +sub current_offloads_to { + my ($dom,$settings,$servers) = @_; + my (%spareid,%otherdomconfigs); + if ((ref($settings) eq 'HASH') && (ref($servers) eq 'HASH')) { + foreach my $lonhost (sort(keys(%{$servers}))) { + my $gotspares; + if (ref($settings->{'spares'}) eq 'HASH') { + if (ref($settings->{'spares'}{$lonhost}) eq 'HASH') { + $spareid{$lonhost}{'primary'} = $settings->{'spares'}{$lonhost}{'primary'}; + $spareid{$lonhost}{'default'} = $settings->{'spares'}{$lonhost}{'default'}; + $gotspares = 1; + } + } + unless ($gotspares) { + my $gotspares; + my $serverhomeID = + &Apache::lonnet::get_server_homeID($servers->{$lonhost}); + my $serverhomedom = + &Apache::lonnet::host_domain($serverhomeID); + if ($serverhomedom ne $dom) { + if (ref($otherdomconfigs{$serverhomedom} eq 'HASH')) { + if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}) eq 'HASH') { + if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}) eq 'HASH') { + $spareid{$lonhost}{'primary'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'primary'}; + $spareid{$lonhost}{'default'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'default'}; + $gotspares = 1; + } + } + } else { + $otherdomconfigs{$serverhomedom} = + &Apache::lonnet::get_dom('configuration',['usersessions'],$serverhomedom); + if (ref($otherdomconfigs{$serverhomedom}) eq 'HASH') { + if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}) eq 'HASH') { + if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}) eq 'HASH') { + if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{$lonhost}) eq 'HASH') { + $spareid{$lonhost}{'primary'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'primary'}; + $spareid{$lonhost}{'default'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'default'}; + $gotspares = 1; + } + } + } + } + } + } + } + unless ($gotspares) { + if ($lonhost eq $Apache::lonnet::perlvar{'lonHostID'}) { + $spareid{$lonhost}{'primary'} = $Apache::lonnet::spareid{'primary'}; + $spareid{$lonhost}{'default'} = $Apache::lonnet::spareid{'default'}; + } else { + my $server_hostname = &Apache::lonnet::hostname($lonhost); + my $server_homeID = &Apache::lonnet::get_server_homeID($server_hostname); + if ($server_homeID eq $Apache::lonnet::perlvar{'lonHostID'}) { + $spareid{$lonhost}{'primary'} = $Apache::lonnet::spareid{'primary'}; + $spareid{$lonhost}{'default'} = $Apache::lonnet::spareid{'default'}; + } else { + my %requested; + $requested{'spareid'} = 'HASH'; + my %returnhash = &Apache::lonnet::get_remote_globals($lonhost,\%requested); + my $spareshash = $returnhash{'spareid'}; + if (ref($spareshash) eq 'HASH') { + $spareid{$lonhost}{'primary'} = $spareshash->{'primary'}; + $spareid{$lonhost}{'default'} = $spareshash->{'default'}; + } + } + } + } + } + } + return %spareid; +} + +sub spares_row { + my ($servers,$spareid,$uniques,$rowtotal) = @_; + my $css_class; + my $numinrow = 4; + my $itemcount = 1; + my $datatable; + if ((ref($servers) eq 'HASH') && (ref($spareid) eq 'HASH')) { + foreach my $server (sort(keys(%{$servers}))) { + $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + $datatable .= ' + '; + my (%current,%canselect); + if (ref($spareid->{$server}) eq 'HASH') { + foreach my $type ('primary','default') { + if (ref($spareid->{$server}{$type}) eq 'ARRAY') { + my @spares = @{$spareid->{$server}{$type}}; + if (@spares > 0) { + $current{$type} .= '
'.&mt($item->{'header'}->[2]->{'col1'}).''.&mt($item->{'header'}->[2]->{'col2'}).'
'. - &mt('Nothing to set here, as the cluster to which this domain belongs only contains this institution.'); - } - } - my %lt = &usersession_titles(); + + my @alldoms = &Apache::lonnet::all_domains(); + my %uniques = &Apache::lonnet::get_unique_servers(\@alldoms); + my %servers = &dom_servers($dom); my $itemcount = 1; - my $numinrow = 5; - my $prefix; - my @types; if ($position eq 'top') { - $prefix = 'hosted'; - @types = ('excludedomain','includedomain'); + if (keys(%uniques) > 1) { + my %spareid = ¤t_offloads_to($dom,$settings,\%servers); + $datatable .= &spares_row(\%servers,\%spareid,\%uniques,$rowtotal); + } else { + $datatable .= ''. + &mt('Nothing to set here, as the cluster to which this domain belongs only contains this server.'); + } } else { - $prefix = 'remote'; - @types = ('version','excludedomain','includedomain'); - } - my (%current,%checkedon,%checkedoff); - my @lcversions = &Apache::lonnet::all_loncaparevs(); - my @locations = sort(keys(%by_location)); - foreach my $type (@types) { - $checkedon{$type} = ''; - $checkedoff{$type} = ' checked="checked"'; - } - if (ref($settings) eq 'HASH') { - if (ref($settings->{$prefix}) eq 'HASH') { - foreach my $key (keys(%{$settings->{$prefix}})) { - $current{$key} = $settings->{$prefix}{$key}; - if ($key eq 'version') { - if ($current{$key} ne '') { - $checkedon{$key} = ' checked="checked"'; - $checkedoff{$key} = ''; - } - } elsif (ref($current{$key}) eq 'ARRAY') { - $checkedon{$key} = ' checked="checked"'; - $checkedoff{$key} = ''; - } + if (keys(%by_location) == 0) { + $datatable .= ''. + &mt('Nothing to set here, as the cluster to which this domain belongs only contains this institution.'); + } else { + my %lt = &usersession_titles(); + my $numinrow = 5; + my $prefix; + my @types; + if ($position eq 'bottom') { + $prefix = 'remote'; + @types = ('version','excludedomain','includedomain'); + } else { + $prefix = 'hosted'; + @types = ('excludedomain','includedomain'); } - } - } - foreach my $type (@types) { - next if ($type ne 'version' && !@locations); - $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; - $datatable .= ' - '.$lt{$type}.'
-   -   - 		'; - if ($type eq 'version') { - my $selector = ' '; - $datatable .= &mt('remote server must be version: [_1] or later',$selector); - } else { - $datatable.= '
'.(' 'x2). - ''. - "\n". - '
'; - my $rem; - for (my $i=0; $i<@locations; $i++) { - my ($showloc,$value,$checkedtype); - if (ref($by_location{$locations[$i]}) eq 'ARRAY') { - my $ip = $by_location{$locations[$i]}->[0]; - if (ref($by_ip{$ip}) eq 'ARRAY') { - $value = join(':',@{$by_ip{$ip}}); - $showloc = join(', ',@{$by_ip{$ip}}); - if (ref($current{$type}) eq 'ARRAY') { - foreach my $loc (@{$by_ip{$ip}}) { - if (grep(/^\Q$loc\E$/,@{$current{$type}})) { - $checkedtype = ' checked="checked"'; - last; + foreach my $type (@types) { + next if ($type ne 'version' && !@locations); + $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + $datatable .= ' + '; - } - $rem = @locations%($numinrow); - my $colsleft = $numinrow - $rem; - if ($colsleft > 1 ) { - $datatable .= ''; - } elsif ($colsleft == 1) { - $datatable .= ''; + $datatable .= ''; + $itemcount ++; } - $datatable .= '
'.$lt{$type}.'
+   +   + 		'; + if ($type eq 'version') { + my $selector = ' '; + $datatable .= &mt('remote server must be version: [_1] or later',$selector); + } else { + $datatable.= '
'.(' 'x2). + ''. + "\n". + '
'; + my $rem; + for (my $i=0; $i<@locations; $i++) { + my ($showloc,$value,$checkedtype); + if (ref($by_location{$locations[$i]}) eq 'ARRAY') { + my $ip = $by_location{$locations[$i]}->[0]; + if (ref($by_ip{$ip}) eq 'ARRAY') { + $value = join(':',@{$by_ip{$ip}}); + $showloc = join(', ',@{$by_ip{$ip}}); + if (ref($current{$type}) eq 'ARRAY') { + foreach my $loc (@{$by_ip{$ip}}) { + if (grep(/^\Q$loc\E$/,@{$current{$type}})) { + $checkedtype = ' checked="checked"'; + last; + } + } } } } + $rem = $i%($numinrow); + if ($rem == 0) { + if ($i > 0) { + $datatable .= ''; + } + $datatable .= ''; + } + $datatable .= ''; } - } - $rem = $i%($numinrow); - if ($rem == 0) { - if ($i > 0) { - $datatable .= ''; + $rem = @locations%($numinrow); + my $colsleft = $numinrow - $rem; + if ($colsleft > 1 ) { + $datatable .= ''; + } elsif ($colsleft == 1) { + $datatable .= ''; } - $datatable .= ''; + $datatable .= '
'. + '
'. + '  
'; } - $datatable .= '
'. - ''. - '  
'; } - $datatable .= '
+ '.$server.' when busy, offloads to:
'; + for (my $i=0; $i<@spares; $i++) { + my $rem = $i%($numinrow); + if ($rem == 0) { + if ($i > 0) { + $current{$type} .= ''; + } + $current{$type} .= ''; + } + $current{$type} .= ''; + } + $current{$type} .= '
'; + } + } + if ($current{$type} eq '') { + $current{$type} = &mt('None specified'); + } + $canselect{$type} = + &newspare_select($server,$type,$spareid->{$server}{$type},$uniques); + } + } + $datatable .= ''.&mt('primary').''.$current{'primary'}.''. + ''.&mt('Add new [_1]primary[_2]:','','').' '. + $canselect{'primary'}.''. + ''. + ''.&mt('default').''. + ''.$current{'default'}.''. + ''.&mt('Add new [_1]default[_2]:','','').' '. + $canselect{'default'}.''; + $itemcount ++; + } + } + $$rowtotal += $itemcount; + return $datatable; +} + +sub newspare_select { + my ($server,$type,$currspares,$uniques) = @_; + my $output; + if (ref($uniques) eq 'HASH') { + if (keys(%{$uniques}) > 1) { + $output = ''; + } + } + return $output; +} + sub contact_titles { my %titles = &Apache::lonlocal::texthash ( 'supportemail' => 'Support E-mail address', @@ -6766,8 +6946,14 @@ sub modify_coursedefaults { sub modify_usersessions { my ($dom,%domconfig) = @_; - my @types = ('version','excludedomain','includedomain'); - my @prefixes = ('remote','hosted'); + my @hostingtypes = ('version','excludedomain','includedomain'); + my @offloadtypes = ('primary','default'); + my %types = ( + remote => \@hostingtypes, + hosted => \@hostingtypes, + spares => \@offloadtypes, + ); + my @prefixes = ('remote','hosted','spares'); my @lcversions = &Apache::lonnet::all_loncaparevs(); my (%by_ip,%by_location,@intdoms); &build_location_hashes(\@intdoms,\%by_ip,\%by_location); @@ -6780,7 +6966,8 @@ sub modify_usersessions { my $resulttext; my %iphost = &Apache::lonnet::get_iphost(); foreach my $prefix (@prefixes) { - foreach my $type (@types) { + next if ($prefix eq 'spares'); + foreach my $type (@{$types{$prefix}}) { my $inuse = $env{'form.'.$prefix.'_'.$type.'_inuse'}; if ($type eq 'version') { my $value = $env{'form.'.$prefix.'_'.$type}; @@ -6872,6 +7059,66 @@ sub modify_usersessions { } } } + + my @alldoms = &Apache::lonnet::all_domains(); + my %uniques = &Apache::lonnet::get_unique_servers(\@alldoms); + my %servers = &dom_servers($dom); + my %spareid = ¤t_offloads_to($dom,$domconfig{'usersessions'},\%servers); + my $savespares; + + foreach my $lonhost (sort(keys(%servers))) { + my $serverhomeID = + &Apache::lonnet::get_server_homeID($servers{$lonhost}); + $defaultshash{'usersessions'}{'spares'}{$lonhost} = {}; + my %spareschg; + foreach my $type (@{$types{'spares'}}) { + my @okspares; + my @checked = &Apache::loncommon::get_env_multiple('form.spare_'.$type.'_'.$lonhost); + foreach my $server (@checked) { + unless (($server eq $lonhost) || ($server eq $serverhomeID)) { + if ($uniques{$server}) { + push(@okspares,$server); + } + } + } + my $new = $env{'form.newspare_'.$type.'_'.$lonhost}; + my $newspare; + if (($new ne '') && ($uniques{$new})) { + unless (($new eq $lonhost) || ($new eq $serverhomeID)) { + $newspare = $new; + $spareschg{$type} = 1; + } + } + if (ref($spareid{$lonhost}) eq 'HASH') { + if (ref($spareid{$lonhost}{$type}) eq 'ARRAY') { + my @diffs = &Apache::loncommon::compare_arrays($domconfig{'usersessions'}{'spares'}{$lonhost}{$type},\@okspares); + if (@diffs > 0) { + $spareschg{$type} = 1; + } elsif ($new ne '') { + $spareschg{$type} = 1; + } + } + } + my @spares = sort(@okspares,$newspare); + $defaultshash{'usersessions'}{'spares'}{$lonhost}{$type} = \@spares; + } + if (keys(%spareschg) > 0) { + $changes{'spares'}{$lonhost} = \%spareschg; + } + } + + if (ref($domconfig{'usersessions'}) eq 'HASH') { + if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') { + if (ref($changes{'spares'}) eq 'HASH') { + if (keys(%{$changes{'spares'}}) > 0) { + $savespares = 1; + } + } + } else { + $savespares = 1; + } + } + if (keys(%changes) > 0) { my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash, $dom); @@ -6891,31 +7138,53 @@ sub modify_usersessions { foreach my $prefix (@prefixes) { if (ref($changes{$prefix}) eq 'HASH') { $resulttext .= '
  • '.$lt{$prefix}.'