--- loncom/interface/domainprefs.pm 2011/08/10 14:54:42 1.152 +++ loncom/interface/domainprefs.pm 2011/10/30 22:19:15 1.158 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: domainprefs.pm,v 1.152 2011/08/10 14:54:42 raeburn Exp $ +# $Id: domainprefs.pm,v 1.158 2011/10/30 22:19:15 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -171,6 +171,9 @@ use Locale::Language; use DateTime::TimeZone; use DateTime::Locale; +my $registered_cleanup; +my $modified_urls; + sub handler { my $r=shift; if ($r->header_only) { @@ -190,6 +193,10 @@ 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']); @@ -399,7 +406,8 @@ sub handler { &Apache::loncommon::sorted_inst_types($dom); $js = &lonbalance_targets_js($dom,$types,\%servers). &new_spares_js(). - &common_domprefs_js(); + &common_domprefs_js(). + &Apache::loncommon::javascript_array_indexof(); } &Apache::lonconfigsettings::display_settings($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname,$js); } else { @@ -2762,7 +2770,7 @@ sub print_loadbalancing { if (ref($types) eq 'ARRAY') { $rownum += scalar(@{$types}); } - my $css_class = 'class="LC_odd_row"'; + my $css_class = ' class="LC_odd_row"'; my $targets_div_style = 'display: none'; my $disabled_div_style = 'display: block'; my $homedom_div_style = 'display: none'; @@ -2835,14 +2843,14 @@ sub print_loadbalancing { $datatable .= ''. &loadbalancing_rules($dom,$intdom,$currrules,$othertitle, $usertypes,$types,\%servers,$currbalancer, - $targets_div_style,$homedom_div_style); + $targets_div_style,$homedom_div_style,$css_class); $$rowtotal += $rownum; return $datatable; } sub loadbalancing_rules { my ($dom,$intdom,$currrules,$othertitle,$usertypes,$types,$servers, - $currbalancer,$targets_div_style,$homedom_div_style) = @_; + $currbalancer,$targets_div_style,$homedom_div_style,$css_class) = @_; my $output; my ($alltypes,$othertypes,$titles) = &loadbalancing_titles($dom,$intdom,$usertypes,$types); @@ -2859,7 +2867,7 @@ sub loadbalancing_rules { } $output .= &loadbalance_rule_row($type,$titles->{$type},$current, $servers,$currbalancer,$dom, - $targets_div_style,$homedom_div_style); + $targets_div_style,$homedom_div_style,$css_class); } } return $output; @@ -2897,7 +2905,7 @@ sub loadbalancing_titles { sub loadbalance_rule_row { my ($type,$title,$current,$servers,$currbalancer,$dom,$targets_div_style, - $homedom_div_style) = @_; + $homedom_div_style,$css_class) = @_; my @rulenames = ('default','homeserver'); my %ruletitles = &offloadtype_text(); if ($type eq '_LC_external') { @@ -2910,7 +2918,7 @@ sub loadbalance_rule_row { $style = $homedom_div_style; } my $output = - '
'.$title.'
'."\n". + '
'.$title.'
'."\n". '
'."\n"; for (my $i=0; $i<@rulenames; $i++) { my $rule = $rulenames[$i]; @@ -3858,7 +3866,7 @@ sub print_serverstatuses { sub serverstatus_pages { return ('userstatus','lonstatus','loncron','server-status','codeversions', 'clusterstatus','metadata_keywords','metadata_harvest', - 'takeoffline','takeonline','showenv','toggledebug'); + 'takeoffline','takeonline','showenv','toggledebug','ping','domconf'); } sub coursecategories_javascript { @@ -4926,7 +4934,7 @@ sub publishlogo { # See if there is anything left unless ($fname) { return ('error: no uploaded file'); } $fname="$subdir/$fname"; - my $filepath='/home/'.$confname.'/public_html'; + my $filepath=$r->dir_config('lonDocRoot')."/priv/$dom/$confname"; my ($fnamepath,$file,$fetchthumb); $file=$fname; if ($fname=~m|/|) { @@ -5004,8 +5012,15 @@ $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').", $!"; @@ -5023,8 +5038,15 @@ $env{'user.name'}.':'.$env{'user.domain' my $copyfile=$targetdir.'/tn-'.$file; if (copy($outfile,$copyfile)) { print $logfile "\nCopied source to ".$copyfile."\n"; - &write_metadata($dom,$confname,$formname, - $targetdir,'tn-'.$file,$logfile); + 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; + } } else { print $logfile "\nUnable to write ".$copyfile. ':'.$!."\n"; @@ -5089,30 +5111,79 @@ sub write_metadata { { print $logfile "\nWrite metadata file for ".$targetdir.'/'.$file; my $mfh; - unless (open($mfh,'>'.$targetdir.'/'.$file.'.meta')) { + 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"; $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 { @@ -7861,14 +7932,13 @@ sub active_dc_picker { 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', + default => 'Default', ); }