--- loncom/interface/domainprefs.pm 2010/05/21 15:54:44 1.135 +++ 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.135 2010/05/21 15:54:44 bisitz Exp $ +# $Id: domainprefs.pm,v 1.145 2011/07/31 23:05:00 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -140,7 +140,7 @@ autolimit =over -- course requests will be processed autoatically up to a limit of +- course requests will be processed automatically up to a limit of N requests for the course type for the particular requestor. If N is undefined, there is no limit to the number of course requests which a course owner may submit and have processed automatically. @@ -203,12 +203,12 @@ sub handler { 'directorysrch','usercreation','usermodification', 'contacts','defaults','scantron','coursecategories', 'serverstatuses','requestcourses','helpsettings', - 'coursedefaults'],$dom); + 'coursedefaults','usersessions'],$dom); my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll', 'autoupdate','autocreate','directorysrch','contacts', 'usercreation','usermodification','scantron', 'requestcourses','coursecategories','serverstatuses','helpsettings', - 'coursedefaults'); + 'coursedefaults','usersessions'); my %prefs = ( 'rolecolors' => { text => 'Default color schemes', @@ -230,7 +230,7 @@ sub handler { }, 'defaults' => - { text => 'Default authentication/language/timezone', + { text => 'Default authentication/language/timezone/portal', help => 'Domain_Configuration_LangTZAuth', header => [{col1 => 'Setting', col2 => 'Value'}], @@ -340,8 +340,10 @@ sub handler { 'coursedefaults' => {text => 'Course/Community defaults', help => 'Domain_Configuration_Course_Defaults', - header => [{col1 => 'Setting', - 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', @@ -349,6 +351,16 @@ sub handler { header => [{col1 => 'Setting', col2 => 'Value',}], }, + 'usersessions' => + {text => 'User session hosting/offloading', + help => 'Domain_Configuration_User_Sessions', + 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'}], + }, ); my %servers = &dom_servers($dom); if (keys(%servers) > 1) { @@ -451,6 +463,8 @@ sub process_changes { $output = &modify_helpsettings($r,$dom,$confname,%domconfig); } elsif ($action eq 'coursedefaults') { $output = &modify_coursedefaults($dom,%domconfig); + } elsif ($action eq 'usersessions') { + $output = &modify_usersessions($dom,%domconfig); } return $output; } @@ -476,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') { @@ -503,8 +521,12 @@ sub print_config_box { $output .= &print_quotas($dom,$settings,\$rowtotal,$action); } elsif ($action eq 'helpsettings') { $output .= &print_helpsettings('top',$dom,$confname,$settings,\$rowtotal); + } elsif ($action eq 'usersessions') { + $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'}).'
@@ -566,6 +588,21 @@ sub print_config_box { $output .= &print_courserequestmail($dom,$settings,\$rowtotal); } elsif ($action eq 'helpsettings') { $output .= &print_helpsettings('bottom',$dom,$confname,$settings,\$rowtotal); + } elsif ($action eq 'usersessions') { + $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'}).'
@@ -654,8 +691,6 @@ sub print_config_box { $output .= &print_serverstatuses($dom,$settings,\$rowtotal); } elsif ($action eq 'helpsettings') { $output .= &print_helpsettings('top',$dom,$confname,$settings,\$rowtotal); - } elsif ($action eq 'coursedefaults') { - $output .= &print_coursedefaults($dom,$settings,\$rowtotal); } } $output .= ' @@ -849,7 +884,6 @@ sub print_login { domlogo => 'Domain Logo', login => 'Login box'); my $itemcount = 1; - my ($css_class,$datatable); foreach my $item (@toggles) { $css_class = $itemcount%2?' class="LC_odd_row"':''; $datatable .= @@ -1869,24 +1903,23 @@ sub print_autocreate { ''.&mt('Yes').' '. ''; + $createoff{'xml'}.' value="0" />'.&mt('No').''. + ''. + ''.&mt('Create pending requests for official courses (if validated)').''. + ' '. + ''; my ($numdc,$dctable) = &active_dc_picker($dom,$curr_dc); if ($numdc > 1) { - $datatable .= ''. - &mt('XML files processed as: (choose Dom. Coord.)'). - ''.$dctable.''. - ''; + $datatable .= ''. + &mt('Course creation processed as: (choose Dom. Coord.)'). + ''.$dctable.''; $$rowtotal ++ ; } else { - $datatable .= ''; + $datatable .= $dctable.''; } - $datatable .= ''.&mt('Create pending requests for official courses (if validated)').''. - ' '. - ''. - ''; return $datatable; } @@ -2077,7 +2110,7 @@ sub print_contacts { ''; if ($type eq 'helpdeskmail') { - $datatable .= '
'.&mt('Bcc').':'.(' 'x6). + $datatable .= '
'.&mt('Bcc:').(' 'x6). ''; } @@ -2226,22 +2259,379 @@ sub radiobutton_prefs { } sub print_coursedefaults { - my ($dom,$settings,$rowtotal) = @_; + my ($position,$dom,$settings,$rowtotal) = @_; my ($css_class,$datatable); my $itemcount = 1; - my (%checkedon,%checkedoff,%choices,%defaultchecked,@toggles); - %choices = - &Apache::lonlocal::texthash ( - canuse_pdfforms => 'Course/Community users can create/upload PDF forms', - ); - %defaultchecked = ('canuse_pdfforms' => 'off'); - @toggles = ('canuse_pdfforms',); - ($datatable,$itemcount) = &radiobutton_prefs($settings,\@toggles,\%defaultchecked, + if ($position eq 'top') { + my (%checkedon,%checkedoff,%choices,%defaultchecked,@toggles); + %choices = + &Apache::lonlocal::texthash ( + canuse_pdfforms => 'Course/Community users can create/upload PDF forms', + ); + %defaultchecked = ('canuse_pdfforms' => 'off'); + @toggles = ('canuse_pdfforms',); + ($datatable,$itemcount) = &radiobutton_prefs($settings,\@toggles,\%defaultchecked, \%choices,$itemcount); + $$rowtotal += $itemcount; + } else { + $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + my %choices = + &Apache::lonlocal::texthash ( + anonsurvey_threshold => 'Responder count needed before showing submissions for anonymous surveys', + ); + my $currdefresponder; + if (ref($settings) eq 'HASH') { + $currdefresponder = $settings->{'anonsurvey_threshold'}; + } + if (!$currdefresponder) { + $currdefresponder = 10; + } elsif ($currdefresponder < 1) { + $currdefresponder = 1; + } + $datatable .= + ''.$choices{'anonsurvey_threshold'}. + ''. + ''. + ''. + ''; + } + return $datatable; +} + +sub print_usersessions { + my ($position,$dom,$settings,$rowtotal) = @_; + my ($css_class,$datatable,%checked,%choices); + my (%by_ip,%by_location,@intdoms); + &build_location_hashes(\@intdoms,\%by_ip,\%by_location); + + my @alldoms = &Apache::lonnet::all_domains(); + my %uniques = &Apache::lonnet::get_unique_servers(\@alldoms); + my %servers = &dom_servers($dom); + my $itemcount = 1; + if ($position eq 'top') { + 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 { + 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'); + } + 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} = ''; + } + } + } + } + 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; + } + } + } + } + } + $rem = $i%($numinrow); + if ($rem == 0) { + if ($i > 0) { + $datatable .= ''; + } + $datatable .= ''; + } + $datatable .= ''; + } + $rem = @locations%($numinrow); + my $colsleft = $numinrow - $rem; + if ($colsleft > 1 ) { + $datatable .= ''; + } elsif ($colsleft == 1) { + $datatable .= ''; + } + $datatable .= '
'. + ''. + '  
'; + } + $datatable .= ''; + $itemcount ++; + } + } + } + $$rowtotal += $itemcount; + return $datatable; +} + +sub build_location_hashes { + my ($intdoms,$by_ip,$by_location) = @_; + return unless((ref($intdoms) eq 'ARRAY') && (ref($by_ip) eq 'HASH') && + (ref($by_location) eq 'HASH')); + my %iphost = &Apache::lonnet::get_iphost(); + my $primary_id = &Apache::lonnet::domain($env{'request.role.domain'},'primary'); + my $primary_ip = &Apache::lonnet::get_host_ip($primary_id); + if (ref($iphost{$primary_ip}) eq 'ARRAY') { + foreach my $id (@{$iphost{$primary_ip}}) { + my $intdom = &Apache::lonnet::internet_dom($id); + unless(grep(/^\Q$intdom\E$/,@{$intdoms})) { + push(@{$intdoms},$intdom); + } + } + } + foreach my $ip (keys(%iphost)) { + if (ref($iphost{$ip}) eq 'ARRAY') { + foreach my $id (@{$iphost{$ip}}) { + my $location = &Apache::lonnet::internet_dom($id); + if ($location) { + next if (grep(/^\Q$location\E$/,@{$intdoms})); + if (ref($by_ip->{$ip}) eq 'ARRAY') { + unless(grep(/^\Q$location\E$/,@{$by_ip->{$ip}})) { + push(@{$by_ip->{$ip}},$location); + } + } else { + $by_ip->{$ip} = [$location]; + } + } + } + } + } + foreach my $ip (sort(keys(%{$by_ip}))) { + if (ref($by_ip->{$ip}) eq 'ARRAY') { + @{$by_ip->{$ip}} = sort(@{$by_ip->{$ip}}); + my $first = $by_ip->{$ip}->[0]; + if (ref($by_location->{$first}) eq 'ARRAY') { + unless (grep(/^\Q$ip\E$/,@{$by_location->{$first}})) { + push(@{$by_location->{$first}},$ip); + } + } else { + $by_location->{$first} = [$ip]; + } + } + } + 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', @@ -2613,9 +3003,9 @@ sub print_usermodification { sub print_defaults { my ($dom,$rowtotal) = @_; my @items = ('auth_def','auth_arg_def','lang_def','timezone_def', - 'datelocale_def'); + 'datelocale_def','portal_def'); my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); - my $titles = &defaults_titles(); + my $titles = &defaults_titles($dom); my $rownum = 0; my ($datatable,$css_class); foreach my $item (@items) { @@ -2652,8 +3042,12 @@ sub print_defaults { my $includeempty = 1; $datatable .= &Apache::loncommon::select_datelocale($item,$domdefaults{$item},undef,$includeempty); } else { + my $size; + if ($item eq 'portal_def') { + $size = ' size="25"'; + } $datatable .= ''; + $domdefaults{$item}.'"'.$size.' />'; } $datatable .= ''; $rownum ++; @@ -2663,13 +3057,25 @@ sub print_defaults { } sub defaults_titles { + my ($dom) = @_; my %titles = &Apache::lonlocal::texthash ( 'auth_def' => 'Default authentication type', 'auth_arg_def' => 'Default authentication argument', 'lang_def' => 'Default language', 'timezone_def' => 'Default timezone', 'datelocale_def' => 'Default locale for dates', + 'portal_def' => 'Portal/Default URL', ); + if ($dom) { + my $uprimary_id = &Apache::lonnet::domain($dom,'primary'); + my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id); + my $protocol = $Apache::lonnet::protocol{$uprimary_id}; + $protocol = 'http' if ($protocol ne 'https'); + if ($uint_dom) { + $titles{'portal_def'} .= ' '.&mt('(for example: [_1])',$protocol.'://loncapa.'. + $uint_dom); + } + } return (\%titles); } @@ -4435,12 +4841,12 @@ sub modify_quotas { $changes{'notify'}{'approval'} = 1; } } else { - if ($domconfig{$action}{'notify'}{'approval'}) { + if ($confhash{'notify'}{'approval'}) { $changes{'notify'}{'approval'} = 1; } } } else { - if ($domconfig{$action}{'notify'}{'approval'}) { + if ($confhash{'notify'}{'approval'}) { $changes{'notify'}{'approval'} = 1; } } @@ -4761,7 +5167,7 @@ sub modify_autoupdate { middlename => 'Middle Name', generation => 'Generation', ); - my $othertitle = &mt('All users'); + $othertitle = &mt('All users'); if (keys(%{$usertypes}) > 0) { $othertitle = &mt('Other users'); } @@ -5805,7 +6211,7 @@ sub modify_defaults { my ($dom,$r) = @_; my ($resulttext,$mailmsgtxt,%newvalues,%changes,@errors); my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); - my @items = ('auth_def','auth_arg_def','lang_def','timezone_def','datelocale_def'); + my @items = ('auth_def','auth_arg_def','lang_def','timezone_def','datelocale_def','portal_def'); my @authtypes = ('internal','krb4','krb5','localauth'); foreach my $item (@items) { $newvalues{$item} = $env{'form.'.$item}; @@ -5841,6 +6247,12 @@ sub modify_defaults { push(@errors,$item); } } + } elsif ($item eq 'portal_def') { + if ($newvalues{$item} ne '') { + unless ($newvalues{$item} =~ /^https?\:\/\/(([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9\-]*[a-zA-Z0-9])\.)*([A-Za-z]|[A-Za-z][A-Za-z0-9\-]*[A-Za-z0-9])\/?$/) { + push(@errors,$item); + } + } } if (grep(/^\Q$item\E$/,@errors)) { $newvalues{$item} = $domdefaults{$item}; @@ -6257,7 +6669,6 @@ sub modify_serverstatuses { my %serverstatushash = ( serverstatuses => \%newserverstatus, ); - my %changes; foreach my $type (@pages) { foreach my $setting ('namedusers','machines') { my (@current,@new); @@ -6487,6 +6898,18 @@ sub modify_coursedefaults { } $defaultshash{'coursedefaults'}{$item} = $env{'form.'.$item}; } + my $currdefresponder = $domconfig{'coursedefaults'}{'anonsurvey_threshold'}; + my $newdefresponder = $env{'form.anonsurvey_threshold'}; + $newdefresponder =~ s/\D//g; + if ($newdefresponder eq '' || $newdefresponder < 1) { + $newdefresponder = 1; + } + $defaultshash{'coursedefaults'}{'anonsurvey_threshold'} = $newdefresponder; + if ($currdefresponder ne $newdefresponder) { + unless ($currdefresponder eq '' && $newdefresponder == 10) { + $changes{'anonsurvey_threshold'} = 1; + } + } } my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash, $dom); @@ -6506,6 +6929,8 @@ sub modify_coursedefaults { } else { $resulttext .= '
  • '.&mt('Course/Community users can create/upload PDF forms set to "off"').'
  • '; } + } elsif ($item eq 'anonsurvey_threshold') { + $resulttext .= '
  • '.&mt('Responder count required for display of anonymous survey submissions set to [_1].',$defaultshash{'coursedefaults'}{'anonsurvey_threshold'}).'
  • '; } } $resulttext .= ''; @@ -6519,6 +6944,264 @@ sub modify_coursedefaults { return $resulttext; } +sub modify_usersessions { + my ($dom,%domconfig) = @_; + 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); + my @locations = sort(keys(%by_location)); + my (%defaultshash,%changes); + foreach my $prefix (@prefixes) { + $defaultshash{'usersessions'}{$prefix} = {}; + } + my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); + my $resulttext; + my %iphost = &Apache::lonnet::get_iphost(); + foreach my $prefix (@prefixes) { + 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}; + my $okvalue; + if ($value ne '') { + if (grep(/^\Q$value\E$/,@lcversions)) { + $okvalue = $value; + } + } + if (ref($domconfig{'usersessions'}) eq 'HASH') { + if (ref($domconfig{'usersessions'}{$prefix}) eq 'HASH') { + if ($domconfig{'usersessions'}{$prefix}{$type} ne '') { + if ($inuse == 0) { + $changes{$prefix}{$type} = 1; + } else { + if ($okvalue ne $domconfig{'usersessions'}{$prefix}{$type}) { + $changes{$prefix}{$type} = 1; + } + if ($okvalue ne '') { + $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; + } + } + } else { + if (($inuse == 1) && ($okvalue ne '')) { + $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; + $changes{$prefix}{$type} = 1; + } + } + } else { + if (($inuse == 1) && ($okvalue ne '')) { + $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; + $changes{$prefix}{$type} = 1; + } + } + } else { + if (($inuse == 1) && ($okvalue ne '')) { + $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; + $changes{$prefix}{$type} = 1; + } + } + } else { + my @vals = &Apache::loncommon::get_env_multiple('form.'.$prefix.'_'.$type); + my @okvals; + foreach my $val (@vals) { + if ($val =~ /:/) { + my @items = split(/:/,$val); + foreach my $item (@items) { + if (ref($by_location{$item}) eq 'ARRAY') { + push(@okvals,$item); + } + } + } else { + if (ref($by_location{$val}) eq 'ARRAY') { + push(@okvals,$val); + } + } + } + @okvals = sort(@okvals); + if (ref($domconfig{'usersessions'}) eq 'HASH') { + if (ref($domconfig{'usersessions'}{$prefix}) eq 'HASH') { + if (ref($domconfig{'usersessions'}{$prefix}{$type}) eq 'ARRAY') { + if ($inuse == 0) { + $changes{$prefix}{$type} = 1; + } else { + $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; + my @changed = &Apache::loncommon::compare_arrays($domconfig{'usersessions'}{$prefix}{$type},$defaultshash{'usersessions'}{$prefix}{$type}); + if (@changed > 0) { + $changes{$prefix}{$type} = 1; + } + } + } else { + if ($inuse == 1) { + $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; + $changes{$prefix}{$type} = 1; + } + } + } else { + if ($inuse == 1) { + $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; + $changes{$prefix}{$type} = 1; + } + } + } else { + if ($inuse == 1) { + $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; + $changes{$prefix}{$type} = 1; + } + } + } + } + } + + 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); + if ($putresult eq 'ok') { + if (ref($defaultshash{'usersessions'}) eq 'HASH') { + if (ref($defaultshash{'usersessions'}{'remote'}) eq 'HASH') { + $domdefaults{'remotesessions'} = $defaultshash{'usersessions'}{'remote'}; + } + if (ref($defaultshash{'usersessions'}{'hosted'}) eq 'HASH') { + $domdefaults{'hostedsessions'} = $defaultshash{'usersessions'}{'hosted'}; + } + } + my $cachetime = 24*60*60; + &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); + my %lt = &usersession_titles(); + $resulttext = &mt('Changes made:').'
      '; + foreach my $prefix (@prefixes) { + if (ref($changes{$prefix}) eq 'HASH') { + $resulttext .= '
    • '.$lt{$prefix}.'
        '; + 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 .= '
      • '; + } + } + } 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 { + if ($type eq 'version') { + $newvalue .= ' '.&mt('(or later)'); + } + $resulttext .= '
      • '.&mt('[_1] set to: [_2].',$lt{$type},$newvalue).'
      • '; + } + } + } + } + $resulttext .= '
      '; + } + } + $resulttext .= '
    '; + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + } else { + $resulttext = &mt('No changes made to settings for user session hosting/offloading.'); + } + return $resulttext; +} + sub recurse_check { my ($chkcats,$categories,$depth,$name) = @_; if (ref($chkcats->[$depth]{$name}) eq 'ARRAY') { @@ -6662,4 +7345,18 @@ sub active_dc_picker { return ($numdcs,$datatable); } +sub usersession_titles { + return &Apache::lonlocal::texthash( + 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', + ); +} + 1;