# The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # # $Id: domainprefs.pm,v 1.39 2008/01/04 10:17:13 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA# # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # ############################################################### ############################################################## package Apache::domainprefs; use strict; use Apache::Constants qw(:common :http); use Apache::lonnet; use Apache::loncommon(); use Apache::lonhtmlcommon(); use Apache::lonlocal; use LONCAPA(); use LONCAPA::Enrollment; use File::Copy; sub handler { my $r=shift; if ($r->header_only) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; return OK; } my $dom = $env{'request.role.domain'}; my $domdesc = &Apache::lonnet::domain($dom,'description'); if (&Apache::lonnet::allowed('mau',$dom)) { &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; } else { $env{'user.error.msg'}= "/adm/domainprefs:mau:0:0:Cannot modify domain settings"; return HTTP_NOT_ACCEPTABLE; } &Apache::lonhtmlcommon::clear_breadcrumbs(); &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['phase']); my $phase = 'pickactions'; if ( exists($env{'form.phase'}) ) { $phase = $env{'form.phase'}; } my %domconfig = &Apache::lonnet::get_dom('configuration',['login','rolecolors', 'quotas','autoenroll','autoupdate','directorysrch', 'usercreation','usermodification','contacts'],$dom); my @prefs_order = ('rolecolors','login','quotas','autoenroll', 'autoupdate','directorysrch','contacts', 'usercreation','usermodification'); my %prefs = ( 'rolecolors' => { text => 'Default color schemes', help => 'Default_Color_Schemes', header => [{col1 => 'Student Settings', col2 => '',}, {col1 => 'Coordinator Settings', col2 => '',}, {col1 => 'Author Settings', col2 => '',}, {col1 => 'Administrator Settings', col2 => '',}], }, 'login' => { text => 'Log-in page options', help => 'Domain_Log-in_Page', header => [{col1 => 'Item', col2 => '',}], }, 'quotas' => { text => 'Default quotas for user portfolios', help => 'Default_User_Quota', header => [{col1 => 'User type', col2 => 'Default quota'}], }, 'autoenroll' => { text => 'Auto-enrollment settings', help => 'Domain_Auto_Enrollment', header => [{col1 => 'Configuration setting', col2 => 'Value(s)'}], }, 'autoupdate' => { text => 'Auto-update settings', help => 'Domain_Auto_Update', header => [{col1 => 'Setting', col2 => 'Value',}, {col1 => 'User Population', col2 => 'Updataeable user data'}], }, 'directorysrch' => { text => 'Institutional directory searches', help => 'Domain_Directory_Search', header => [{col1 => 'Setting', col2 => 'Value',}], }, 'contacts' => { text => 'Contact Information', help => 'Domain_Contact_Information', header => [{col1 => 'Setting', col2 => 'Value',}], }, 'usercreation' => { text => 'User creation', help => 'Domain_User_Creation', header => [{col1 => 'Format Rule Type', col2 => 'Format Rules in force'}, {col1 => 'User account creation', col2 => 'Usernames which may be created',}, {col1 => 'Context', col2 => 'Assignable Authentication Types'}], }, 'usermodification' => { text => 'User modification', help => 'Domain_User_Modification', header => [{col1 => 'Target user has role', col2 => 'User information updateable in author context'}, {col1 => 'Target user has role', col2 => 'User information updateable in course context'}], }, ); my @roles = ('student','coordinator','author','admin'); my @actions = &Apache::loncommon::get_env_multiple('form.actions'); &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:changePage(document.$phase,'pickactions')", text=>"Pick functionality"}); my $confname = $dom.'-domainconfig'; if ($phase eq 'process') { &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:changePage(document.$phase,'display')", text=>"Domain Configuration"}, {href=>"javascript:changePage(document.$phase,'$phase')", text=>"Updated"}); &print_header($r,$phase); foreach my $item (@prefs_order) { if (grep(/^\Q$item\E$/,@actions)) { $r->print('

'.&mt($prefs{$item}{'text'}).'

'. &process_changes($r,$dom,$confname,$item, \@roles,%domconfig)); } } $r->print('

'); &print_footer($r,$phase,'display','Back to configuration display', \@actions); $r->print('

'); } elsif ($phase eq 'display') { &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:changePage(document.$phase,'display')", text=>"Domain Configuration"}); &print_header($r,$phase); if (@actions > 0) { my $rowsum = 0; my (%output,%rowtotal,@items); my $halfway = @actions/2; foreach my $item (@prefs_order) { if (grep(/^\Q$item\E$/,@actions)) { push(@items,$item); ($output{$item},$rowtotal{$item}) = &print_config_box($r,$dom,$confname,$phase, $item,$prefs{$item}, $domconfig{$item}); $rowsum += $rowtotal{$item}; } } my $colend; my $halfway = $rowsum/2; my $aggregate = 0; my $sumleft = 0; my $sumright = 0; my $crossover; for (my $i=0; $i<@items; $i++) { $aggregate += $rowtotal{$items[$i]}; if ($aggregate > $halfway) { $crossover = $i; last; } } for (my $i=0; $i<$crossover; $i++) { $sumleft += $rowtotal{$items[$i]}; } for (my $i=$crossover+1; $i<@items; $i++) { $sumright += $rowtotal{$items[$i]}; } if ((@items > 1) && ($env{'form.numcols'} == 2)) { my $sumdiff = $sumright - $sumleft; if ($sumdiff > 0) { $colend = $crossover + 1; } else { $colend = $crossover; } } else { $colend = @items; } $r->print('

'); for (my $i=0; $i<$colend; $i++) { $r->print($output{$items[$i]}); } $r->print(''); if ($colend < @items) { for (my $i=$colend; $i<@items; $i++) { $r->print($output{$items[$i]}); } } $r->print('

'); $r->print(&print_footer($r,$phase,'process','Save',\@actions)); } else { $r->print(''. ''."\n". ''.&mt('No settings chosen'). ''); } $r->print(''); $r->print(&Apache::loncommon::end_page()); } else { if ($phase eq '') { $phase = 'pickactions'; } my %helphash; &print_header($r,$phase); if (keys(%domconfig) == 0) { my $primarylibserv = &Apache::lonnet::domain($dom,'primary'); my @ids=&Apache::lonnet::current_machine_ids(); if (!grep(/^\Q$primarylibserv\E$/,@ids)) { my %designhash = &Apache::loncommon::get_domainconf($dom); my @loginimages = ('img','logo','domlogo'); my $custom_img_count = 0; foreach my $img (@loginimages) { if ($designhash{$dom.'.login.'.$img} ne '') { $custom_img_count ++; } } foreach my $role (@roles) { if ($designhash{$dom.'.'.$role.'.img'} ne '') { $custom_img_count ++; } } if ($custom_img_count > 0) { my $switch_server = &check_switchserver($dom,$confname); $r->print( &mt('Domain configuration settings have yet to be saved for this domain via the web-based domain preferences interface.').'
'. &mt("While this remains so, you must switch to the domain's primary library server in order to update settings.").'

'. &mt("Thereafter, (with a Domain Coordinator role selected in the domain) you will be able to update settings when logged in to any server in the LON-CAPA network.").'
'. &mt("However, you will still need to switch to the domain's primary library server to upload new images or logos.").'

'); if ($switch_server) { $r->print($switch_server.' '.&mt('to primary library server for domain: [_1]',$dom)); } return OK; } } } $r->print('

'.&mt('Functionality to display/modify').'

'); $r->print(''."\n".'

  '. '

'); my ($numitems,$midpoint,$seconddiv,$count); $numitems = @prefs_order; $midpoint = int($numitems/2); if ($numitems%2) { $midpoint ++; } $count = 0; foreach my $item (@prefs_order) { $r->print('

'); $count ++; if ((!$seconddiv) && ($count >= $midpoint)) { $r->print('
'."\n".'
'."\n"); $seconddiv = 1; } } $r->print('

'. &mt('Display options').'

'."\n". '

'.&mt('Display using: ')."\n". '  '. ''. &mt('two columns').'

