--- loncom/interface/domainprefs.pm 2011/11/07 03:27:23 1.138.2.12 +++ loncom/interface/domainprefs.pm 2011/08/01 19:46:49 1.146 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: domainprefs.pm,v 1.138.2.12 2011/11/07 03:27:23 raeburn Exp $ +# $Id: domainprefs.pm,v 1.146 2011/08/01 19:46:49 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -171,9 +171,6 @@ use Locale::Language; use DateTime::TimeZone; use DateTime::Locale; -my $registered_cleanup; -my $modified_urls; - sub handler { my $r=shift; if ($r->header_only) { @@ -193,10 +190,6 @@ sub handler { "/adm/domainprefs:mau:0:0:Cannot modify domain settings"; return HTTP_NOT_ACCEPTABLE; } - - $registered_cleanup=0; - @{$modified_urls}=(); - &Apache::lonhtmlcommon::clear_breadcrumbs(); &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['phase','actions']); @@ -209,12 +202,12 @@ sub handler { 'quotas','autoenroll','autoupdate','autocreate', 'directorysrch','usercreation','usermodification', 'contacts','defaults','scantron','coursecategories', - 'serverstatuses','requestcourses','coursedefaults', - 'usersessions'],$dom); + 'serverstatuses','requestcourses','helpsettings', + 'coursedefaults','usersessions'],$dom); my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll', 'autoupdate','autocreate','directorysrch','contacts', 'usercreation','usermodification','scantron', - 'requestcourses','coursecategories','serverstatuses', + 'requestcourses','coursecategories','serverstatuses','helpsettings', 'coursedefaults','usersessions'); my %prefs = ( 'rolecolors' => @@ -344,11 +337,13 @@ sub handler { {col1 => 'Unauthenticated Help Settings', col2 => ''}], }, - 'coursedefaults' => + 'coursedefaults' => {text => 'Course/Community defaults', help => 'Domain_Configuration_Course_Defaults', - header => [{col1 => 'Defaults which can be overridden for each course by a DC', - col2 => 'Value',}], + header => [{col1 => 'Defaults which can be overridden in each course by a CC', + col2 => 'Value',}, + {col1 => 'Defaults which can be overridden for each course by a DC', + col2 => 'Value',},], }, 'privacy' => {text => 'User Privacy', @@ -356,10 +351,12 @@ sub handler { header => [{col1 => 'Setting', col2 => 'Value',}], }, - 'usersessions' => - {text => 'User session hosting', + 'usersessions' => + {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'}], @@ -462,6 +459,8 @@ sub process_changes { $output = &modify_serverstatuses($dom,%domconfig); } elsif ($action eq 'requestcourses') { $output = &modify_quotas($dom,$action,%domconfig); + } elsif ($action eq 'helpsettings') { + $output = &modify_helpsettings($r,$dom,$confname,%domconfig); } elsif ($action eq 'coursedefaults') { $output = &modify_coursedefaults($dom,%domconfig); } elsif ($action eq 'usersessions') { @@ -491,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') { @@ -519,9 +522,11 @@ sub print_config_box { } elsif ($action eq 'helpsettings') { $output .= &print_helpsettings('top',$dom,$confname,$settings,\$rowtotal); } elsif ($action eq 'usersessions') { - $output .= &print_usersessions('top',$dom,$settings,\$rowtotal); + $output .= &print_usersessions('top',$dom,$settings,\$rowtotal); } elsif ($action eq 'rolecolors') { $output .= &print_rolecolors($phase,'student',$dom,$confname,$settings,\$rowtotal); + } elsif ($action eq 'coursedefaults') { + $output .= &print_coursedefaults('top',$dom,$settings,\$rowtotal); } $output .= '
'.&mt($item->{'header'}->[0]->{'col1'}).''.&mt($item->{'header'}->[0]->{'col2'}).''.&mt($item->{'header'}->[0]->{'col2'}).'
@@ -584,7 +589,20 @@ 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).' + + + + + + + + + '. + &print_usersessions('bottom',$dom,$settings,\$rowtotal); + $rowtotal ++; + } elsif ($action eq 'coursedefaults') { + $output .= &print_coursedefaults('bottom',$dom,$settings,\$rowtotal); } elsif ($action eq 'rolecolors') { $output .= &print_rolecolors($phase,'coordinator',$dom,$confname,$settings,\$rowtotal).'
'.&mt($item->{'header'}->[2]->{'col1'}).''.&mt($item->{'header'}->[2]->{'col2'}).'
@@ -671,8 +689,8 @@ sub print_config_box { $output .= &print_scantronformat($r,$dom,$confname,$settings,\$rowtotal); } elsif ($action eq 'serverstatuses') { $output .= &print_serverstatuses($dom,$settings,\$rowtotal); - } elsif ($action eq 'coursedefaults') { - $output .= &print_coursedefaults('bottom',$dom,$settings,\$rowtotal); + } elsif ($action eq 'helpsettings') { + $output .= &print_helpsettings('top',$dom,$confname,$settings,\$rowtotal); } } $output .= ' @@ -1896,7 +1914,7 @@ sub print_autocreate { my ($numdc,$dctable) = &active_dc_picker($dom,$curr_dc); if ($numdc > 1) { $datatable .= ''. - &mt('Course creation processed as: (choose Dom. Coord.)'). + &mt('Course creation processed as: (choose Dom. Coord.)'). ''.$dctable.''; $$rowtotal ++ ; } else { @@ -2286,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 .= ''. - &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 .= ''; - $itemcount ++; } $$rowtotal += $itemcount; return $datatable; @@ -2451,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 .= ' + + '.$server.' when busy, offloads to:'; + 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} .= ''; + 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', @@ -3336,7 +3517,7 @@ sub print_serverstatuses { sub serverstatus_pages { return ('userstatus','lonstatus','loncron','server-status','codeversions', 'clusterstatus','metadata_keywords','metadata_harvest', - 'takeoffline','takeonline','showenv','toggledebug','ping','domconf'); + 'takeoffline','takeonline','showenv','toggledebug'); } sub coursecategories_javascript { @@ -4482,15 +4663,8 @@ $env{'user.name'}.':'.$env{'user.domain' if (copy($source,$copyfile)) { print $logfile "\nCopied original source to ".$copyfile."\n"; $output = 'ok'; + &write_metadata($dom,$confname,$formname,$targetdir,$file,$logfile); $logourl = '/res/'.$dom.'/'.$confname.'/'.$fname; - push(@{$modified_urls},[$copyfile,$source]); - my $metaoutput = - &write_metadata($dom,$confname,$formname,$targetdir,$file,$logfile); - unless ($registered_cleanup) { - my $handlers = $r->get_handlers('PerlCleanupHandler'); - $r->set_handlers('PerlCleanupHandler' => [\¬ifysubscribed,@{$handlers}]); - $registered_cleanup=1; - } } else { print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; $output = &mt('Failed to copy file to RES space').", $!"; @@ -4508,15 +4682,8 @@ $env{'user.name'}.':'.$env{'user.domain' my $copyfile=$targetdir.'/tn-'.$file; if (copy($outfile,$copyfile)) { print $logfile "\nCopied source to ".$copyfile."\n"; - my $thumb_metaoutput = - &write_metadata($dom,$confname,$formname, - $targetdir,'tn-'.$file,$logfile); - push(@{$modified_urls},[$copyfile,$outfile]); - unless ($registered_cleanup) { - my $handlers = $r->get_handlers('PerlCleanupHandler'); - $r->set_handlers('PerlCleanupHandler' => [\¬ifysubscribed,@{$handlers}]); - $registered_cleanup=1; - } + &write_metadata($dom,$confname,$formname, + $targetdir,'tn-'.$file,$logfile); } else { print $logfile "\nUnable to write ".$copyfile. ':'.$!."\n"; @@ -4581,79 +4748,30 @@ sub write_metadata { { print $logfile "\nWrite metadata file for ".$targetdir.'/'.$file; my $mfh; - if (open($mfh,'>'.$targetdir.'/'.$file.'.meta')) { - foreach (sort keys %metadatafields) { - unless ($_=~/\./) { - my $unikey=$_; - $unikey=~/^([A-Za-z]+)/; - my $tag=$1; - $tag=~tr/A-Z/a-z/; - print $mfh "\n\<$tag"; - foreach (split(/\,/,$metadatakeys{$unikey})) { - my $value=$metadatafields{$unikey.'.'.$_}; - $value=~s/\"/\'\'/g; - print $mfh ' '.$_.'="'.$value.'"'; - } - print $mfh '>'. - &HTML::Entities::encode($metadatafields{$unikey},'<>&"') - .''; - } - } - $output = 'ok'; - print $logfile "\nWrote metadata"; - close($mfh); - } else { - print $logfile "\nFailed to open metadata file"; + unless (open($mfh,'>'.$targetdir.'/'.$file.'.meta')) { $output = &mt('Could not write metadata'); } + foreach (sort keys %metadatafields) { + unless ($_=~/\./) { + my $unikey=$_; + $unikey=~/^([A-Za-z]+)/; + my $tag=$1; + $tag=~tr/A-Z/a-z/; + print $mfh "\n\<$tag"; + foreach (split(/\,/,$metadatakeys{$unikey})) { + my $value=$metadatafields{$unikey.'.'.$_}; + $value=~s/\"/\'\'/g; + print $mfh ' '.$_.'="'.$value.'"'; + } + print $mfh '>'. + &HTML::Entities::encode($metadatafields{$unikey},'<>&"') + .''; + } + } + $output = 'ok'; + print $logfile "\nWrote metadata"; + close($mfh); } - return $output; -} - -sub notifysubscribed { - foreach my $targetsource (@{$modified_urls}){ - next unless (ref($targetsource) eq 'ARRAY'); - my ($target,$source)=@{$targetsource}; - if ($source ne '') { - if (open(my $logfh,'>>'.$source.'.log')) { - print $logfh "\nCleanup phase: Notifications\n"; - my @subscribed=&subscribed_hosts($target); - foreach my $subhost (@subscribed) { - print $logfh "\nNotifying host ".$subhost.':'; - my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); - print $logfh $reply; - } - my @subscribedmeta=&subscribed_hosts("$target.meta"); - foreach my $subhost (@subscribedmeta) { - print $logfh "\nNotifying host for metadata only ".$subhost.':'; - my $reply=&Apache::lonnet::critical('update:'.$target.'.meta', - $subhost); - print $logfh $reply; - } - print $logfh "\n============ Done ============\n"; - close(logfh); - } - } - } - return OK; -} - -sub subscribed_hosts { - my ($target) = @_; - my @subscribed; - if (open(my $fh,"<$target.subscription")) { - while (my $subline=<$fh>) { - if ($subline =~ /^($match_lonid):/) { - my $host = $1; - if ($host ne $Apache::lonnet::perlvar{'lonHostID'}) { - unless (grep(/^\Q$host\E$/,@subscribed)) { - push(@subscribed,$host); - } - } - } - } - } - return @subscribed; } sub check_switchserver { @@ -6751,7 +6869,7 @@ sub modify_coursedefaults { my ($resulttext,$errors,%changes,%defaultshash); my %defaultchecked = ('canuse_pdfforms' => 'off'); my @offon = ('off','on'); - my @toggles = (); + my @toggles = ('canuse_pdfforms'); $defaultshash{'coursedefaults'} = {}; @@ -6828,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); @@ -6842,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}; @@ -6934,6 +7059,71 @@ 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; + if (($newspare ne '') && (!grep(/^\Q$newspare\E$/,@okspares))) { + @spares = sort(@okspares,$newspare); + } else { + @spares = sort(@okspares); + } + $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); @@ -6953,31 +7143,53 @@ sub modify_usersessions { foreach my $prefix (@prefixes) { if (ref($changes{$prefix}) eq 'HASH') { $resulttext .= '
  • '.$lt{$prefix}.'
      '; - foreach my $type (@types) { - if (defined($changes{$prefix}{$type})) { - my $newvalue; - if (ref($defaultshash{'usersessions'}) eq 'HASH') { - if (ref($defaultshash{'usersessions'}{$prefix})) { - if ($type eq 'version') { - $newvalue = $defaultshash{'usersessions'}{$prefix}{$type}; - } elsif (ref($defaultshash{'usersessions'}{$prefix}{$type}) eq 'ARRAY') { - if (@{$defaultshash{'usersessions'}{$prefix}{$type}} > 0) { - $newvalue = join(', ',@{$defaultshash{'usersessions'}{$prefix}{$type}}); + if ($prefix eq 'spares') { + if (ref($changes{$prefix}) eq 'HASH') { + foreach my $lonhost (sort(keys(%{$changes{$prefix}}))) { + $resulttext .= '
    • '.$lonhost.' '; + if (ref($changes{$prefix}{$lonhost}) eq 'HASH') { + foreach my $type (@{$types{$prefix}}) { + if ($changes{$prefix}{$lonhost}{$type}) { + my $offloadto = &mt('None'); + if (ref($defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}) eq 'ARRAY') { + if (@{$defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}} > 0) { + $offloadto = join(', ',@{$defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}}); + } + } + $resulttext .= &mt('[_1] set to: [_2]',''.$lt{'type'}.'',$offloadto).(' 'x3); } } } + $resulttext .= '
      • '; } - if ($newvalue eq '') { - if ($type eq 'version') { - $resulttext .= '
    • '.&mt('[_1] set to: off',$lt{$type}).'
      • '; + } + } else { + foreach my $type (@{$types{$prefix}}) { + if (defined($changes{$prefix}{$type})) { + my $newvalue; + if (ref($defaultshash{'usersessions'}) eq 'HASH') { + if (ref($defaultshash{'usersessions'}{$prefix})) { + if ($type eq 'version') { + $newvalue = $defaultshash{'usersessions'}{$prefix}{$type}; + } elsif (ref($defaultshash{'usersessions'}{$prefix}{$type}) eq 'ARRAY') { + if (@{$defaultshash{'usersessions'}{$prefix}{$type}} > 0) { + $newvalue = join(', ',@{$defaultshash{'usersessions'}{$prefix}{$type}}); + } + } + } + } + if ($newvalue eq '') { + if ($type eq 'version') { + $resulttext .= '
    • '.&mt('[_1] set to: off',$lt{$type}).'
      • '; + } else { + $resulttext .= '
    • '.&mt('[_1] set to: none',$lt{$type}).'
      • '; + } } else { - $resulttext .= '
    • '.&mt('[_1] set to: none',$lt{$type}).'
      • '; + if ($type eq 'version') { + $newvalue .= ' '.&mt('(or later)'); + } + $resulttext .= '
    • '.&mt('[_1] set to: [_2].',$lt{$type},$newvalue).'
      • '; } - } else { - if ($type eq 'version') { - $newvalue .= ' '.&mt('(or later)'); - } - $resulttext .= '
    • '.&mt('[_1] set to: [_2].',$lt{$type},$newvalue).'
      • '; } } } @@ -6990,7 +7202,7 @@ sub modify_usersessions { &mt('An error occurred: [_1]',$putresult).''; } } else { - $resulttext = &mt('No changes made to settings for user session hosting.'); + $resulttext = &mt('No changes made to settings for user session hosting/offloading.'); } return $resulttext; } @@ -7143,9 +7355,12 @@ sub usersession_titles { hosted => 'Hosting of sessions for users from other domains on servers in this domain', remote => 'Hosting of sessions for users in this domain on servers in other domains', + spares => 'Servers offloaded to, when busy', version => 'LON-CAPA version requirement', excludedomain => 'Allow all, but exclude specific domains', includedomain => 'Deny all, but include specific domains', + primary => 'Primary (checked first)', + default => 'Default', ); } 500 Internal Server Error

      Internal Server Error

      The server encountered an internal error or misconfiguration and was unable to complete your request.

      Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

      More information about this error may be available in the server error log.