--- loncom/interface/domainprefs.pm 2011/08/09 12:16:41 1.151 +++ loncom/interface/domainprefs.pm 2012/08/21 21:12:08 1.164 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: domainprefs.pm,v 1.151 2011/08/09 12:16:41 raeburn Exp $ +# $Id: domainprefs.pm,v 1.164 2012/08/21 21:12:08 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -86,8 +86,8 @@ $dom,$settings,$rowtotal,$action. $dom is the domain, $settings is a reference to a hash of current settings for the current context, $rowtotal is a reference to the scalar used to record the -number of rows displayed on the page, and $action is the context (either quotas -or requestcourses). +number of rows displayed on the page, and $action is the context (quotas, +requestcourses or requestauthor). The print_quotas routine was orginally created to display/store information about default quota sizes for portfolio spaces for the different types of @@ -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']); @@ -204,11 +211,13 @@ sub handler { 'directorysrch','usercreation','usermodification', 'contacts','defaults','scantron','coursecategories', 'serverstatuses','requestcourses','helpsettings', - 'coursedefaults','usersessions','loadbalancing'],$dom); + 'coursedefaults','usersessions','loadbalancing', + 'requestauthor'],$dom); my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll', 'autoupdate','autocreate','directorysrch','contacts', 'usercreation','usermodification','scantron', - 'requestcourses','coursecategories','serverstatuses','helpsettings', + 'requestcourses','requestauthor','coursecategories', + 'serverstatuses','helpsettings', 'coursedefaults','usersessions'); if (keys(%servers) > 1) { push(@prefs_order,'loadbalancing'); @@ -240,7 +249,7 @@ sub handler { col2 => 'Value'}], }, 'quotas' => - { text => 'User blogs, personal information pages, portfolios', + { text => 'Blogs, personal web pages, webDAV, portfolios', help => 'Domain_Configuration_Quotas', header => [{col1 => 'User affiliation', col2 => 'Available tools', @@ -316,6 +325,14 @@ sub handler { {col1 => 'Setting', col2 => 'Value'}], }, + 'requestauthor' => + {text => 'Request authoring space', + help => 'Domain_Configuration_Request_Author', + header => [{col1 => 'User affiliation', + col2 => 'Availability/Processing of requests',}, + {col1 => 'Setting', + col2 => 'Value'}], + }, 'coursecategories' => { text => 'Cataloging of courses/communities', help => 'Domain_Configuration_Cataloging_Courses', @@ -375,7 +392,6 @@ sub handler { ], }, ); - my $js; if (keys(%servers) > 1) { $prefs{'login'} = { text => 'Log-in page options', help => 'Domain_Configuration_Login_Page', @@ -384,10 +400,6 @@ sub handler { {col1 => 'Log-in Page Items', col2 => ''}], }; - my ($othertitle,$usertypes,$types) = - &Apache::loncommon::sorted_inst_types($dom); - - $js = &lonbalance_targets_js($dom,$types,\%servers); } my @roles = ('student','coordinator','author','admin'); my @actions = &Apache::loncommon::get_env_multiple('form.actions'); @@ -398,6 +410,15 @@ sub handler { if ($phase eq 'process') { &Apache::lonconfigsettings::make_changes($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname,\@roles); } elsif ($phase eq 'display') { + my $js; + if (keys(%servers) > 1) { + my ($othertitle,$usertypes,$types) = + &Apache::loncommon::sorted_inst_types($dom); + $js = &lonbalance_targets_js($dom,$types,\%servers). + &new_spares_js(). + &common_domprefs_js(). + &Apache::loncommon::javascript_array_indexof(); + } &Apache::lonconfigsettings::display_settings($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname,$js); } else { if (keys(%domconfig) == 0) { @@ -476,6 +497,8 @@ sub process_changes { $output = &modify_serverstatuses($dom,%domconfig); } elsif ($action eq 'requestcourses') { $output = &modify_quotas($dom,$action,%domconfig); + } elsif ($action eq 'requestauthor') { + $output = &modify_quotas($dom,$action,%domconfig); } elsif ($action eq 'helpsettings') { $output = &modify_helpsettings($r,$dom,$confname,%domconfig); } elsif ($action eq 'coursedefaults') { @@ -538,6 +561,8 @@ sub print_config_box { $colspan = ' colspan="2"'; } elsif ($action eq 'requestcourses') { $output .= &print_quotas($dom,$settings,\$rowtotal,$action); + } elsif ($action eq 'requestauthor') { + $output .= &print_quotas($dom,$settings,\$rowtotal,$action); } elsif ($action eq 'helpsettings') { $output .= &print_helpsettings('top',$dom,$confname,$settings,\$rowtotal); } elsif ($action eq 'usersessions') { @@ -604,7 +629,9 @@ sub print_config_box { } elsif ($action eq 'login') { $output .= &print_login('bottom',$dom,$confname,$phase,$settings,\$rowtotal); } elsif ($action eq 'requestcourses') { - $output .= &print_courserequestmail($dom,$settings,\$rowtotal); + $output .= &print_requestmail($dom,$action,$settings,\$rowtotal); + } elsif ($action eq 'requestauthor') { + $output .= &print_requestmail($dom,$action,$settings,\$rowtotal); } elsif ($action eq 'helpsettings') { $output .= &print_helpsettings('bottom',$dom,$confname,$settings,\$rowtotal); } elsif ($action eq 'usersessions') { @@ -1047,6 +1074,7 @@ sub print_rolecolors { sub display_color_options { my ($dom,$confname,$phase,$role,$itemcount,$choices,$is_custom,$defaults,$designs, $images,$bgs,$links,$alt_text,$rowtotal,$logintext) = @_; + my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; my $css_class = $itemcount%2?' class="LC_odd_row"':''; my $datatable = ''. ''.$choices->{'font'}.''; @@ -1124,11 +1152,11 @@ sub display_color_options { $showfile = $imgfile; my $imgdir = $1; my $filename = $2; - if (-e "/home/httpd/html/$imgdir/tn-".$filename) { + if (-e "$londocroot/$imgdir/tn-".$filename) { $showfile = "/$imgdir/tn-".$filename; } else { - my $input = "/home/httpd/html".$imgfile; - my $output = '/home/httpd/html/'.$imgdir.'/tn-'.$filename; + my $input = $londocroot.$imgfile; + my $output = "$londocroot/$imgdir/tn-".$filename; if (!-e $output) { my ($width,$height) = &thumb_dimensions(); my ($fullwidth,$fullheight) = &check_dimensions($input); @@ -1136,7 +1164,7 @@ sub display_color_options { if ($fullwidth > $width && $fullheight > $height) { my $size = $width.'x'.$height; system("convert -sample $size $input $output"); - $showfile = '/'.$imgdir.'/tn-'.$filename; + $showfile = "/$imgdir/tn-".$filename; } } } @@ -1364,14 +1392,19 @@ sub print_quotas { @options =('norequest','approval','validate','autolimit'); %validations = &Apache::lonnet::auto_courserequest_checks($dom); %titles = &courserequest_titles(); + } elsif ($context eq 'requestauthor') { + @usertools = ('author'); + @options = ('norequest','approval','automatic'); + %titles = &authorrequest_titles(); } else { - @usertools = ('aboutme','blog','portfolio'); + @usertools = ('aboutme','blog','webdav','portfolio'); %titles = &tool_titles(); } if (ref($types) eq 'ARRAY') { foreach my $type (@{$types}) { my $currdefquota; - unless ($context eq 'requestcourses') { + unless (($context eq 'requestcourses') || + ($context eq 'requestauthor')) { if (ref($settings) eq 'HASH') { if (ref($settings->{defaultquota}) eq 'HASH') { $currdefquota = $settings->{defaultquota}->{$type}; @@ -1441,6 +1474,28 @@ sub print_quotas { $cell{$item} .= $titles{'unlimited'}; } } + } elsif ($context eq 'requestauthor') { + my $curroption; + if (ref($settings) eq 'HASH') { + $curroption = $settings->{$type}; + } + if (!$curroption) { + $curroption = 'norequest'; + } + foreach my $option (@options) { + my $val = $option; + if ($option eq 'norequest') { + $val = 0; + } + my $checked = ''; + if ($option eq $curroption) { + $checked = ' checked="checked"'; + } + $datatable .= '  '; + } } else { my $checked = 'checked="checked" '; if (ref($settings) eq 'HASH') { @@ -1466,7 +1521,8 @@ sub print_quotas { $datatable .= ''; } $datatable .= ''; - unless ($context eq 'requestcourses') { + unless (($context eq 'requestcourses') || + ($context eq 'requestauthor')) { $datatable .= ''. ''. + $titles{$option}.'  '; + } } else { my $checked = 'checked="checked" '; if (ref($settings) eq 'HASH') { @@ -1572,7 +1652,7 @@ sub print_quotas { $datatable .= ''; } $datatable .= ''; - unless ($context eq 'requestcourses') { + unless (($context eq 'requestcourses') || ($context eq 'requestauthor')) { $datatable .= ''. ' Mb'; @@ -1650,6 +1730,33 @@ sub print_quotas { $advcell{$item} .= $titles{'unlimited'}; } } + } elsif ($context eq 'requestauthor') { + my $curroption; + if (ref($settings) eq 'HASH') { + $curroption = $settings->{'_LC_adv'}; + } + my $checked = ''; + if ($curroption eq '') { + $checked = ' checked="checked"'; + } + $datatable .= '  '; + foreach my $option (@options) { + my $val = $option; + if ($option eq 'norequest') { + $val = 0; + } + my $checked = ''; + if ($val eq $curroption) { + $checked = ' checked="checked"'; + } + $datatable .= '  '; + } } else { my $checked = 'checked="checked" '; if (ref($settings) eq 'HASH') { @@ -1679,8 +1786,8 @@ sub print_quotas { return $datatable; } -sub print_courserequestmail { - my ($dom,$settings,$rowtotal) = @_; +sub print_requestmail { + my ($dom,$action,$settings,$rowtotal) = @_; my ($now,$datatable,%dompersonnel,@domcoord,@currapproval,$rows); $now = time; $rows = 0; @@ -1711,9 +1818,14 @@ sub print_courserequestmail { my $numinrow = 4; my $numdc = @domcoord; my $css_class = 'class="LC_odd_row"'; - $datatable = ''. - ' '.&mt('Receive notification of course requests requiring approval.'). - ' '. + my $text; + if ($action eq 'requestcourses') { + $text = &mt('Receive notification of course requests requiring approval'); + } else { + $text = &mt('Receive notification of authoring space requests requiring approval') + } + $datatable = ''. + ' '.$text.''. ' '; if (@domcoord > 0) { $datatable .= ''; @@ -2336,13 +2448,14 @@ sub print_usersessions { &build_location_hashes(\@intdoms,\%by_ip,\%by_location); my @alldoms = &Apache::lonnet::all_domains(); - my %uniques = &Apache::lonnet::get_unique_servers(\@alldoms); + my %serverhomes = %Apache::lonnet::serverhomeIDs; my %servers = &Apache::lonnet::internet_dom_servers($dom); + my %altids = &id_for_thisdom(%servers); my $itemcount = 1; if ($position eq 'top') { - if (keys(%uniques) > 1) { + if (keys(%serverhomes) > 1) { my %spareid = ¤t_offloads_to($dom,$settings,\%servers); - $datatable .= &spares_row(\%servers,\%spareid,\%uniques,$rowtotal); + $datatable .= &spares_row($dom,\%servers,\%spareid,\%serverhomes,\%altids,$rowtotal); } else { $datatable .= ''; + '.$server.' when busy, offloads to:'."\n"; my (%current,%canselect); - if (ref($spareid->{$server}) eq 'HASH') { - foreach my $type ('primary','default') { + my @choices = + &possible_newspares($server,$spareid->{$server},$serverhomes,$altids); + foreach my $type ('primary','default') { + if (ref($spareid->{$server}) eq 'HASH') { if (ref($spareid->{$server}{$type}) eq 'ARRAY') { my @spares = @{$spareid->{$server}{$type}}; if (@spares > 0) { - $current{$type} .= '
'. &mt('Nothing to set here, as the cluster to which this domain belongs only contains one server.'); @@ -2515,14 +2628,16 @@ sub build_location_hashes { sub current_offloads_to { my ($dom,$settings,$servers) = @_; my (%spareid,%otherdomconfigs); - if ((ref($settings) eq 'HASH') && (ref($servers) eq 'HASH')) { + if (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; + if (ref($settings) eq 'HASH') { + 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) { @@ -2590,63 +2705,101 @@ sub current_offloads_to { } sub spares_row { - my ($servers,$spareid,$uniques,$rowtotal) = @_; + my ($dom,$servers,$spareid,$serverhomes,$altids,$rowtotal) = @_; my $css_class; my $numinrow = 4; my $itemcount = 1; my $datatable; - if ((ref($servers) eq 'HASH') && (ref($spareid) eq 'HASH')) { + my %typetitles = &sparestype_titles(); + if ((ref($servers) eq 'HASH') && (ref($spareid) eq 'HASH') && (ref($altids) eq 'HASH')) { foreach my $server (sort(keys(%{$servers}))) { + my $serverhome = &Apache::lonnet::get_server_homeID($servers->{$server}); + my ($othercontrol,$serverdom); + if ($serverhome ne $server) { + $serverdom = &Apache::lonnet::host_domain($serverhome); + $othercontrol = &mt('Session offloading controlled by domain: [_1]',''.$serverdom.''); + } else { + $serverdom = &Apache::lonnet::host_domain($server); + if ($serverdom ne $dom) { + $othercontrol = &mt('Session offloading controlled by domain: [_1]',''.$serverdom.''); + } + } + next unless (ref($spareid->{$server}) eq 'HASH'); $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; $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} .= ''; + if ($othercontrol) { + $current{$type} = join(', ',@spares); + } else { + $current{$type} .= '
'; + my $numspares = scalar(@spares); + 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} .= ''."\n"; + } + my $rem = @spares%($numinrow); + my $colsleft = $numinrow - $rem; + if ($colsleft > 1 ) { + $current{$type} .= ''; + } elsif ($colsleft == 1) { + $current{$type} .= ''."\n"; } - $current{$type} .= ''; - } - my $rem = @spares%($numinrow); - my $colsleft = $numinrow - $rem; - if ($colsleft > 1 ) { - $current{$type} .= ''; - } elsif ($colsleft == 1) { - $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); + if ($othercontrol) { + if ($type eq 'primary') { + $canselect{$type} = $othercontrol; + } + } else { + $canselect{$type} = + &mt('Add new [_1]'.$type.'[_2]:','','').' '. + ''."\n"; + } + } else { + $current{$type} = &mt('Could not be determined'); + if ($type eq 'primary') { + $canselect{$type} = $othercontrol; + } } + if ($type eq 'default') { + $datatable .= ''; + } + $datatable .= ''.$typetitles{$type}.''."\n". + ''.$current{$type}.''."\n". + ''.$canselect{$type}.''."\n"; } - $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 ++; } } @@ -2654,26 +2807,42 @@ sub spares_row { return $datatable; } -sub newspare_select { - my ($server,$type,$currspares,$uniques) = @_; - my $output; - if (ref($uniques) eq 'HASH') { - if (keys(%{$uniques}) > 1) { - $output = ''; } } - return $output; + my @choices; + if ((ref($serverhomes) eq 'HASH') && (ref($altids) eq 'HASH')) { + if (keys(%{$serverhomes}) > 1) { + foreach my $name (sort(keys(%{$serverhomes}))) { + unless ($excluded{$name}) { + if (exists($altids->{$serverhomes->{$name}})) { + push(@choices,$altids->{$serverhomes->{$name}}); + } else { + push(@choices,$serverhomes->{$name}); + } + } + } + } + } + return sort(@choices); } sub print_loadbalancing { @@ -2702,7 +2871,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'; @@ -2775,14 +2944,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); @@ -2799,7 +2968,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; @@ -2837,7 +3006,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') { @@ -2845,12 +3014,13 @@ sub loadbalance_rule_row { } else { push(@rulenames,'specific'); } + push(@rulenames,'none'); my $style = $targets_div_style; if (($type eq '_LC_external') || ($type eq '_LC_internetdom')) { $style = $homedom_div_style; } my $output = - '
'.$title.'
'."\n". + '
'.$title.'
'."\n". '
'."\n"; for (my $i=0; $i<@rulenames; $i++) { my $rule = $rulenames[$i]; @@ -2901,6 +3071,7 @@ sub offloadtype_text { 'homeserver' => "Offloads to user's home server", 'externalbalancer' => "Offloads to Load Balancer in user's domain", 'specific' => 'Offloads to specific server', + 'none' => 'No offload', ); return %ruletitles; } @@ -2932,8 +3103,9 @@ sub contact_titles { sub tool_titles { my %titles = &Apache::lonlocal::texthash ( - aboutme => 'Personal Information Page', + aboutme => 'Personal web page', blog => 'Blog', + webdav => 'WebDAV', portfolio => 'Portfolio', official => 'Official courses (with institutional codes)', unofficial => 'Unofficial courses', @@ -2956,6 +3128,15 @@ sub courserequest_titles { return %titles; } +sub authorrequest_titles { + my %titles = &Apache::lonlocal::texthash ( + norequest => 'Not allowed', + approval => 'Approval by Dom. Coord.', + automatic => 'Automatic approval', + ); + return %titles; +} + sub courserequest_conditions { my %conditions = &Apache::lonlocal::texthash ( approval => '(Processing of request subject to approval by Domain Coordinator).', @@ -3798,7 +3979,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 { @@ -4866,15 +5047,17 @@ 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 $docroot=$r->dir_config('lonDocRoot'); + my $filepath="$docroot/priv"; + my $relpath = "$dom/$confname"; my ($fnamepath,$file,$fetchthumb); $file=$fname; if ($fname=~m|/|) { ($fnamepath,$file) = ($fname =~ m|^(.*)/([^/]+)$|); } - my @parts=split(/\//,$filepath.'/'.$fnamepath); + my @parts=split(/\//,"$filepath/$relpath/$fnamepath"); my $count; - for ($count=4;$count<=$#parts;$count++) { + for ($count=5;$count<=$#parts;$count++) { $filepath.="/$parts[$count]"; if ((-e $filepath)!=1) { mkdir($filepath,02770); @@ -4921,7 +5104,6 @@ $env{'user.name'}.':'.$env{'user.domain' close(FH); chmod(0660, $source); # Permissions to rw-rw---. - my $docroot=$r->dir_config('lonDocRoot'); my $targetdir=$docroot.'/res/'.$dom.'/'.$confname .'/'.$fnamepath; my $copyfile=$targetdir.'/'.$file; @@ -4944,8 +5126,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').", $!"; @@ -4963,8 +5152,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"; @@ -5029,30 +5225,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 { @@ -5076,7 +5321,7 @@ sub modify_quotas { %limithash,$toolregexp,%conditions,$resulttext,%changes); if ($action eq 'quotas') { $context = 'tools'; - } else { + } else { $context = $action; } if ($context eq 'requestcourses') { @@ -5086,8 +5331,11 @@ sub modify_quotas { %titles = &courserequest_titles(); $toolregexp = join('|',@usertools); %conditions = &courserequest_conditions(); + } elsif ($context eq 'requestauthor') { + @usertools = ('author'); + %titles = &authorrequest_titles(); } else { - @usertools = ('aboutme','blog','portfolio'); + @usertools = ('aboutme','blog','webdav','portfolio'); %titles = &tool_titles(); } my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); @@ -5103,6 +5351,10 @@ sub modify_quotas { $confhash{$item}{$type} = $env{$key}; } } + } elsif ($context eq 'requestauthor') { + if ($key =~ /^\Qform.authorreq_\E(.+)$/) { + $confhash{$1} = $env{$key}; + } } else { if ($key =~ /^form\.quota_(.+)$/) { $confhash{'defaultquota'}{$1} = $env{$key}; @@ -5112,7 +5364,7 @@ sub modify_quotas { } } } - if ($context eq 'requestcourses') { + if (($context eq 'requestcourses') || ($context eq 'requestauthor')) { my @approvalnotify = &Apache::loncommon::get_env_multiple('form.reqapprovalnotify'); @approvalnotify = sort(@approvalnotify); $confhash{'notify'}{'approval'} = join(',',@approvalnotify); @@ -5148,6 +5400,11 @@ sub modify_quotas { $confhash{$item}{$type} .= $limithash{$item}{$type}; } } + } elsif ($context eq 'requestauthor') { + $unset = '0'; + if ($type eq '_LC_adv') { + $unset = ''; + } } else { if (grep(/^\Q$type\E$/,@{$toolshash{$item}})) { $confhash{$item}{$type} = 1; @@ -5156,7 +5413,11 @@ sub modify_quotas { } } if (ref($domconfig{$action}) eq 'HASH') { - if (ref($domconfig{$action}{$item}) eq 'HASH') { + if ($action eq 'requestauthor') { + if ($domconfig{$action}{$type} ne $confhash{$type}) { + $changes{$type} = 1; + } + } elsif (ref($domconfig{$action}{$item}) eq 'HASH') { if ($domconfig{$action}{$item}{$type} ne $confhash{$item}{$type}) { $changes{$item}{$type} = 1; } @@ -5176,6 +5437,10 @@ sub modify_quotas { if ($confhash{$item}{$type} ne $unset) { $changes{$item}{$type} = 1; } + } elsif ($context eq 'requestauthor') { + if ($confhash{$type} ne $unset) { + $changes{$type} = 1; + } } else { if (!$confhash{$item}{$type}) { $changes{$item}{$type} = 1; @@ -5184,7 +5449,7 @@ sub modify_quotas { } } } - unless ($context eq 'requestcourses') { + unless (($context eq 'requestcourses') || ($context eq 'requestauthor')) { if (ref($domconfig{'quotas'}) eq 'HASH') { if (ref($domconfig{'quotas'}{'defaultquota'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'quotas'}{'defaultquota'}})) { @@ -5227,10 +5492,14 @@ sub modify_quotas { } } - foreach my $key (keys(%confhash)) { - $domdefaults{$key} = $confhash{$key}; + if ($context eq 'requestauthor') { + $domdefaults{'requestauthor'} = \%confhash; + } else { + foreach my $key (keys(%confhash)) { + $domdefaults{$key} = $confhash{$key}; + } } - + my %quotahash = ( $action => { %confhash } ); @@ -5242,7 +5511,8 @@ sub modify_quotas { &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); $resulttext = &mt('Changes made:').'
    '; - unless ($context eq 'requestcourses') { + unless (($context eq 'requestcourses') || + ($context eq 'requestauthor')) { if (ref($changes{'defaultquota'}) eq 'HASH') { $resulttext .= '
  • '.&mt('Portfolio default quotas').'
      '; foreach my $type (@{$types},'default') { @@ -5259,12 +5529,25 @@ sub modify_quotas { } my %newenv; foreach my $item (@usertools) { - if (ref($changes{$item}) eq 'HASH') { + my (%haschgs,%inconf); + if ($context eq 'requestauthor') { + %haschgs = %changes; + %inconf = %confhash; + } else { + if (ref($changes{$item}) eq 'HASH') { + %haschgs = %{$changes{$item}}; + } + if (ref($confhash{$item}) eq 'HASH') { + %inconf = %{$confhash{$item}}; + } + } + if (keys(%haschgs) > 0) { my $newacc = &Apache::lonnet::usertools_access($env{'user.name'}, $env{'user.domain'}, $item,'reload',$context); - if ($context eq 'requestcourses') { + if (($context eq 'requestcourses') || + ($context eq 'requestauthor')) { if ($env{'environment.canrequest.'.$item} ne $newacc) { $newenv{'environment.canrequest.'.$item} = $newacc; } @@ -5273,26 +5556,28 @@ sub modify_quotas { $newenv{'environment.availabletools.'.$item} = $newacc; } } - $resulttext .= '
    • '.$titles{$item}.'
        '; + unless ($context eq 'requestauthor') { + $resulttext .= '
      • '.$titles{$item}.'
          '; + } foreach my $type (@{$types},'default','_LC_adv') { - if ($changes{$item}{$type}) { + if ($haschgs{$type}) { my $typetitle = $usertypes->{$type}; if ($type eq 'default') { $typetitle = $othertitle; } elsif ($type eq '_LC_adv') { $typetitle = 'LON-CAPA Advanced Users'; } - if ($confhash{$item}{$type}) { + if ($inconf{$type}) { if ($context eq 'requestcourses') { my $cond; - if ($confhash{$item}{$type} =~ /^autolimit=(\d*)$/) { + if ($inconf{$type} =~ /^autolimit=(\d*)$/) { if ($1 eq '') { $cond = &mt('(Automatic processing of any request).'); } else { $cond = &mt('(Automatic processing of requests up to limit of [quant,_1,request] per user).',$1); } } else { - $cond = $conditions{$confhash{$item}{$type}}; + $cond = $conditions{$inconf{$type}}; } $resulttext .= '
        • '.&mt('Set to be available to [_1].',$typetitle).' '.$cond.'
          • '; } else { @@ -5300,7 +5585,7 @@ sub modify_quotas { } } else { if ($type eq '_LC_adv') { - if ($confhash{$item}{$type} eq '0') { + if ($inconf{$type} eq '0') { $resulttext .= '
        • '.&mt('Set to be unavailable to [_1]',$typetitle).'
          • '; } else { $resulttext .= '
        • '.&mt('No override set for [_1]',$typetitle).'
          • '; @@ -5311,17 +5596,19 @@ sub modify_quotas { } } } - $resulttext .= '
        • '; + unless ($context eq 'requestauthor') { + $resulttext .= '
      • '; + } } } - if ($action eq 'requestcourses') { + if (($action eq 'requestcourses') || ($action eq 'requestauthor')) { if (ref($changes{'notify'}) eq 'HASH') { if ($changes{'notify'}{'approval'}) { if (ref($confhash{'notify'}) eq 'HASH') { if ($confhash{'notify'}{'approval'}) { $resulttext .= '
    • '.&mt('Notification of requests requiring approval will be sent to: ').$confhash{'notify'}{'approval'}.'
      • '; } else { - $resulttext .= '
    • '.&mt('No Domain Coordinators will receive notification of course requests requiring approval.').'
      • '; + $resulttext .= '
    • '.&mt('No Domain Coordinators will receive notification of requests requiring approval.').'
      • '; } } } @@ -5334,6 +5621,8 @@ sub modify_quotas { } else { if ($context eq 'requestcourses') { $resulttext = &mt('No changes made to rights to request creation of courses.'); + } elsif ($context eq 'requestauthor') { + $resulttext = &mt('No changes made to rights to request author space.'); } else { $resulttext = &mt('No changes made to availability of personal information pages, blogs, portfolios or default quotas'); } @@ -7342,7 +7631,6 @@ sub modify_usersessions { } my @alldoms = &Apache::lonnet::all_domains(); - my %uniques = &Apache::lonnet::get_unique_servers(\@alldoms); my %servers = &Apache::lonnet::internet_dom_servers($dom); my %spareid = ¤t_offloads_to($dom,$domconfig{'usersessions'},\%servers); my $savespares; @@ -7350,34 +7638,26 @@ sub modify_usersessions { foreach my $lonhost (sort(keys(%servers))) { my $serverhomeID = &Apache::lonnet::get_server_homeID($servers{$lonhost}); + my $serverhostname = &Apache::lonnet::hostname($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); + if (&Apache::lonnet::hostname($server) ne '') { + unless (&Apache::lonnet::hostname($server) eq $serverhostname) { + unless (grep(/^\Q$server\E$/,@okspares)) { + push(@okspares,$server); + } } } } my $new = $env{'form.newspare_'.$type.'_'.$lonhost}; my $newspare; - if (($new ne '') && ($uniques{$new})) { - unless (($new eq $lonhost) || ($new eq $serverhomeID)) { + if (($new ne '') && (&Apache::lonnet::hostname($new))) { + unless (&Apache::lonnet::hostname($new) eq $serverhostname) { $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; @@ -7387,6 +7667,14 @@ sub modify_usersessions { @spares = sort(@okspares); } $defaultshash{'usersessions'}{'spares'}{$lonhost}{$type} = \@spares; + if (ref($spareid{$lonhost}) eq 'HASH') { + if (ref($spareid{$lonhost}{$type}) eq 'ARRAY') { + my @diffs = &Apache::loncommon::compare_arrays($spareid{$lonhost}{$type},\@spares); + if (@diffs > 0) { + $spareschg{$type} = 1; + } + } + } } if (keys(%spareschg) > 0) { $changes{'spares'}{$lonhost} = \%spareschg; @@ -7802,17 +8090,28 @@ 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', ); } +sub id_for_thisdom { + my (%servers) = @_; + my %altids; + foreach my $server (keys(%servers)) { + my $serverhome = &Apache::lonnet::get_server_homeID($servers{$server}); + if ($serverhome ne $server) { + $altids{$serverhome} = $server; + } + } + return %altids; +} + sub count_servers { my ($currbalancer,%servers) = @_; my (@spares,$numspares); @@ -7875,7 +8174,7 @@ function showSpares(balancer,ishomedom) document.getElementById('loadbalancing_targets').style.display='block'; document.getElementById('loadbalancing_disabled').style.display='none'; - + for (var i=0; i + + +END +} + +sub new_spares_js { + my @sparestypes = ('primary','default'); + my $types = join("','",@sparestypes); + my $select = &mt('Select'); + return <<"END"; + + + +END + +} + +sub common_domprefs_js { + return <<"END"; + + END + } 1;