'); $r->print(&print_footer($r,$phase,'display','Go')); $r->print(''); $r->print(&Apache::loncommon::end_page()); } return OK; } sub process_changes { my ($r,$dom,$confname,$action,$roles,%domconfig) = @_; my $output; if ($action eq 'login') { $output = &modify_login($r,$dom,$confname,%domconfig); } elsif ($action eq 'rolecolors') { $output = &modify_rolecolors($r,$dom,$confname,$roles, %domconfig); } elsif ($action eq 'quotas') { $output = &modify_quotas($dom,%domconfig); } elsif ($action eq 'autoenroll') { $output = &modify_autoenroll($dom,%domconfig); } elsif ($action eq 'autoupdate') { $output = &modify_autoupdate($dom,%domconfig); } elsif ($action eq 'directorysrch') { $output = &modify_directorysrch($dom,%domconfig); } elsif ($action eq 'usercreation') { $output = &modify_usercreation($dom,%domconfig); } elsif ($action eq 'usermodification') { $output = &modify_usermodification($dom,%domconfig); } elsif ($action eq 'contacts') { $output = &modify_contacts($dom,%domconfig); } return $output; } sub print_config_box { my ($r,$dom,$confname,$phase,$action,$item,$settings) = @_; my $rowtotal = 0; my $output = ''; # # FIXME - put the help link back in when the help files exist # # '); $rowtotal ++; if (($action eq 'autoupdate') || ($action eq 'rolecolors') || ($action eq 'usercreation') || ($action eq 'usermodification')) { my $colspan = ($action eq 'rolecolors')?' colspan="2"':''; $output .= ' '. ''; $itemcount ++; $css_class = $itemcount%2?' class="LC_odd_row"':''; $datatable .= ''. ''. ''; $itemcount ++; $datatable .= &display_color_options($dom,$confname,$phase,'login',$itemcount,\%choices,\%is_custom,\%defaults,\%designs,\@images,\@bgs,\@links,\%alt_text,$rowtotal); $datatable .= '
'.&mt($item->{text}). ' 
'.&mt($item->{text}).' '. # &Apache::loncommon::help_open_topic($item->{'help'}).'
'; $rowtotal ++; if ($action eq 'autoupdate') { $output .= &print_autoupdate('top',$dom,$settings,\$rowtotal); } elsif ($action eq 'usercreation') { $output .= &print_usercreation('top',$dom,$settings,\$rowtotal); } elsif ($action eq 'usermodification') { $output .= &print_usermodification('top',$dom,$settings,\$rowtotal); } else { $output .= &print_rolecolors($phase,'student',$dom,$confname,$settings,\$rowtotal); } $output .= '
'.$item->{'header'}->[0]->{'col1'}.' '.$item->{'header'}->[0]->{'col2'}.'
'; $rowtotal ++; if ($action eq 'autoupdate') { $output .= &print_autoupdate('bottom',$dom,$settings,\$rowtotal); } elsif ($action eq 'usercreation') { $output .= &print_usercreation('middle',$dom,$settings,\$rowtotal).'
'.$item->{'header'}->[1]->{'col1'}.' '.$item->{'header'}->[1]->{'col2'}.'
'. &print_usercreation('bottom',$dom,$settings,\$rowtotal); $rowtotal ++; } elsif ($action eq 'usermodification') { $output .= &print_usermodification('bottom',$dom,$settings,\$rowtotal); } else { $output .= &print_rolecolors($phase,'coordinator',$dom,$confname,$settings,\$rowtotal).'
'.$item->{'header'}->[2]->{'col1'}.' '.$item->{'header'}->[2]->{'col2'}.'
'. &print_rolecolors($phase,'author',$dom,$confname,$settings,\$rowtotal).'
'.$item->{'header'}->[2]->{'col1'}.' '.$item->{'header'}->[2]->{'col2'}.'
'. &print_rolecolors($phase,'admin',$dom,$confname,$settings,\$rowtotal); $rowtotal += 2; } } else { $output .= '
'.$item->{'header'}->[3]->{'col1'}.' '.$item->{'header'}->[3]->{'col2'}.'
'; if (($action eq 'login') || ($action eq 'directorysrch')) { $output .= ' '; } else { $output .= ' '; } $output .= ' '; $rowtotal ++; if ($action eq 'login') { $output .= &print_login($dom,$confname,$phase,$settings,\$rowtotal); } elsif ($action eq 'quotas') { $output .= &print_quotas($dom,$settings,\$rowtotal); } elsif ($action eq 'autoenroll') { $output .= &print_autoenroll($dom,$settings,\$rowtotal); } elsif ($action eq 'directorysrch') { $output .= &print_directorysrch($dom,$settings,\$rowtotal); } elsif ($action eq 'contacts') { $output .= &print_contacts($dom,$settings,\$rowtotal); } } $output .= '
'.$item->{'header'}->[0]->{'col1'}.''.$item->{'header'}->[0]->{'col1'}.''.$item->{'header'}->[0]->{'col2'}.'

'; return ($output,$rowtotal); } sub print_header { my ($r,$phase) = @_; my $alert = &mt('You must select at least one functionality type to display.'); my $js = ' '; my $additem; if ($phase eq 'pickactions') { my %loaditems = ( 'onload' => "javascript:getViewportDims(document.$phase.width,document.$phase.height);setDisplayColumns();setFormElements(document.pickactions);", ); $additem = {'add_entries' => \%loaditems,}; } else { my %loaditems = ( 'onload' => "javascript:getViewportDims(document.$phase.width,document.$phase.height);", ); $additem = {'add_entries' => \%loaditems,}; } $r->print(&Apache::loncommon::start_page('View/Modify Domain Settings', $js,$additem)); $r->print(&Apache::lonhtmlcommon::breadcrumbs('Domain Settings')); $r->print('
'); $r->print('
'); return; } sub print_footer { my ($r,$phase,$newphase,$button_text,$actions) = @_; $button_text = &mt($button_text); $r->print(''. ''. ''); if (($phase eq 'display') || ($phase eq 'process')) { if (ref($actions) eq 'ARRAY') { foreach my $item (@{$actions}) { $r->print('')."\n"; } } $r->print(''); } my $dest='"javascript:changePage(document.'.$phase.','."'$newphase'".')"'; if ($phase eq 'process') { $r->print('

'.$button_text.'

'); } else { my $onclick; if ($phase eq 'display') { $onclick = '"javascript:changePage(document.'.$phase.','."'$newphase'".')"'; } else { $onclick = '"javascript:changePage(document.'.$phase.','."'$newphase'".')"'; } $r->print('

'); } if ($phase eq 'process') { $r->print('
'.&Apache::loncommon::end_page()); } return; } sub print_login { my ($dom,$confname,$phase,$settings,$rowtotal) = @_; my %choices = &login_choices(); my ($catalogon,$catalogoff,$adminmailon,$adminmailoff); $catalogon = ' checked="checked" '; $adminmailoff = ' checked="checked" '; my @images = ('img','logo','domlogo'); my @bgs = ('pgbg','mainbg','sidebg'); my @links = ('link','alink','vlink'); my %designhash = &Apache::loncommon::get_domainconf($dom); my %defaultdesign = %Apache::loncommon::defaultdesign; my (%is_custom,%designs); my %defaults = ( font => $defaultdesign{'login.font'}, ); foreach my $item (@images) { $defaults{$item} = $defaultdesign{'login.'.$item}; } foreach my $item (@bgs) { $defaults{'bgs'}{$item} = $defaultdesign{'login.'.$item}; } foreach my $item (@links) { $defaults{'links'}{$item} = $defaultdesign{'login.'.$item}; } if (ref($settings) eq 'HASH') { if ($settings->{'coursecatalog'} eq '0') { $catalogoff = $catalogon; $catalogon = ' '; } if ($settings->{'adminmail'} eq '1') { $adminmailon = $adminmailoff; $adminmailoff = ' '; } foreach my $item (@images) { if ($settings->{$item} ne '') { $designs{$item} = $settings->{$item}; $is_custom{$item} = 1; } } if ($settings->{'font'} ne '') { $designs{'font'} = $settings->{'font'}; $is_custom{'font'} = 1; } foreach my $item (@bgs) { if ($settings->{$item} ne '') { $designs{'bgs'}{$item} = $settings->{$item}; $is_custom{$item} = 1; } } foreach my $item (@links) { if ($settings->{$item} ne '') { $designs{'links'}{$item} = $settings->{$item}; $is_custom{$item} = 1; } } } else { if ($designhash{$dom.'.login.font'} ne '') { $designs{'font'} = $designhash{$dom.'.login.font'}; $is_custom{'font'} = 1; } foreach my $item (@images) { if ($designhash{$dom.'.login.'.$item} ne '') { $designs{$item} = $designhash{$dom.'.login.'.$item}; $is_custom{$item} = 1; } } foreach my $item (@bgs) { if ($designhash{$dom.'.login.'.$item} ne '') { $designs{'bgs'}{$item} = $designhash{$dom.'.login.'.$item}; $is_custom{$item} = 1; } } foreach my $item (@links) { if ($designhash{$dom.'.login.'.$item} ne '') { $designs{'links'}{$item} = $designhash{$dom.'.login.'.$item}; $is_custom{$item} = 1; } } } my %alt_text = &Apache::lonlocal::texthash ( img => 'Log-in banner', logo => 'Institution Logo', domlogo => 'Domain Logo'); my $itemcount = 1; my $css_class = $itemcount%2?' class="LC_odd_row"':''; my $datatable = '
'.$choices{'coursecatalog'}. ''. ' '. '
'.$choices{'adminmail'}.''. ' '. '
'; return $datatable; } sub login_choices { my %choices = &Apache::lonlocal::texthash ( coursecatalog => 'Display Course Catalog link?', adminmail => "Display Administrator's E-mail Address?", img => "Header", logo => "Main Logo", domlogo => "Domain Logo", bgs => "Background colors", links => "Link colors", font => "Font color", pgbg => "Page", mainbg => "Main panel", sidebg => "Side panel", link => "Link", alink => "Active link", vlink => "Visited link", ); return %choices; } sub print_rolecolors { my ($phase,$role,$dom,$confname,$settings,$rowtotal) = @_; my %choices = &color_font_choices(); my @bgs = ('pgbg','tabbg','sidebg'); my @links = ('link','alink','vlink'); my @images = ('img'); my %alt_text = &Apache::lonlocal::texthash(img => "Banner for $role role"); my %designhash = &Apache::loncommon::get_domainconf($dom); my %defaultdesign = %Apache::loncommon::defaultdesign; my (%is_custom,%designs); my %defaults = ( img => $defaultdesign{$role.'.img'}, font => $defaultdesign{$role.'.font'}, ); foreach my $item (@bgs) { $defaults{'bgs'}{$item} = $defaultdesign{$role.'.'.$item}; } foreach my $item (@links) { $defaults{'links'}{$item} = $defaultdesign{$role.'.'.$item}; } if (ref($settings) eq 'HASH') { if (ref($settings->{$role}) eq 'HASH') { if ($settings->{$role}->{'img'} ne '') { $designs{'img'} = $settings->{$role}->{'img'}; $is_custom{'img'} = 1; } if ($settings->{$role}->{'font'} ne '') { $designs{'font'} = $settings->{$role}->{'font'}; $is_custom{'font'} = 1; } foreach my $item (@bgs) { if ($settings->{$role}->{$item} ne '') { $designs{'bgs'}{$item} = $settings->{$role}->{$item}; $is_custom{$item} = 1; } } foreach my $item (@links) { if ($settings->{$role}->{$item} ne '') { $designs{'links'}{$item} = $settings->{$role}->{$item}; $is_custom{$item} = 1; } } } } else { if ($designhash{$dom.'.'.$role.'.img'} ne '') { $designs{img} = $designhash{$dom.'.'.$role.'.img'}; $is_custom{'img'} = 1; } if ($designhash{$dom.'.'.$role.'.font'} ne '') { $designs{font} = $designhash{$dom.'.'.$role.'.font'}; $is_custom{'font'} = 1; } foreach my $item (@bgs) { if ($designhash{$dom.'.'.$role.'.'.$item} ne '') { $designs{'bgs'}{$item} = $designhash{$dom.'.'.$role.'.'.$item}; $is_custom{$item} = 1; } } foreach my $item (@links) { if ($designhash{$dom.'.'.$role.'.'.$item} ne '') { $designs{'links'}{$item} = $designhash{$dom.'.'.$role.'.'.$item}; $is_custom{$item} = 1; } } } my $itemcount = 1; my $datatable = &display_color_options($dom,$confname,$phase,$role,$itemcount,\%choices,\%is_custom,\%defaults,\%designs,\@images,\@bgs,\@links,\%alt_text,$rowtotal); $datatable .= ''; return $datatable; } sub display_color_options { my ($dom,$confname,$phase,$role,$itemcount,$choices,$is_custom,$defaults,$designs, $images,$bgs,$links,$alt_text,$rowtotal) = @_; my $css_class = $itemcount%2?' class="LC_odd_row"':''; my $datatable = ''. ''.$choices->{'font'}.''; if (!$is_custom->{'font'}) { $datatable .= ''.&mt('Default in use:').' '.$defaults->{'font'}.''; } else { $datatable .= ' '; } my $fontlink = &color_pick($phase,$role,'font',$choices->{'font'},$designs->{'font'}); $datatable .= ''. ' '.$fontlink. '    '. ''; my $switchserver = &check_switchserver($dom,$confname); foreach my $img (@{$images}) { $itemcount ++; $css_class = $itemcount%2?' class="LC_odd_row"':''; $datatable .= ''. ''.$choices->{$img}.''; my ($imgfile, $img_import); if ($designs->{$img} ne '') { $imgfile = $designs->{$img}; $img_import = ($imgfile =~ m{^/adm/}); } else { $imgfile = $defaults->{$img}; } if ($imgfile) { my ($showfile,$fullsize); if ($imgfile =~ m-^(/res/\Q$dom\E/\Q$confname\E/\Q$img\E)/([^/]+)$-) { my $urldir = $1; my $filename = $2; my @info = &Apache::lonnet::stat_file($designs->{$img}); if (@info) { my $thumbfile = 'tn-'.$filename; my @thumb=&Apache::lonnet::stat_file($urldir.'/'.$thumbfile); if (@thumb) { $showfile = $urldir.'/'.$thumbfile; } else { $showfile = $imgfile; } } else { $showfile = ''; } } elsif ($imgfile =~ m-^/(adm/[^/]+)/([^/]+)$-) { $showfile = $imgfile; my $imgdir = $1; my $filename = $2; if (-e "/home/httpd/html/$imgdir/tn-".$filename) { $showfile = "/$imgdir/tn-".$filename; } else { my $input = "/home/httpd/html".$imgfile; my $output = '/home/httpd/html/'.$imgdir.'/tn-'.$filename; if (!-e $output) { my ($width,$height) = &thumb_dimensions(); my ($fullwidth,$fullheight) = &check_dimensions($input); if ($fullwidth ne '' && $fullheight ne '') { if ($fullwidth > $width && $fullheight > $height) { my $size = $width.'x'.$height; system("convert -sample $size $input $output"); $showfile = '/'.$imgdir.'/tn-'.$filename; } } } } } if ($showfile) { $showfile = &Apache::loncommon::lonhttpdurl($showfile); $fullsize = &Apache::loncommon::lonhttpdurl($imgfile); $datatable.= ''; if (!$is_custom->{$img}) { $datatable .= &mt('Default in use:').'
'; } if ($img_import) { $datatable.= ''; } $datatable.= ''.$alt_text->{$img}.
                             ''; if ($is_custom->{$img}) { $datatable.=' '.&mt('Replace:').'
'; } else { $datatable.=''.&mt('Upload:').'
'; } } else { $datatable .= '
'. &mt('Upload:'); } } else { $datatable .= '
'. &mt('Upload:'); } if ($switchserver) { $datatable .= &mt('Upload to library server: [_1]',$switchserver); } else { $datatable .=' '; } $datatable .= ''; } $itemcount ++; $css_class = $itemcount%2?' class="LC_odd_row"':''; $datatable .= ''. ''.$choices->{'bgs'}.''; my $bgs_def; foreach my $item (@{$bgs}) { if (!$is_custom->{$item}) { $bgs_def .= ''.$choices->{$item}.'    
'.$defaults->{'bgs'}{$item}.''; } } if ($bgs_def) { $datatable .= ''.&mt('Default(s) in use:').'
'.$bgs_def.'
'; } else { $datatable .= ' '; } $datatable .= ''. ''; foreach my $item (@{$bgs}) { my $link = &color_pick($phase,$role,$item,$choices->{$item},$designs->{'bgs'}{$item}); $datatable .= ''; } $datatable .= '
'.$link; if ($designs->{'bgs'}{$item}) { $datatable .= '    '; } $datatable .= '
'; $itemcount ++; $css_class = $itemcount%2?' class="LC_odd_row"':''; $datatable .= ''. ''.$choices->{'links'}.''; my $links_def; foreach my $item (@{$links}) { if (!$is_custom->{$item}) { $links_def .= ''.$choices->{$item}.'
'.$defaults->{'links'}{$item}.''; } } if ($links_def) { $datatable .= ''.&mt('Default(s) in use:').'
'.$links_def.'
'; } else { $datatable .= ' '; } $datatable .= ''. ''; foreach my $item (@{$links}) { $datatable .= ''; } $$rowtotal += $itemcount; return $datatable; } sub color_pick { my ($phase,$role,$item,$desc,$curcol) = @_; my $link = ''.$desc.''; return $link; } sub color_pick_js { my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition(); my $output = <<"ENDCOL"; function pclose() { parmwin=window.open("/adm/rat/empty.html","LONCAPAparms","height=350,width=350,scrollbars=no,menubar=no"); parmwin.close(); } $pjump_def function psub() { pclose(); if (document.parmform.pres_marker.value!='') { if (document.parmform.pres_type.value!='') { eval('document.display.'+ document.parmform.pres_marker.value+ '.value=document.parmform.pres_value.value;'); } } else { document.parmform.pres_value.value=''; document.parmform.pres_marker.value=''; } } ENDCOL return $output; } sub print_quotas { my ($dom,$settings,$rowtotal) = @_; my $datatable; my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom); my $typecount = 0; my $css_class; if (ref($types) eq 'ARRAY') { foreach my $type (@{$types}) { if (defined($usertypes->{$type})) { $typecount ++; $css_class = $typecount%2?' class="LC_odd_row"':''; $datatable .= ''. ''. ''; } } } my $defaultquota = '20'; if (ref($settings) eq 'HASH') { if (defined($settings->{'default'})) { $defaultquota = $settings->{'default'}; } } $typecount ++; $css_class = $typecount%2?' class="LC_odd_row"':''; $datatable .= ''. ''. ''; $$rowtotal += $typecount; return $datatable; } sub print_autoenroll { my ($dom,$settings,$rowtotal) = @_; my $autorun = &Apache::lonnet::auto_run(undef,$dom), my ($defdom,$runon,$runoff); if (ref($settings) eq 'HASH') { if (exists($settings->{'run'})) { if ($settings->{'run'} eq '0') { $runoff = ' checked="checked" '; $runon = ' '; } else { $runon = ' checked="checked" '; $runoff = ' '; } } else { if ($autorun) { $runon = ' checked="checked" '; $runoff = ' '; } else { $runoff = ' checked="checked" '; $runon = ' '; } } if (exists($settings->{'sender_domain'})) { $defdom = $settings->{'sender_domain'}; } } else { if ($autorun) { $runon = ' checked="checked" '; $runoff = ' '; } else { $runoff = ' checked="checked" '; $runon = ' '; } } my $domform = &Apache::loncommon::select_dom_form($defdom,'sender_domain',1); my $notif_sender; if (ref($settings) eq 'HASH') { $notif_sender = $settings->{'sender_uname'}; } my $datatable=''. ''. ''. ''. ''; $$rowtotal += 2; return $datatable; } sub print_autoupdate { my ($position,$dom,$settings,$rowtotal) = @_; my $datatable; if ($position eq 'top') { my $updateon = ' '; my $updateoff = ' checked="checked" '; my $classlistson = ' '; my $classlistsoff = ' checked="checked" '; if (ref($settings) eq 'HASH') { if ($settings->{'run'} eq '1') { $updateon = $updateoff; $updateoff = ' '; } if ($settings->{'classlists'} eq '1') { $classlistson = $classlistsoff; $classlistsoff = ' '; } } my %title = ( run => 'Auto-update active?', classlists => 'Update information in classlists?', ); $datatable = ''. ''. ''. ''. ''. ''. ''; $$rowtotal += 2; } else { my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom); my @fields = ('lastname','firstname','middlename','gen', 'permanentemail','id'); my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles(); my $numrows = 0; if (ref($types) eq 'ARRAY') { if (@{$types} > 0) { $datatable = &usertype_update_row($settings,$usertypes,\%fieldtitles, \@fields,$types,\$numrows); $$rowtotal += @{$types}; } } $datatable .= &usertype_update_row($settings,{'default' => $othertitle}, \%fieldtitles,\@fields,['default'], \$numrows); $$rowtotal ++; } return $datatable; } sub print_directorysrch { my ($dom,$settings,$rowtotal) = @_; my $srchon = ' '; my $srchoff = ' checked="checked" '; my ($exacton,$containson,$beginson); my $localon = ' '; my $localoff = ' checked="checked" '; if (ref($settings) eq 'HASH') { if ($settings->{'available'} eq '1') { $srchon = $srchoff; $srchoff = ' '; } if ($settings->{'localonly'} eq '1') { $localon = $localoff; $localoff = ' '; } if (ref($settings->{'searchtypes'}) eq 'ARRAY') { foreach my $type (@{$settings->{'searchtypes'}}) { if ($type eq 'exact') { $exacton = ' checked="checked" '; } elsif ($type eq 'contains') { $containson = ' checked="checked" '; } elsif ($type eq 'begins') { $beginson = ' checked="checked" '; } } } else { if ($settings->{'searchtypes'} eq 'exact') { $exacton = ' checked="checked" '; } elsif ($settings->{'searchtypes'} eq 'contains') { $containson = ' checked="checked" '; } elsif ($settings->{'searchtypes'} eq 'specify') { $exacton = ' checked="checked" '; $containson = ' checked="checked" '; } } } my ($searchtitles,$titleorder) = &sorted_searchtitles(); my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom); my $numinrow = 4; my $cansrchrow = 0; my $datatable=''. ''. ''. ''. ''. ''. ''; $$rowtotal += 2; if (ref($usertypes) eq 'HASH') { if (keys(%{$usertypes}) > 0) { $datatable .= &users_cansearch_row($settings,$types,$usertypes,$dom, $numinrow,$othertitle); $cansrchrow = 1; } } if ($cansrchrow) { $$rowtotal ++; $datatable .= ''; } else { $datatable .= ''; } $datatable .= ''; $$rowtotal ++; if ($cansrchrow) { $datatable .= ''; } else { $datatable .= ''; } $datatable .= ''. ''; $$rowtotal ++; return $datatable; } sub print_contacts { my ($dom,$settings,$rowtotal) = @_; my $datatable; my @contacts = ('adminemail','supportemail'); my (%checked,%to,%otheremails); my @mailings = ('errormail','packagesmail','helpdeskmail'); foreach my $type (@mailings) { $otheremails{$type} = ''; } if (ref($settings) eq 'HASH') { foreach my $item (@contacts) { if (exists($settings->{$item})) { $to{$item} = $settings->{$item}; } } foreach my $type (@mailings) { if (exists($settings->{$type})) { if (ref($settings->{$type}) eq 'HASH') { foreach my $item (@contacts) { if ($settings->{$type}{$item}) { $checked{$type}{$item} = ' checked="checked" '; } } $otheremails{$type} = $settings->{$type}{'others'}; } } } } else { $to{'supportemail'} = $Apache::lonnet::perlvar{'lonSupportEMail'}; $to{'adminemail'} = $Apache::lonnet::perlvar{'lonAdmEMail'}; $checked{'errormail'}{'adminemail'} = ' checked="checked" '; $checked{'packagesmail'}{'adminemail'} = ' checked="checked" '; $checked{'helpdeskmail'}{'supportemail'} = ' checked="checked" '; } my ($titles,$short_titles) = &contact_titles(); my $rownum = 0; my $css_class; foreach my $item (@contacts) { if ($rownum%2) { $css_class = ''; } else { $css_class = ' class="LC_odd_row" '; } $datatable .= ''. ''; $rownum ++; } foreach my $type (@mailings) { if ($rownum%2) { $css_class = ''; } else { $css_class = ' class="LC_odd_row" '; } $datatable .= ''. ''. ''."\n"; $rownum ++; } $$rowtotal += $rownum; return $datatable; } sub contact_titles { my %titles = &Apache::lonlocal::texthash ( 'supportemail' => 'Support E-mail address', 'adminemail' => 'Default Server Admin E-mail address', 'errormail' => 'Error reports to be e-mailed to', 'packagesmail' => 'Package update alerts to be e-mailed to', 'helpdeskmail' => 'Helpdesk requests to be e-mailed to' ); my %short_titles = &Apache::lonlocal::texthash ( adminemail => 'Admin E-mail address', supportemail => 'Support E-mail', ); return (\%titles,\%short_titles); } sub print_usercreation { my ($position,$dom,$settings,$rowtotal) = @_; my $numinrow = 4; my $datatable; if ($position eq 'top') { $$rowtotal ++; my $rowcount = 0; my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($dom,'username'); if (ref($rules) eq 'HASH') { if (keys(%{$rules}) > 0) { $datatable .= &user_formats_row('username',$settings,$rules, $ruleorder,$numinrow,$rowcount); $$rowtotal ++; $rowcount ++; } } my ($idrules,$idruleorder) = &Apache::lonnet::inst_userrules($dom,'id'); if (ref($idrules) eq 'HASH') { if (keys(%{$idrules}) > 0) { $datatable .= &user_formats_row('id',$settings,$idrules, $idruleorder,$numinrow,$rowcount); $$rowtotal ++; $rowcount ++; } } if ($rowcount == 0) { $datatable .= ''; $$rowtotal ++; $rowcount ++; } } elsif ($position eq 'middle') { my @creators = ('author','course'); my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($dom,'username'); my %lt = &usercreation_types(); my %checked; if (ref($settings) eq 'HASH') { if (ref($settings->{'cancreate'}) eq 'HASH') { foreach my $item (@creators) { $checked{$item} = $settings->{'cancreate'}{$item}; } } elsif (ref($settings->{'cancreate'}) eq 'ARRAY') { foreach my $item (@creators) { if (grep(/^\Q$item\E$/,@{$settings->{'cancreate'}})) { $checked{$item} = 'none'; } } } } my $rownum = 0; foreach my $item (@creators) { $rownum ++; if ($checked{$item} eq '') { $checked{$item} = 'any'; } my $css_class; if ($rownum%2) { $css_class = ''; } else { $css_class = ' class="LC_odd_row" '; } $datatable .= ''. ''; } } else { my @contexts = ('author','course','domain'); my @authtypes = ('int','krb4','krb5','loc'); my %checked; if (ref($settings) eq 'HASH') { if (ref($settings->{'authtypes'}) eq 'HASH') { foreach my $item (@contexts) { if (ref($settings->{'authtypes'}{$item}) eq 'HASH') { foreach my $auth (@authtypes) { if ($settings->{'authtypes'}{$item}{$auth}) { $checked{$item}{$auth} = ' checked="checked" '; } } } } } } else { foreach my $item (@contexts) { foreach my $auth (@authtypes) { $checked{$item}{$auth} = ' checked="checked" '; } } } my %title = &context_names(); my %authname = &authtype_names(); my $rownum = 0; my $css_class; foreach my $item (@contexts) { if ($rownum%2) { $css_class = ''; } else { $css_class = ' class="LC_odd_row" '; } $datatable .= ''. ''; $rownum ++; } $$rowtotal += $rownum; } return $datatable; } sub user_formats_row { my ($type,$settings,$rules,$ruleorder,$numinrow,$rowcount) = @_; my $output; my %text = ( 'username' => 'new usernames', 'id' => 'IDs', ); my $css_class = $rowcount%2?' class="LC_odd_row"':''; $output = ''. ''. ''; return $output; } sub usercreation_types { my %lt = &Apache::lonlocal::texthash ( author => 'When adding a co-author', course => 'When adding a user to a course', any => 'Any', official => 'Institutional only ', unofficial => 'Non-institutional only', none => 'None', ); return %lt; } sub authtype_names { my %lt = &Apache::lonlocal::texthash( int => 'Internal', krb4 => 'Kerberos 4', krb5 => 'Kerberos 5', loc => 'Local', ); return %lt; } sub context_names { my %context_title = &Apache::lonlocal::texthash( author => 'Creating users when an Author', course => 'Creating users when in a course', domain => 'Creating users when a Domain Coordinator', ); return %context_title; } sub print_usermodification { my ($position,$dom,$settings,$rowtotal) = @_; my $numinrow = 4; my ($context,$datatable,$rowcount); if ($position eq 'top') { $rowcount = 0; $context = 'author'; foreach my $role ('ca','aa') { $datatable .= &modifiable_userdata_row($context,$role,$settings, $numinrow,$rowcount); $$rowtotal ++; $rowcount ++; } } else { $context = 'course'; $rowcount = 0; foreach my $role ('st','ep','ta','in','cr') { $datatable .= &modifiable_userdata_row($context,$role,$settings, $numinrow,$rowcount); $$rowtotal ++; $rowcount ++; } } return $datatable; } sub modifiable_userdata_row { my ($context,$role,$settings,$numinrow,$rowcount) = @_; my $rolename; if ($role eq 'cr') { $rolename = &mt('Custom role'); } else { $rolename = &Apache::lonnet::plaintext($role); } my @fields = ('lastname','firstname','middlename','generation', 'permanentemail','id'); my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles(); my $output; my $css_class = $rowcount%2?' class="LC_odd_row"':''; $output = ''. ''. ''; return $output; } sub users_cansearch_row { my ($settings,$types,$usertypes,$dom,$numinrow,$othertitle) = @_; my $output = ''. ''; return $output; } sub sorted_inst_types { my ($dom) = @_; my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); my $othertitle = &mt('All users'); my @types; if (ref($order) eq 'ARRAY') { @types = @{$order}; } if (@types == 0) { if (ref($usertypes) eq 'HASH') { @types = sort(keys(%{$usertypes})); } } if (keys(%{$usertypes}) > 0) { $othertitle = &mt('Other users'); } return ($othertitle,$usertypes,\@types); } sub sorted_searchtitles { my %searchtitles = &Apache::lonlocal::texthash( 'uname' => 'username', 'lastname' => 'last name', 'lastfirst' => 'last name, first name', ); my @titleorder = ('uname','lastname','lastfirst'); return (\%searchtitles,\@titleorder); } sub sorted_searchtypes { my %srchtypes_desc = ( exact => 'is exact match', contains => 'contains ..', begins => 'begins with ..', ); my @srchtypeorder = ('exact','begins','contains'); return (\%srchtypes_desc,\@srchtypeorder); } sub usertype_update_row { my ($settings,$usertypes,$fieldtitles,$fields,$types,$rownums) = @_; my $datatable; my $numinrow = 4; foreach my $type (@{$types}) { if (defined($usertypes->{$type})) { $$rownums ++; my $css_class = $$rownums%2?' class="LC_odd_row"':''; $datatable .= ''; } } return $datatable; } sub modify_login { my ($r,$dom,$confname,%domconfig) = @_; my ($resulttext,$errors,$colchgtext,%changes,%colchanges); my %title = ( coursecatalog => 'Display course catalog', adminmail => 'Display administrator E-mail address'); my @offon = ('off','on'); my %loginhash; ($errors,%colchanges) = &modify_colors($r,$dom,$confname,['login'], \%domconfig,\%loginhash); $loginhash{login}{coursecatalog} = $env{'form.coursecatalog'}; $loginhash{login}{adminmail} = $env{'form.adminmail'}; if (ref($colchanges{'login'}) eq 'HASH') { $colchgtext = &display_colorchgs($dom,\%colchanges,['login'], \%loginhash); } my $putresult = &Apache::lonnet::put_dom('configuration',\%loginhash, $dom); if ($putresult eq 'ok') { if (($domconfig{'login'}{'coursecatalog'} eq '0') && ($env{'form.coursecatalog'} eq '1')) { $changes{'coursecatalog'} = 1; } elsif (($domconfig{'login'}{'coursecatalog'} eq '' || $domconfig{'login'}{'coursecatalog'} eq '1') && ($env{'form.coursecatalog'} eq '0')) { $changes{'coursecatalog'} = 1; } if (($domconfig{'login'}{'adminmail'} eq '1') && ($env{'form.adminmail'} eq '0')) { $changes{'adminmail'} = 1; } elsif (($domconfig{'login'}{'adminmail'} eq '' || $domconfig{'login'}{'adminmail'} eq '0') && ($env{'form.adminmail'} eq '1')) { $changes{'adminmail'} = 1; } if (keys(%changes) > 0 || $colchgtext) { $resulttext = &mt('Changes made:').'
    '; foreach my $item (sort(keys(%changes))) { $resulttext .= '
  • '.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").'
  • '; } $resulttext .= $colchgtext.'
'; } else { $resulttext = &mt('No changes made to log-in page settings'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } if ($errors) { $resulttext .= '
'.&mt('The following errors occurred: ').'
    '. $errors.'
'; } return $resulttext; } sub color_font_choices { my %choices = &Apache::lonlocal::texthash ( img => "Header", bgs => "Background colors", links => "Link colors", font => "Font color", pgbg => "Page", tabbg => "Header", sidebg => "Border", link => "Link", alink => "Active link", vlink => "Visited link", ); return %choices; } sub modify_rolecolors { my ($r,$dom,$confname,$roles,%domconfig) = @_; my ($resulttext,%rolehash); $rolehash{'rolecolors'} = {}; my ($errors,%changes) = &modify_colors($r,$dom,$confname,$roles, $domconfig{'rolecolors'},$rolehash{'rolecolors'}); my $putresult = &Apache::lonnet::put_dom('configuration',\%rolehash, $dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { $resulttext = &display_colorchgs($dom,\%changes,$roles, $rolehash{'rolecolors'}); } else { $resulttext = &mt('No changes made to default color schemes'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } if ($errors) { $resulttext .= &mt('The following errors occurred: ').'
    '. $errors.'
'; } return $resulttext; } sub modify_colors { my ($r,$dom,$confname,$roles,$domconfig,$confhash) = @_; my (%changes,%choices); my @bgs = ('pgbg','mainbg','sidebg'); my @links = ('link','alink','vlink'); my @images; my $servadm = $r->dir_config('lonAdmEMail'); my $errors; foreach my $role (@{$roles}) { if ($role eq 'login') { %choices = &login_choices(); } else { %choices = &color_font_choices(); } if ($role eq 'login') { @images = ('img','logo','domlogo'); } else { @images = ('img'); } $confhash->{$role}{'font'} = $env{'form.'.$role.'_font'}; foreach my $item (@bgs,@links) { $confhash->{$role}{$item} = $env{'form.'.$role.'_'.$item}; } my ($configuserok,$author_ok,$switchserver,%currroles); my $uhome = &Apache::lonnet::homeserver($confname,$dom,1); ($configuserok,%currroles) = &check_configuser($uhome,$dom, $confname,$servadm); if ($configuserok eq 'ok') { $switchserver = &check_switchserver($dom,$confname); if ($switchserver eq '') { $author_ok = &check_authorstatus($dom,$confname,%currroles); } } my ($width,$height) = &thumb_dimensions(); foreach my $img (@images) { if ( ! $env{'form.'.$role.'_'.$img.'.filename'} && !defined($domconfig->{$role}{$img}) && !$env{'form.'.$role.'_del_'.$img} && $env{'form.'.$role.'_import_'.$img}) { # import the old configured image from the .tab setting # if they haven't provided a new one $domconfig->{$role}{$img} = $env{'form.'.$role.'_import_'.$img}; } if ($env{'form.'.$role.'_'.$img.'.filename'} ne '') { my $error; if ($configuserok eq 'ok') { if ($switchserver) { $error = &mt("Upload of [_1] image for $role page(s) is not permitted to this server: [_2]",$choices{$img},$switchserver); } else { if ($author_ok eq 'ok') { my ($result,$logourl) = &publishlogo($r,'upload',$role.'_'.$img, $dom,$confname,$img,$width,$height); if ($result eq 'ok') { $confhash->{$role}{$img} = $logourl; $changes{$role}{'images'}{$img} = 1; } else { $error = &mt("Upload of [_1] image for $role page(s) failed because an error occurred publishing the file in RES space. Error was: [_2].",$choices{img},$result); } } else { $error = &mt("Upload of [_1] image for $role page(s) failed because an author role could not be assigned to a Domain Configuation user ([_2]) in domain: [_3]. Error was: [_4].",$choices{$img},$confname,$dom,$author_ok); } } } else { $error = &mt("Upload of [_1] image for $role page(s) failed because a Domain Configuation user ([_2]) could not be created in domain: [_3]. Error was: [_4].",$choices{$img},$confname,$dom,$configuserok); } if ($error) { &Apache::lonnet::logthis($error); $errors .= '
  • '.$error.'
  • '; } } elsif ($domconfig->{$role}{$img} ne '') { if ($domconfig->{$role}{$img} !~ m-^(/res/\Q$dom\E/\Q$confname\E/\Q$img\E)/([^/]+)$-) { my $error; if ($configuserok eq 'ok') { # is confname an author? if ($switchserver eq '') { if ($author_ok eq 'ok') { my ($result,$logourl) = &publishlogo($r,'copy',$domconfig->{$role}{$img}, $dom,$confname,$img,$width,$height); if ($result eq 'ok') { $confhash->{$role}{$img} = $logourl; $changes{$role}{'images'}{$img} = 1; } } } } } } } if (ref($domconfig) eq 'HASH') { if (ref($domconfig->{$role}) eq 'HASH') { foreach my $img (@images) { if ($domconfig->{$role}{$img} ne '') { if ($env{'form.'.$role.'_del_'.$img}) { $confhash->{$role}{$img} = ''; $changes{$role}{'images'}{$img} = 1; } else { if ($confhash->{$role}{$img} eq '') { $confhash->{$role}{$img} = $domconfig->{$role}{$img}; } } } else { if ($env{'form.'.$role.'_del_'.$img}) { $confhash->{$role}{$img} = ''; $changes{$role}{'images'}{$img} = 1; } } } if ($domconfig->{$role}{'font'} ne '') { if ($confhash->{$role}{'font'} ne $domconfig->{$role}{'font'}) { $changes{$role}{'font'} = 1; } } else { if ($confhash->{$role}{'font'}) { $changes{$role}{'font'} = 1; } } foreach my $item (@bgs) { if ($domconfig->{$role}{$item} ne '') { if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) { $changes{$role}{'bgs'}{$item} = 1; } } else { if ($confhash->{$role}{$item}) { $changes{$role}{'bgs'}{$item} = 1; } } } foreach my $item (@links) { if ($domconfig->{$role}{$item} ne '') { if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) { $changes{$role}{'links'}{$item} = 1; } } else { if ($confhash->{$role}{$item}) { $changes{$role}{'links'}{$item} = 1; } } } } else { &default_change_checker($role,\@images,\@links,\@bgs, $confhash,\%changes); } } else { &default_change_checker($role,\@images,\@links,\@bgs, $confhash,\%changes); } } return ($errors,%changes); } sub default_change_checker { my ($role,$images,$links,$bgs,$confhash,$changes) = @_; foreach my $item (@{$links}) { if ($confhash->{$role}{$item}) { $changes->{$role}{'links'}{$item} = 1; } } foreach my $item (@{$bgs}) { if ($confhash->{$role}{$item}) { $changes->{$role}{'bgs'}{$item} = 1; } } foreach my $img (@{$images}) { if ($env{'form.'.$role.'_del_'.$img}) { $confhash->{$role}{$img} = ''; $changes->{$role}{'images'}{$img} = 1; } } if ($confhash->{$role}{'font'}) { $changes->{$role}{'font'} = 1; } } sub display_colorchgs { my ($dom,$changes,$roles,$confhash) = @_; my (%choices,$resulttext); &Apache::loncommon::devalidate_domconfig_cache($dom); if (!grep(/^login$/,@{$roles})) { $resulttext = &mt('Changes made:').'
    '; } foreach my $role (@{$roles}) { if ($role eq 'login') { %choices = &login_choices(); } else { %choices = &color_font_choices(); } if (ref($changes->{$role}) eq 'HASH') { if ($role ne 'login') { $resulttext .= '

    '.&mt($role).'

    '; } foreach my $key (sort(keys(%{$changes->{$role}}))) { if ($role ne 'login') { $resulttext .= '
      '; } if (ref($changes->{$role}{$key}) eq 'HASH') { if ($role ne 'login') { $resulttext .= '
    • '.&mt($choices{$key}).':
        '; } foreach my $item (sort(keys(%{$changes->{$role}{$key}}))) { if ($confhash->{$role}{$item} eq '') { $resulttext .= '
      • '.&mt("$choices{$item} set to default").'
      • '; } else { my $newitem = $confhash->{$role}{$item}; if ($key eq 'images') { $newitem = ''.$choices{$item}.''; } $resulttext .= '
      • '.&mt("$choices{$item} set to [_1]",$newitem).'
      • '; } } if ($role ne 'login') { $resulttext .= '
    • '; } } else { if ($confhash->{$role}{$key} eq '') { $resulttext .= '
    • '.&mt("$choices{$key} set to default").'
    • '; } else { $resulttext .= '
    • '.&mt("$choices{$key} set to [_1]",$confhash->{$role}{$key}).'
    • '; } } if ($role ne 'login') { $resulttext .= '
    '; } } } } return $resulttext; } sub thumb_dimensions { return ('200','50'); } sub check_dimensions { my ($inputfile) = @_; my ($fullwidth,$fullheight); if ($inputfile =~ m|^[/\w.\-]+$|) { if (open(PIPE,"identify $inputfile 2>&1 |")) { my $imageinfo = ; if (!close(PIPE)) { &Apache::lonnet::logthis("Failed to close PIPE opened to retrieve image information for $inputfile"); } chomp($imageinfo); my ($fullsize) = ($imageinfo =~ /^\Q$inputfile\E\s+\w+\s+(\d+x\d+)/); if ($fullsize) { ($fullwidth,$fullheight) = split(/x/,$fullsize); } } } return ($fullwidth,$fullheight); } sub check_configuser { my ($uhome,$dom,$confname,$servadm) = @_; my ($configuserok,%currroles); if ($uhome eq 'no_host') { srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand. my $configpass = &LONCAPA::Enrollment::create_password(); $configuserok = &Apache::lonnet::modifyuser($dom,$confname,'','internal', $configpass,'','','','','',undef,$servadm); } else { $configuserok = 'ok'; %currroles = &Apache::lonnet::get_my_roles($confname,$dom,'userroles'); } return ($configuserok,%currroles); } sub check_authorstatus { my ($dom,$confname,%currroles) = @_; my $author_ok; if (!$currroles{$confname.':'.$dom.':au'}) { my $start = time; my $end = 0; $author_ok = &Apache::lonnet::assignrole($dom,$confname,'/'.$dom.'/', 'au',$end,$start); } else { $author_ok = 'ok'; } return $author_ok; } sub publishlogo { my ($r,$action,$formname,$dom,$confname,$subdir,$thumbwidth,$thumbheight) = @_; my ($output,$fname,$logourl); if ($action eq 'upload') { $fname=$env{'form.'.$formname.'.filename'}; chop($env{'form.'.$formname}); } else { ($fname) = ($formname =~ /([^\/]+)$/); } $fname=&Apache::lonnet::clean_filename($fname); # See if there is anything left unless ($fname) { return ('error: no uploaded file'); } $fname="$subdir/$fname"; my $filepath='/home/'.$confname.'/public_html'; my ($fnamepath,$file,$fetchthumb); $file=$fname; if ($fname=~m|/|) { ($fnamepath,$file) = ($fname =~ m|^(.*)/([^/]+)$|); } my @parts=split(/\//,$filepath.'/'.$fnamepath); my $count; for ($count=4;$count<=$#parts;$count++) { $filepath.="/$parts[$count]"; if ((-e $filepath)!=1) { mkdir($filepath,02770); } } # Check for bad extension and disallow upload if ($file=~/\.(\w+)$/ && (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { $output = &mt('Invalid file extension ([_1]) - reserved for LONCAPA use.',$1); } elsif ($file=~/\.(\w+)$/ && !defined(&Apache::loncommon::fileembstyle($1))) { $output = &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1); } elsif ($file=~/\.(\d+)\.(\w+)$/) { $output = &mt('File name not allowed a rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2); } elsif (-d "$filepath/$file") { $output = &mt('File name is a directory name - rename the file and re-upload'); } else { my $source = $filepath.'/'.$file; my $logfile; if (!open($logfile,">>$source".'.log')) { return (&mt('No write permission to Construction Space')); } print $logfile "\n================= Publish ".localtime()." ================\n". $env{'user.name'}.':'.$env{'user.domain'}."\n"; # Save the file if (!open(FH,'>'.$source)) { &Apache::lonnet::logthis('Failed to create '.$source); return (&mt('Failed to create file')); } if ($action eq 'upload') { if (!print FH ($env{'form.'.$formname})) { &Apache::lonnet::logthis('Failed to write to '.$source); return (&mt('Failed to write file')); } } else { my $original = &Apache::lonnet::filelocation('',$formname); if(!copy($original,$source)) { &Apache::lonnet::logthis('Failed to copy '.$original.' to '.$source); return (&mt('Failed to write file')); } } 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; my @parts=split(/\//,$targetdir); my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; for (my $count=5;$count<=$#parts;$count++) { $path.="/$parts[$count]"; if (!-e $path) { print $logfile "\nCreating directory ".$path; mkdir($path,02770); } } my $versionresult; if (-e $copyfile) { $versionresult = &logo_versioning($targetdir,$file,$logfile); } else { $versionresult = 'ok'; } if ($versionresult eq 'ok') { 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; } else { print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; $output = &mt('Failed to copy file to RES space').", $!"; } if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) { my $inputfile = $filepath.'/'.$file; my $outfile = $filepath.'/'.'tn-'.$file; my ($fullwidth,$fullheight) = &check_dimensions($inputfile); if ($fullwidth ne '' && $fullheight ne '') { if ($fullwidth > $thumbwidth && $fullheight > $thumbheight) { my $thumbsize = $thumbwidth.'x'.$thumbheight; system("convert -sample $thumbsize $inputfile $outfile"); chmod(0660, $filepath.'/tn-'.$file); if (-e $outfile) { 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); } else { print $logfile "\nUnable to write ".$copyfile. ':'.$!."\n"; } } } } } } else { $output = $versionresult; } } return ($output,$logourl); } sub logo_versioning { my ($targetdir,$file,$logfile) = @_; my $target = $targetdir.'/'.$file; my ($maxversion,$fn,$extn,$output); $maxversion = 0; if ($file =~ /^(.+)\.(\w+)$/) { $fn=$1; $extn=$2; } opendir(DIR,$targetdir); while (my $filename=readdir(DIR)) { if ($filename=~/\Q$fn\E\.(\d+)\.\Q$extn\E$/) { $maxversion=($1>$maxversion)?$1:$maxversion; } } $maxversion++; print $logfile "\nCreating old version ".$maxversion."\n"; my $copyfile=$targetdir.'/'.$fn.'.'.$maxversion.'.'.$extn; if (copy($target,$copyfile)) { print $logfile "Copied old target to ".$copyfile."\n"; $copyfile=$copyfile.'.meta'; if (copy($target.'.meta',$copyfile)) { print $logfile "Copied old target metadata to ".$copyfile."\n"; $output = 'ok'; } else { print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; $output = &mt('Failed to copy old meta').", $!, "; } } else { print $logfile "Unable to write ".$copyfile.':'.$!."\n"; $output = &mt('Failed to copy old target').", $!, "; } return $output; } sub write_metadata { my ($dom,$confname,$formname,$targetdir,$file,$logfile) = @_; my (%metadatafields,%metadatakeys,$output); $metadatafields{'title'}=$formname; $metadatafields{'creationdate'}=time; $metadatafields{'lastrevisiondate'}=time; $metadatafields{'copyright'}='public'; $metadatafields{'modifyinguser'}=$env{'user.name'}.':'. $env{'user.domain'}; $metadatafields{'authorspace'}=$confname.':'.$dom; $metadatafields{'domain'}=$dom; { print $logfile "\nWrite metadata file for ".$targetdir.'/'.$file; my $mfh; 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); } } sub check_switchserver { my ($dom,$confname) = @_; my ($allowed,$switchserver); my $home = &Apache::lonnet::homeserver($confname,$dom); if ($home eq 'no_host') { $home = &Apache::lonnet::domain($dom,'primary'); } my @ids=&Apache::lonnet::current_machine_ids(); foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } } if (!$allowed) { $switchserver=''.&mt('Switch Server').''; } return $switchserver; } sub javascript_set_colnums { return < 1100) { document.pickactions.numcols[1].checked = true; } else { document.pickactions.numcols[0].checked = true; } } END } sub modify_quotas { my ($dom,%domconfig) = @_; my ($resulttext,%changes); my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom); my %formhash; foreach my $key (keys(%env)) { if ($key =~ /^form\.quota_(.+)$/) { $formhash{$1} = $env{$key}; } } $formhash{'default'} = $env{'form.defaultquota'}; if (ref($domconfig{'quotas'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'quotas'}})) { if (exists($formhash{$key})) { if ($formhash{$key} ne $domconfig{'quotas'}{$key}) { $changes{$key} = 1; } } else { $formhash{$key} = $domconfig{'quotas'}{$key}; } } } foreach my $key (keys(%formhash)) { if ($formhash{$key} ne '') { if (!exists($domconfig{'quotas'}{$key})) { $changes{$key} = 1; } } } my %quotahash = ( quotas => {%formhash}, ); my $putresult = &Apache::lonnet::put_dom('configuration',\%quotahash, $dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
      '; foreach my $type (@{$types},'default') { if (defined($changes{$type})) { my $typetitle = $usertypes->{$type}; if ($type eq 'default') { $typetitle = $othertitle; } $resulttext .= '
    • '.&mt('[_1] set to [_2] Mb',$typetitle,$formhash{$type}).'
    • '; } } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to default quotas'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } sub modify_autoenroll { my ($dom,%domconfig) = @_; my ($resulttext,%changes); my %currautoenroll; if (ref($domconfig{'autoenroll'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'autoenroll'}})) { $currautoenroll{$key} = $domconfig{'autoenroll'}{$key}; } } my $autorun = &Apache::lonnet::auto_run(undef,$dom), my %title = ( run => 'Auto-enrollment active', sender => 'Sender for notification messages'); my @offon = ('off','on'); my $sender_uname = $env{'form.sender_uname'}; my $sender_domain = $env{'form.sender_domain'}; if ($sender_domain eq '') { $sender_uname = ''; } elsif ($sender_uname eq '') { $sender_domain = ''; } my %autoenrollhash = ( autoenroll => { run => $env{'form.autoenroll_run'}, sender_uname => $sender_uname, sender_domain => $sender_domain, } ); my $putresult = &Apache::lonnet::put_dom('configuration',\%autoenrollhash, $dom); if ($putresult eq 'ok') { if (exists($currautoenroll{'run'})) { if ($currautoenroll{'run'} ne $env{'form.autoenroll_run'}) { $changes{'run'} = 1; } } elsif ($autorun) { if ($env{'form.autoenroll_run'} ne '1') { $changes{'run'} = 1; } } if ($currautoenroll{'sender_uname'} ne $sender_uname) { $changes{'sender'} = 1; } if ($currautoenroll{'sender_domain'} ne $sender_domain) { $changes{'sender'} = 1; } if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
      '; if ($changes{'run'}) { $resulttext .= '
    • '.&mt("$title{'run'} set to $offon[$env{'form.autoenroll_run'}]").'
    • '; } if ($changes{'sender'}) { if ($sender_uname eq '' || $sender_domain eq '') { $resulttext .= '
    • '.&mt("$title{'sender'} set to default (course owner).").'
    • '; } else { $resulttext .= '
    • '.&mt("$title{'sender'} set to [_1]",$sender_uname.':'.$sender_domain).'
    • '; } } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to auto-enrollment settings'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } sub modify_autoupdate { my ($dom,%domconfig) = @_; my ($resulttext,%currautoupdate,%fields,%changes); if (ref($domconfig{'autoupdate'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'autoupdate'}})) { $currautoupdate{$key} = $domconfig{'autoupdate'}{$key}; } } my @offon = ('off','on'); my %title = &Apache::lonlocal::texthash ( run => 'Auto-update:', classlists => 'Updates to user information in classlists?' ); my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom); my %fieldtitles = &Apache::lonlocal::texthash ( id => 'Student/Employee ID', permanentemail => 'E-mail address', lastname => 'Last Name', firstname => 'First Name', middlename => 'Middle Name', gen => 'Generation', ); my $othertitle = &mt('All users'); if (keys(%{$usertypes}) > 0) { $othertitle = &mt('Other users'); } foreach my $key (keys(%env)) { if ($key =~ /^form\.updateable_(.+)_([^_]+)$/) { push(@{$fields{$1}},$2); } } my %updatehash = ( autoupdate => { run => $env{'form.autoupdate_run'}, classlists => $env{'form.classlists'}, fields => {%fields}, } ); foreach my $key (keys(%currautoupdate)) { if (($key eq 'run') || ($key eq 'classlists')) { if (exists($updatehash{autoupdate}{$key})) { if ($currautoupdate{$key} ne $updatehash{autoupdate}{$key}) { $changes{$key} = 1; } } } elsif ($key eq 'fields') { if (ref($currautoupdate{$key}) eq 'HASH') { foreach my $item (@{$types},'default') { if (ref($currautoupdate{$key}{$item}) eq 'ARRAY') { my $change = 0; foreach my $type (@{$currautoupdate{$key}{$item}}) { if (!exists($fields{$item})) { $change = 1; } elsif (ref($fields{$item}) eq 'ARRAY') { if (!grep(/^\Q$type\E$/,@{$fields{$item}})) { $change = 1; } } } if ($change) { push(@{$changes{$key}},$item); } } } } } } foreach my $item (@{$types},'default') { if (defined($fields{$item})) { if (ref($currautoupdate{'fields'}) eq 'HASH') { if (!exists($currautoupdate{'fields'}{$item})) { push(@{$changes{'fields'}},$item); } } else { push(@{$changes{'fields'}},$item); } } } my $putresult = &Apache::lonnet::put_dom('configuration',\%updatehash, $dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
      '; foreach my $key (sort(keys(%changes))) { if (ref($changes{$key}) eq 'ARRAY') { foreach my $item (@{$changes{$key}}) { my @newvalues; foreach my $type (@{$fields{$item}}) { push(@newvalues,$fieldtitles{$type}); } my $newvaluestr; if (@newvalues > 0) { $newvaluestr = join(', ',@newvalues); } else { $newvaluestr = &mt('none'); } if ($item eq 'default') { $resulttext .= '
    • '.&mt("Updates for '[_1]' set to: '[_2]'",$othertitle,$newvaluestr).'
    • '; } else { $resulttext .= '
    • '.&mt("Updates for '[_1]' set to: '[_2]'",$usertypes->{$item},$newvaluestr).'
    • '; } } } else { my $newvalue; if ($key eq 'run') { $newvalue = $offon[$env{'form.autoupdate_run'}]; } else { $newvalue = $offon[$env{'form.'.$key}]; } $resulttext .= '
    • '.&mt("[_1] set to $newvalue",$title{$key}).'
    • '; } } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to autoupdates'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } sub modify_directorysrch { my ($dom,%domconfig) = @_; my ($resulttext,%changes); my %currdirsrch; if (ref($domconfig{'directorysrch'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'directorysrch'}})) { $currdirsrch{$key} = $domconfig{'directorysrch'}{$key}; } } my %title = ( available => 'Directory search available', localonly => 'Other domains can search', searchby => 'Search types', searchtypes => 'Search latitude'); my @offon = ('off','on'); my @otherdoms = ('Yes','No'); my @searchtypes = &Apache::loncommon::get_env_multiple('form.searchtypes'); my @cansearch = &Apache::loncommon::get_env_multiple('form.cansearch'); my @searchby = &Apache::loncommon::get_env_multiple('form.searchby'); my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom); if (keys(%{$usertypes}) == 0) { @cansearch = ('default'); } else { if (ref($currdirsrch{'cansearch'}) eq 'ARRAY') { foreach my $type (@{$currdirsrch{'cansearch'}}) { if (!grep(/^\Q$type\E$/,@cansearch)) { push(@{$changes{'cansearch'}},$type); } } foreach my $type (@cansearch) { if (!grep(/^\Q$type\E$/,@{$currdirsrch{'cansearch'}})) { push(@{$changes{'cansearch'}},$type); } } } else { push(@{$changes{'cansearch'}},@cansearch); } } if (ref($currdirsrch{'searchby'}) eq 'ARRAY') { foreach my $by (@{$currdirsrch{'searchby'}}) { if (!grep(/^\Q$by\E$/,@searchby)) { push(@{$changes{'searchby'}},$by); } } foreach my $by (@searchby) { if (!grep(/^\Q$by\E$/,@{$currdirsrch{'searchby'}})) { push(@{$changes{'searchby'}},$by); } } } else { push(@{$changes{'searchby'}},@searchby); } if (ref($currdirsrch{'searchtypes'}) eq 'ARRAY') { foreach my $type (@{$currdirsrch{'searchtypes'}}) { if (!grep(/^\Q$type\E$/,@searchtypes)) { push(@{$changes{'searchtypes'}},$type); } } foreach my $type (@searchtypes) { if (!grep(/^\Q$type\E$/,@{$currdirsrch{'searchtypes'}})) { push(@{$changes{'searchtypes'}},$type); } } } else { if (exists($currdirsrch{'searchtypes'})) { foreach my $type (@searchtypes) { if ($type ne $currdirsrch{'searchtypes'}) { push(@{$changes{'searchtypes'}},$type); } } if (!grep(/^\Q$currdirsrch{'searchtypes'}\E/,@searchtypes)) { push(@{$changes{'searchtypes'}},$currdirsrch{'searchtypes'}); } } else { push(@{$changes{'searchtypes'}},@searchtypes); } } my %dirsrch_hash = ( directorysrch => { available => $env{'form.dirsrch_available'}, cansearch => \@cansearch, localonly => $env{'form.dirsrch_localonly'}, searchby => \@searchby, searchtypes => \@searchtypes, } ); my $putresult = &Apache::lonnet::put_dom('configuration',\%dirsrch_hash, $dom); if ($putresult eq 'ok') { if (exists($currdirsrch{'available'})) { if ($currdirsrch{'available'} ne $env{'form.dirsrch_available'}) { $changes{'available'} = 1; } } else { if ($env{'form.dirsrch_available'} eq '1') { $changes{'available'} = 1; } } if (exists($currdirsrch{'localonly'})) { if ($currdirsrch{'localonly'} ne $env{'form.dirsrch_localonly'}) { $changes{'localonly'} = 1; } } else { if ($env{'form.dirsrch_localonly'} eq '1') { $changes{'localonly'} = 1; } } if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
      '; if ($changes{'available'}) { $resulttext .= '
    • '.&mt("$title{'available'} set to: $offon[$env{'form.dirsrch_available'}]").'
    • '; } if ($changes{'localonly'}) { $resulttext .= '
    • '.&mt("$title{'localonly'} set to: $otherdoms[$env{'form.dirsrch_localonly'}]").'
    • '; } if (ref($changes{'cansearch'}) eq 'ARRAY') { my $chgtext; if (ref($usertypes) eq 'HASH') { if (keys(%{$usertypes}) > 0) { foreach my $type (@{$types}) { if (grep(/^\Q$type\E$/,@cansearch)) { $chgtext .= $usertypes->{$type}.'; '; } } if (grep(/^default$/,@cansearch)) { $chgtext .= $othertitle; } else { $chgtext =~ s/\; $//; } $resulttext .= '
    • '.&mt("Users from domain '[_1]' permitted to search the institutional directory set to: [_2]",$dom,$chgtext).'
    • '; } } } if (ref($changes{'searchby'}) eq 'ARRAY') { my ($searchtitles,$titleorder) = &sorted_searchtitles(); my $chgtext; foreach my $type (@{$titleorder}) { if (grep(/^\Q$type\E$/,@searchby)) { if (defined($searchtitles->{$type})) { $chgtext .= $searchtitles->{$type}.'; '; } } } $chgtext =~ s/\; $//; $resulttext .= '
    • '.&mt("$title{'searchby'} set to: [_1]",$chgtext).'
    • '; } if (ref($changes{'searchtypes'}) eq 'ARRAY') { my ($srchtypes_desc,$srchtypeorder) = &sorted_searchtypes(); my $chgtext; foreach my $type (@{$srchtypeorder}) { if (grep(/^\Q$type\E$/,@searchtypes)) { if (defined($srchtypes_desc->{$type})) { $chgtext .= $srchtypes_desc->{$type}.'; '; } } } $chgtext =~ s/\; $//; $resulttext .= '
    • '.&mt("$title{'searchtypes'} set to: \"[_1]\"",$chgtext).'
    • '; } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to institution directory search settings'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } sub modify_contacts { my ($dom,%domconfig) = @_; my ($resulttext,%currsetting,%newsetting,%changes,%contacts_hash); if (ref($domconfig{'contacts'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'contacts'}})) { $currsetting{$key} = $domconfig{'contacts'}{$key}; } } my (%others,%to); my @contacts = ('supportemail','adminemail'); my @mailings = ('errormail','packagesmail','helpdeskmail'); foreach my $type (@mailings) { @{$newsetting{$type}} = &Apache::loncommon::get_env_multiple('form.'.$type); foreach my $item (@contacts) { if (grep(/^\Q$item\E$/,@{$newsetting{$type}})) { $contacts_hash{contacts}{$type}{$item} = 1; } else { $contacts_hash{contacts}{$type}{$item} = 0; } } $others{$type} = $env{'form.'.$type.'_others'}; $contacts_hash{contacts}{$type}{'others'} = $others{$type}; } foreach my $item (@contacts) { $to{$item} = $env{'form.'.$item}; $contacts_hash{'contacts'}{$item} = $to{$item}; } if (keys(%currsetting) > 0) { foreach my $item (@contacts) { if ($to{$item} ne $currsetting{$item}) { $changes{$item} = 1; } } foreach my $type (@mailings) { foreach my $item (@contacts) { if (ref($currsetting{$type}) eq 'HASH') { if ($currsetting{$type}{$item} ne $contacts_hash{contacts}{$type}{$item}) { push(@{$changes{$type}},$item); } } else { push(@{$changes{$type}},@{$newsetting{$type}}); } } if ($others{$type} ne $currsetting{$type}{'others'}) { push(@{$changes{$type}},'others'); } } } else { my %default; $default{'supportemail'} = $Apache::lonnet::perlvar{'lonSupportEMail'}; $default{'adminemail'} = $Apache::lonnet::perlvar{'lonAdmEMail'}; $default{'errormail'} = 'adminemail'; $default{'packagesmail'} = 'adminemail'; $default{'helpdeskmail'} = 'supportemail'; foreach my $item (@contacts) { if ($to{$item} ne $default{$item}) { $changes{$item} = 1; } } foreach my $type (@mailings) { if ((@{$newsetting{$type}} != 1) || ($newsetting{$type}[0] ne $default{$type})) { push(@{$changes{$type}},@{$newsetting{$type}}); } if ($others{$type} ne '') { push(@{$changes{$type}},'others'); } } } my $putresult = &Apache::lonnet::put_dom('configuration',\%contacts_hash, $dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { my ($titles,$short_titles) = &contact_titles(); $resulttext = &mt('Changes made:').'
      '; foreach my $item (@contacts) { if ($changes{$item}) { $resulttext .= '
    • '.$titles->{$item}. &mt(' set to: '). ''. $to{$item}.'
    • '; } } foreach my $type (@mailings) { if (ref($changes{$type}) eq 'ARRAY') { $resulttext .= '
    • '.$titles->{$type}.': '; my @text; foreach my $item (@{$newsetting{$type}}) { push(@text,$short_titles->{$item}); } if ($others{$type} ne '') { push(@text,$others{$type}); } $resulttext .= ''. join(', ',@text).'
    • '; } } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to contact information'); } } else { $resulttext = ''. &mt('An error occurred: [_1].',$putresult).''; } return $resulttext; } sub modify_usercreation { my ($dom,%domconfig) = @_; my ($resulttext,%curr_usercreation,%changes,%authallowed,%cancreate); if (ref($domconfig{'usercreation'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'usercreation'}})) { $curr_usercreation{$key} = $domconfig{'usercreation'}{$key}; } } my %title = &Apache::lonlocal::texthash ( author => 'adding co-authors/assistant authors', course => 'adding users to a course', ); my @username_rule = &Apache::loncommon::get_env_multiple('form.username_rule'); my @id_rule = &Apache::loncommon::get_env_multiple('form.id_rule'); my @contexts = ('author','course'); foreach my $item(@contexts) { $cancreate{$item} = $env{'form.can_createuser_'.$item}; } if (ref($curr_usercreation{'cancreate'}) eq 'HASH') { foreach my $item (@contexts) { if ($curr_usercreation{'cancreate'}{$item} ne $cancreate{$item}) { push(@{$changes{'cancreate'}},$item); } } } elsif (ref($curr_usercreation{'cancreate'}) eq 'ARRAY') { foreach my $item (@contexts) { if (grep(/^\Q$item\E$/,@{$curr_usercreation{'cancreate'}})) { if ($cancreate{$item} ne 'any') { push(@{$changes{'cancreate'}},$item); } } else { if ($cancreate{$item} ne 'none') { push(@{$changes{'cancreate'}},$item); } } } } else { foreach my $item ('author','course') { push(@{$changes{'cancreate'}},$item); } } if (ref($curr_usercreation{'username_rule'}) eq 'ARRAY') { foreach my $type (@{$curr_usercreation{'username_rule'}}) { if (!grep(/^\Q$type\E$/,@username_rule)) { push(@{$changes{'username_rule'}},$type); } } foreach my $type (@username_rule) { if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'username_rule'}})) { push(@{$changes{'username_rule'}},$type); } } } else { push(@{$changes{'username_rule'}},@username_rule); } if (ref($curr_usercreation{'id_rule'}) eq 'ARRAY') { foreach my $type (@{$curr_usercreation{'id_rule'}}) { if (!grep(/^\Q$type\E$/,@id_rule)) { push(@{$changes{'id_rule'}},$type); } } foreach my $type (@id_rule) { if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'id_rule'}})) { push(@{$changes{'id_rule'}},$type); } } } else { push(@{$changes{'id_rule'}},@id_rule); } my @contexts = ('author','course','domain'); my @authtypes = ('int','krb4','krb5','loc'); my %authhash; foreach my $item (@contexts) { my @authallowed = &Apache::loncommon::get_env_multiple('form.'.$item.'_auth'); foreach my $auth (@authtypes) { if (grep(/^\Q$auth\E$/,@authallowed)) { $authhash{$item}{$auth} = 1; } else { $authhash{$item}{$auth} = 0; } } } if (ref($curr_usercreation{'authtypes'}) eq 'HASH') { foreach my $item (@contexts) { if (ref($curr_usercreation{'authtypes'}{$item}) eq 'HASH') { foreach my $auth (@authtypes) { if ($authhash{$item}{$auth} ne $curr_usercreation{'authtypes'}{$item}{$auth}) { push(@{$changes{'authtypes'}},$item); last; } } } } } else { foreach my $item (@contexts) { push(@{$changes{'authtypes'}},$item); } } my %usercreation_hash = ( usercreation => { cancreate => \%cancreate, username_rule => \@username_rule, id_rule => \@id_rule, authtypes => \%authhash, } ); my $putresult = &Apache::lonnet::put_dom('configuration',\%usercreation_hash, $dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
      '; if (ref($changes{'cancreate'}) eq 'ARRAY') { my %lt = &usercreation_types(); foreach my $type (@{$changes{'cancreate'}}) { my $chgtext; if ($cancreate{$type} eq 'none') { $chgtext = $lt{$type}.' '.&mt('creation of new users is not permitted, except by a Domain Coordinator.'); } elsif ($cancreate{$type} eq 'any') { $chgtext = $lt{$type}.' '.&mt('creation of new users is permitted for both institutional and non-institutional usernames.'); } elsif ($cancreate{$type} eq 'official') { $chgtext = $lt{$type}.' '.&mt('creation of new users is only permitted for institutional usernames.',$lt{$type}); } elsif ($cancreate{$type} eq 'unofficial') { $chgtext = $lt{$type}.' '.&mt('creation of new users is only permitted for non-institutional usernames.',$lt{$type}); } $resulttext .= '
    • '.$chgtext.'
    • '; } } if (ref($changes{'username_rule'}) eq 'ARRAY') { my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($dom,'username'); my $chgtext = '
        '; foreach my $type (@username_rule) { if (ref($rules->{$type}) eq 'HASH') { $chgtext .= '
      • '.$rules->{$type}{'name'}.'
      • '; } } $chgtext .= '
      '; if (@username_rule > 0) { $resulttext .= '
    • '.&mt('Usernames with the following formats are restricted to verified users in the institutional directory: ').$chgtext.'
    • '; } else { $resulttext .= '
    • '.&mt('There are now no username formats restricted to verified users in the institutional directory.').'
    • '; } } if (ref($changes{'id_rule'}) eq 'ARRAY') { my ($idrules,$idruleorder) = &Apache::lonnet::inst_userrules($dom,'id'); my $chgtext = '
        '; foreach my $type (@id_rule) { if (ref($idrules->{$type}) eq 'HASH') { $chgtext .= '
      • '.$idrules->{$type}{'name'}.'
      • '; } } $chgtext .= '
      '; if (@id_rule > 0) { $resulttext .= '
    • '.&mt('IDs with the following formats are restricted to verified users in the institutional directory: ').$chgtext.'
    • '; } else { $resulttext .= '
    • '.&mt('There are now no ID formats restricted to verified users in the institutional directory.').'
    • '; } } my %authname = &authtype_names(); my %context_title = &context_names(); if (ref($changes{'authtypes'}) eq 'ARRAY') { my $chgtext = '
        '; foreach my $type (@{$changes{'authtypes'}}) { my @allowed; $chgtext .= '
      • '.$context_title{$type}.' - '.&mt('assignable authentication types: '); foreach my $auth (@authtypes) { if ($authhash{$type}{$auth}) { push(@allowed,$authname{$auth}); } } $chgtext .= join(', ',@allowed).'
      • '; } $chgtext .= '
      '; $resulttext .= '
    • '.&mt('Authentication types available for assignment to new users').'
      '.$chgtext; $resulttext .= '
    • '; } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to user creation settings'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } sub modify_usermodification { my ($dom,%domconfig) = @_; my ($resulttext,%curr_usermodification,%changes); if (ref($domconfig{'usermodification'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'usermodification'}})) { $curr_usermodification{$key} = $domconfig{'usermodification'}{$key}; } } my @contexts = ('author','course'); my %context_title = ( author => 'In author context', course => 'In course context', ); my @fields = ('lastname','firstname','middlename','generation', 'permanentemail','id'); my %roles = ( author => ['ca','aa'], course => ['st','ep','ta','in','cr'], ); my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles(); my %modifyhash; foreach my $context (@contexts) { foreach my $role (@{$roles{$context}}) { my @modifiable = &Apache::loncommon::get_env_multiple('form.canmodify_'.$role); foreach my $item (@fields) { if (grep(/^\Q$item\E$/,@modifiable)) { $modifyhash{$context}{$role}{$item} = 1; } else { $modifyhash{$context}{$role}{$item} = 0; } } } if (ref($curr_usermodification{$context}) eq 'HASH') { foreach my $role (@{$roles{$context}}) { if (ref($curr_usermodification{$context}{$role}) eq 'HASH') { foreach my $field (@fields) { if ($modifyhash{$context}{$role}{$field} ne $curr_usermodification{$context}{$role}{$field}) { push(@{$changes{$context}},$role); last; } } } } } else { foreach my $context (@contexts) { foreach my $role (@{$roles{$context}}) { push(@{$changes{$context}},$role); } } } } my %usermodification_hash = ( usermodification => \%modifyhash, ); my $putresult = &Apache::lonnet::put_dom('configuration', \%usermodification_hash,$dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { $resulttext = &mt('Changes made: ').'
      '; foreach my $context (@contexts) { if (ref($changes{$context}) eq 'ARRAY') { $resulttext .= '
    • '.$context_title{$context}.':
        '; if (ref($changes{$context}) eq 'ARRAY') { foreach my $role (@{$changes{$context}}) { my $rolename; if ($role eq 'cr') { $rolename = &mt('Custom'); } else { $rolename = &Apache::lonnet::plaintext($role); } my @modifiable; $resulttext .= '
      • '.&mt('Target user with [_1] role',$rolename).' - '.&mt('modifiable fields: '); foreach my $field (@fields) { if ($modifyhash{$context}{$role}{$field}) { push(@modifiable,$fieldtitles{$field}); } } if (@modifiable > 0) { $resulttext .= join(', ',@modifiable); } else { $resulttext .= &mt('none'); } $resulttext .= '
      • '; } $resulttext .= '
    • '; } } } $resulttext .= '
    '; } else { $resulttext = &mt('No changes made to user modification settings'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } return $resulttext; } 1;
    '."\n". &color_pick($phase,$role,$item,$choices->{$item}, $designs->{'links'}{$item}); if ($designs->{'links'}{$item}) { $datatable.='    '; } $datatable .= '
    '.$usertypes->{$type}.''. ' Mb
    '.$othertitle.''. ' Mb
    '.&mt('Auto-enrollment active?').' '. '
    '.&mt('Notification messages - sender'). ''. &mt('username').': '. '  '.&mt('domain'). ': '.$domform.'
    '.&mt($title{'run'}).' '. '
    '.&mt($title{'classlists'}).''. ' '. '
    '.&mt('Directory search available?').' '. '
    '.&mt('Other domains can search?').' '. '
    '.&mt('Supported search methods'). ''; foreach my $title (@{$titleorder}) { if (defined($searchtitles->{$title})) { my $check = ' '; if (ref($settings) eq 'HASH') { if (ref($settings->{'searchby'}) eq 'ARRAY') { if (grep(/^\Q$title\E$/,@{$settings->{'searchby'}})) { $check = ' checked="checked" '; } } } $datatable .= ''; } } $datatable .= '
    '. '
    '.&mt('Search latitude').''. ' '. ' '. '
    '.$titles->{$item}. ''. '
    '. $titles->{$type}.': '. ''; foreach my $item (@contacts) { $datatable .= ' '; } $datatable .= '
    '.&mt('Others').':  '. ''. '
    '.&mt('No format rules have been defined for usernames or IDs in this domain.').'
    '.$lt{$item}. ''; my @options = ('any'); if (ref($rules) eq 'HASH') { if (keys(%{$rules}) > 0) { push(@options,('official','unofficial')); } } push(@options,'none'); foreach my $option (@options) { my $check = ' '; if ($checked{$item} eq $option) { $check = ' checked="checked" '; } $datatable .= '  '; } $datatable .= '
    '.$title{$item}. ''. ''; foreach my $auth (@authtypes) { $datatable .= ' '; } $datatable .= '
    '. &mt("Format rules to check for $text{$type}: "). ''; my $rem; if (ref($ruleorder) eq 'ARRAY') { for (my $i=0; $i<@{$ruleorder}; $i++) { if (ref($rules->{$ruleorder->[$i]}) eq 'HASH') { my $rem = $i%($numinrow); if ($rem == 0) { if ($i > 0) { $output .= ''; } $output .= ''; } my $check = ' '; if (ref($settings) eq 'HASH') { if (ref($settings->{$type.'_rule'}) eq 'ARRAY') { if (grep(/^\Q$ruleorder->[$i]\E$/,@{$settings->{$type.'_rule'}})) { $check = ' checked="checked" '; } } } $output .= ''; } } $rem = @{$ruleorder}%($numinrow); } my $colsleft = $numinrow - $rem; if ($colsleft > 1 ) { $output .= ''; } elsif ($colsleft == 1) { $output .= ''; } $output .= '
    '. ''. '  
    '.$rolename.''; my $rem; my %checks; if (ref($settings) eq 'HASH') { if (ref($settings->{$context}) eq 'HASH') { if (ref($settings->{$context}->{$role}) eq 'HASH') { foreach my $field (@fields) { if ($settings->{$context}->{$role}->{$field}) { $checks{$field} = ' checked="checked" '; } } } } } for (my $i=0; $i<@fields; $i++) { my $rem = $i%($numinrow); if ($rem == 0) { if ($i > 0) { $output .= ''; } $output .= ''; } my $check = ' '; if (exists($checks{$fields[$i]})) { $check = $checks{$fields[$i]} } else { if ($role eq 'st') { if (ref($settings) ne 'HASH') { $check = ' checked="checked" '; } } } $output .= ''; $rem = @fields%($numinrow); } my $colsleft = $numinrow - $rem; if ($colsleft > 1 ) { $output .= ''; } elsif ($colsleft == 1) { $output .= ''; } $output .= '
    '. ''. '  
    '.&mt('Users allowed to search').' ('.$dom.')'. ''; my $rem; if (ref($types) eq 'ARRAY') { for (my $i=0; $i<@{$types}; $i++) { if (defined($usertypes->{$types->[$i]})) { my $rem = $i%($numinrow); if ($rem == 0) { if ($i > 0) { $output .= ''; } $output .= ''; } my $check = ' '; if (ref($settings->{'cansearch'}) eq 'ARRAY') { if (grep(/^\Q$types->[$i]\E$/,@{$settings->{'cansearch'}})) { $check = ' checked="checked" '; } } $output .= ''; } } $rem = @{$types}%($numinrow); } my $colsleft = $numinrow - $rem; if ($colsleft > 1) { $output .= ''. '
    '. ''; } else { $output .= ''; } my $defcheck = ' '; if (ref($settings->{'cansearch'}) eq 'ARRAY') { if (grep(/^default$/,@{$settings->{'cansearch'}})) { $defcheck = ' checked="checked" '; } } $output .= '
    '.$usertypes->{$type}. ''; for (my $i=0; $i<@{$fields}; $i++) { my $rem = $i%($numinrow); if ($rem == 0) { if ($i > 0) { $datatable .= ''; } $datatable .= ''; } my $check = ' '; if (ref($settings) eq 'HASH') { if (ref($settings->{'fields'}) eq 'HASH') { if (ref($settings->{'fields'}{$type}) eq 'ARRAY') { if (grep(/^\Q$fields->[$i]\E$/,@{$settings->{'fields'}{$type}})) { $check = ' checked="checked" '; } } } } if ($i == @{$fields}-1) { my $colsleft = $numinrow - $rem; if ($colsleft > 1) { $datatable .= ''; } $datatable .= '
    '; } else { $datatable .= ''; } } else { $datatable .= ''; } $datatable .= '