--- loncom/interface/domainprefs.pm 2011/11/30 18:36:26 1.138.2.13 +++ loncom/interface/domainprefs.pm 2010/08/24 13:37:50 1.139 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: domainprefs.pm,v 1.138.2.13 2011/11/30 18:36:26 raeburn Exp $ +# $Id: domainprefs.pm,v 1.139 2010/08/24 13:37:50 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -140,7 +140,7 @@ autolimit =over -- course requests will be processed automatically up to a limit of +- course requests will be processed autoatically 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. @@ -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' => @@ -237,7 +230,7 @@ sub handler { }, 'defaults' => - { text => 'Default authentication/language/timezone/portal', + { text => 'Default authentication/language/timezone', help => 'Domain_Configuration_LangTZAuth', header => [{col1 => 'Setting', col2 => 'Value'}], @@ -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', @@ -462,6 +457,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') { @@ -519,9 +516,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 .= ' @@ -585,6 +584,8 @@ sub print_config_box { $output .= &print_helpsettings('bottom',$dom,$confname,$settings,\$rowtotal); } elsif ($action eq 'usersessions') { $output .= &print_usersessions('bottom',$dom,$settings,\$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).' @@ -671,8 +672,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 .= ' @@ -866,6 +867,7 @@ 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 .= @@ -1885,23 +1887,24 @@ sub print_autocreate { ''.&mt('Yes').' '. ''. - ''. - ''.&mt('Create pending requests for official courses (if validated)').''. - ' '. - ''; + $createoff{'xml'}.' value="0" />'.&mt('No').''; my ($numdc,$dctable) = &active_dc_picker($dom,$curr_dc); if ($numdc > 1) { - $datatable .= ''. - &mt('Course creation processed as: (choose Dom. Coord.)'). - ''.$dctable.''; + $datatable .= ''. + &mt('XML files processed as: (choose Dom. Coord.)'). + ''.$dctable.''. + ''; $$rowtotal ++ ; } else { - $datatable .= $dctable.''; + $datatable .= ''; } + $datatable .= ''.&mt('Create pending requests for official courses (if validated)').''. + ' '. + ''. + ''; return $datatable; } @@ -2284,17 +2287,9 @@ sub print_coursedefaults { 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); - 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 $itemcount = 1; - my $numinrow = 5; + my $numinrow = 6; my $prefix; my @types; if ($position eq 'top') { @@ -2306,6 +2301,8 @@ sub print_usersessions { } my (%current,%checkedon,%checkedoff); 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)); foreach my $type (@types) { $checkedon{$type} = ''; @@ -2328,7 +2325,6 @@ sub print_usersessions { } } foreach my $type (@types) { - next if ($type ne 'version' && !@locations); $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; $datatable .= ' '.$lt{$type}.'
@@ -2822,9 +2818,9 @@ sub print_usermodification { sub print_defaults { my ($dom,$rowtotal) = @_; my @items = ('auth_def','auth_arg_def','lang_def','timezone_def', - 'datelocale_def','portal_def'); + 'datelocale_def'); my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); - my $titles = &defaults_titles($dom); + my $titles = &defaults_titles(); my $rownum = 0; my ($datatable,$css_class); foreach my $item (@items) { @@ -2861,12 +2857,8 @@ 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}.'" />'; } $datatable .= ''; $rownum ++; @@ -2876,25 +2868,13 @@ 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); } @@ -3336,7 +3316,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 +4462,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 +4481,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 +4547,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 { @@ -4723,12 +4640,12 @@ sub modify_quotas { $changes{'notify'}{'approval'} = 1; } } else { - if ($confhash{'notify'}{'approval'}) { + if ($domconfig{$action}{'notify'}{'approval'}) { $changes{'notify'}{'approval'} = 1; } } } else { - if ($confhash{'notify'}{'approval'}) { + if ($domconfig{$action}{'notify'}{'approval'}) { $changes{'notify'}{'approval'} = 1; } } @@ -5049,7 +4966,7 @@ sub modify_autoupdate { middlename => 'Middle Name', generation => 'Generation', ); - $othertitle = &mt('All users'); + my $othertitle = &mt('All users'); if (keys(%{$usertypes}) > 0) { $othertitle = &mt('Other users'); } @@ -6093,7 +6010,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','portal_def'); + my @items = ('auth_def','auth_arg_def','lang_def','timezone_def','datelocale_def'); my @authtypes = ('internal','krb4','krb5','localauth'); foreach my $item (@items) { $newvalues{$item} = $env{'form.'.$item}; @@ -6129,12 +6046,6 @@ 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}; @@ -6551,6 +6462,7 @@ sub modify_serverstatuses { my %serverstatushash = ( serverstatuses => \%newserverstatus, ); + my %changes; foreach my $type (@pages) { foreach my $setting ('namedusers','machines') { my (@current,@new); @@ -6751,7 +6663,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'} = {}; @@ -6813,7 +6725,7 @@ sub modify_coursedefaults { } } elsif ($item eq 'anonsurvey_threshold') { $resulttext .= '
  • '.&mt('Responder count required for display of anonymous survey submissions set to [_1].',$defaultshash{'coursedefaults'}{'anonsurvey_threshold'}).'
  • '; - } + } } $resulttext .= ''; } else {