[BACK]Return to domainprefs.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/domainprefs.pm between versions 1.45 and 1.53

version 1.45, 2008/02/29 21:01:36 version 1.53, 2008/05/29 03:27:33
Line 37  use Apache::loncommon(); Line 37  use Apache::loncommon();
 use Apache::lonhtmlcommon();  use Apache::lonhtmlcommon();
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::lonmsg();  use Apache::lonmsg();
 use LONCAPA();  use LONCAPA;
 use LONCAPA::Enrollment;  use LONCAPA::Enrollment;
 use File::Copy;  use File::Copy;
 use Locale::Language;  use Locale::Language;
Line 70  sub handler { Line 70  sub handler {
     my %domconfig =      my %domconfig =
       &Apache::lonnet::get_dom('configuration',['login','rolecolors',        &Apache::lonnet::get_dom('configuration',['login','rolecolors',
                 'quotas','autoenroll','autoupdate','directorysrch',                  'quotas','autoenroll','autoupdate','directorysrch',
                 'usercreation','usermodification','contacts','defaults'],$dom);                  'usercreation','usermodification','contacts','defaults',
                   'scantron','coursecategories'],$dom);
     my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll',      my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll',
                        'autoupdate','directorysrch','contacts',                         'autoupdate','directorysrch','contacts',
                        'usercreation','usermodification');                         'usercreation','usermodification','scantron',
                          'coursecategories');
     my %prefs = (      my %prefs = (
         'rolecolors' =>          'rolecolors' =>
                    { text => 'Default color schemes',                     { text => 'Default color schemes',
Line 150  sub handler { Line 152  sub handler {
                                {col1 => 'Target user has role',                                 {col1 => 'Target user has role',
                                 col2 => 'User information updateable in course context'}],                                  col2 => 'User information updateable in course context'}],
                   },                    },
           'scantron' => 
                     { text => 'Scantron format file',
                       help => 'Domain_Scantron_Formats',
                       header => [ {col1 => 'Item',
                                    col2 => '',
                                 }],
                     },
           'coursecategories' => 
                     { text => 'Cataloging of courses',
                       help => 'Domain_Course_Catalog',
                       header => [  {col1 => 'Categories',
                                     col2 => '',
                                 }],
                     }
     );      );
     my @roles = ('student','coordinator','author','admin');      my @roles = ('student','coordinator','author','admin');
     my @actions = &Apache::loncommon::get_env_multiple('form.actions');      my @actions = &Apache::loncommon::get_env_multiple('form.actions');
Line 308  sub handler { Line 324  sub handler {
         $r->print('</div><div class="LC_clear_float_footer"></div><h3>'.          $r->print('</div><div class="LC_clear_float_footer"></div><h3>'.
                   &mt('Display options').'</h3>'."\n".                    &mt('Display options').'</h3>'."\n".
                   '<p><span class="LC_nobreak">'.&mt('Display using: ')."\n".                    '<p><span class="LC_nobreak">'.&mt('Display using: ')."\n".
                   '<label><input type="radio" name="numcols" value="1">'.                    '<label><input type="radio" name="numcols" value="1" />'.
                   &mt('one column').'</label>&nbsp;&nbsp;'.                    &mt('one column').'</label>&nbsp;&nbsp;<label>'.
                   '<input type="radio" name="numcols" value="2">'.                    '<input type="radio" name="numcols" value="2" />'.
                   &mt('two columns').'</label></span></p>');                    &mt('two columns').'</label></span></p>');
         $r->print(&print_footer($r,$phase,'display','Go'));          $r->print(&print_footer($r,$phase,'display','Go'));
         $r->print('</form>');          $r->print('</form>');
Line 343  sub process_changes { Line 359  sub process_changes {
         $output = &modify_contacts($dom,%domconfig);          $output = &modify_contacts($dom,%domconfig);
     } elsif ($action eq 'defaults') {      } elsif ($action eq 'defaults') {
         $output = &modify_defaults($dom,$r);          $output = &modify_defaults($dom,$r);
       } elsif ($action eq 'scantron') {
           $output = &modify_scantron($r,$dom,$confname,%domconfig);
       } elsif ($action eq 'coursecategories') {
           $output = &modify_coursecategories($dom,%domconfig);
     }      }
     return $output;      return $output;
 }  }
Line 350  sub process_changes { Line 370  sub process_changes {
 sub print_config_box {  sub print_config_box {
     my ($r,$dom,$confname,$phase,$action,$item,$settings) = @_;      my ($r,$dom,$confname,$phase,$action,$item,$settings) = @_;
     my $rowtotal = 0;      my $rowtotal = 0;
     my $output =       my $output;
       if ($action eq 'coursecategories') {
           $output = &coursecategories_javascript($settings);
       }  
       $output .= 
          '<table class="LC_nested_outer">           '<table class="LC_nested_outer">
           <tr>            <tr>
            <th align="left"><span class="LC_nobreak">'.&mt($item->{text}).             <th align="left"><span class="LC_nobreak">'.&mt($item->{text}).
Line 450  sub print_config_box { Line 474  sub print_config_box {
             $output .= '              $output .= '
               <td class="LC_left_item">'.$item->{'header'}->[0]->{'col1'}.'</td>';                <td class="LC_left_item">'.$item->{'header'}->[0]->{'col1'}.'</td>';
         }          }
           my $colspan = ($action eq 'coursecategories')?' colspan="2"':'';
         $output .= '          $output .= '
               <td class="LC_right_item">'.$item->{'header'}->[0]->{'col2'}.'</td>                <td class="LC_right_item"'.$colspan.'>'.$item->{'header'}->[0]->{'col2'}.'</td>
              </tr>';               </tr>';
         $rowtotal ++;                $rowtotal ++;
         if ($action eq 'login') {          if ($action eq 'login') {
             $output .= &print_login($dom,$confname,$phase,$settings,\$rowtotal);              $output .= &print_login($dom,$confname,$phase,$settings,\$rowtotal);
         } elsif ($action eq 'quotas') {          } elsif ($action eq 'quotas') {
Line 466  sub print_config_box { Line 491  sub print_config_box {
             $output .= &print_contacts($dom,$settings,\$rowtotal);              $output .= &print_contacts($dom,$settings,\$rowtotal);
         } elsif ($action eq 'defaults') {          } elsif ($action eq 'defaults') {
             $output .= &print_defaults($dom,\$rowtotal);              $output .= &print_defaults($dom,\$rowtotal);
           } elsif ($action eq 'scantron') {
               $output .= &print_scantronformat($r,$dom,$confname,$settings,\$rowtotal);
           } elsif ($action eq 'coursecategories'){
               $output .= &print_coursecategories($dom,$item,$settings,\$rowtotal);
         }          }
     }      }
     $output .= '      $output .= '
Line 486  function changePage(formname,newphase) { Line 515  function changePage(formname,newphase) {
     numchecked = 0;      numchecked = 0;
     if (formname == document.pickactions) {      if (formname == document.pickactions) {
         if (formname.actions.length > 0) {          if (formname.actions.length > 0) {
             for (var i = 0; i <formname.actions.length; i++) {              for (var i = 0; i<formname.actions.length; i++) {
                 if (formname.actions[i].checked) {                  if (formname.actions[i].checked) {
                     numchecked ++;                      numchecked ++;
                 }                  }
Line 1514  sub print_usercreation { Line 1543  sub print_usercreation {
             &Apache::lonnet::inst_userrules($dom,'username');              &Apache::lonnet::inst_userrules($dom,'username');
         my %lt = &usercreation_types();          my %lt = &usercreation_types();
         my %checked;          my %checked;
           my @selfcreate; 
         if (ref($settings) eq 'HASH') {          if (ref($settings) eq 'HASH') {
             if (ref($settings->{'cancreate'}) eq 'HASH') {              if (ref($settings->{'cancreate'}) eq 'HASH') {
                 foreach my $item (@creators) {                  foreach my $item (@creators) {
                     $checked{$item} = $settings->{'cancreate'}{$item};                      $checked{$item} = $settings->{'cancreate'}{$item};
                 }                  }
                   if (ref($settings->{'cancreate'}{'selfcreate'}) eq 'ARRAY') {
                       @selfcreate = @{$settings->{'cancreate'}{'selfcreate'}};
                   } elsif ($settings->{'cancreate'}{'selfcreate'} ne '') {
                       if ($settings->{'cancreate'}{'selfcreate'} eq 'any') {
                           @selfcreate = ('email','login','sso');
                       } elsif ($settings->{'cancreate'}{'selfcreate'} ne 'none') {
                           @selfcreate = ($settings->{'cancreate'}{'selfcreate'});
                       }
                   }
             } elsif (ref($settings->{'cancreate'}) eq 'ARRAY') {              } elsif (ref($settings->{'cancreate'}) eq 'ARRAY') {
                 foreach my $item (@creators) {                  foreach my $item (@creators) {
                     if (grep(/^\Q$item\E$/,@{$settings->{'cancreate'}})) {                      if (grep(/^\Q$item\E$/,@{$settings->{'cancreate'}})) {
Line 1530  sub print_usercreation { Line 1569  sub print_usercreation {
         my $rownum = 0;          my $rownum = 0;
         foreach my $item (@creators) {          foreach my $item (@creators) {
             $rownum ++;              $rownum ++;
             if ($checked{$item} eq '') {              if ($item ne 'selfcreate') {  
                 if ($item eq 'selfcreate') {                  if ($checked{$item} eq '') {
                     $checked{$item} = 'none';  
                 } else {  
                     $checked{$item} = 'any';                      $checked{$item} = 'any';
                 }                  }
             }              }
Line 1546  sub print_usercreation { Line 1583  sub print_usercreation {
             $datatable .= '<tr'.$css_class.'>'.              $datatable .= '<tr'.$css_class.'>'.
                          '<td><span class="LC_nobreak">'.$lt{$item}.                           '<td><span class="LC_nobreak">'.$lt{$item}.
                          '</span></td><td align="right">';                           '</span></td><td align="right">';
             my @options = ('any');              my @options;
             if ($item eq 'selfcreate') {              if ($item eq 'selfcreate') {
                 push(@options,('email','login','sso'));                  push(@options,('email','login','sso'));
             } else {              } else {
                   @options = ('any');
                 if (ref($rules) eq 'HASH') {                  if (ref($rules) eq 'HASH') {
                     if (keys(%{$rules}) > 0) {                      if (keys(%{$rules}) > 0) {
                         push(@options,('official','unofficial'));                          push(@options,('official','unofficial'));
                     }                      }
                 }                  }
                   push(@options,'none');
             }              }
             push(@options,'none');  
             foreach my $option (@options) {              foreach my $option (@options) {
                   my $type = 'radio';
                 my $check = ' ';                  my $check = ' ';
                 if ($checked{$item} eq $option) {                  if ($item eq 'selfcreate') {
                     $check = ' checked="checked" ';                      $type = 'checkbox';
                       if (grep(/^\Q$option\E$/,@selfcreate)) {
                           $check = ' checked="checked" ';
                       }
                   } else {
                       if ($checked{$item} eq $option) {
                           $check = ' checked="checked" ';
                       }
                 }                   } 
                 $datatable .= '<span class="LC_nobreak"><label>'.                  $datatable .= '<span class="LC_nobreak"><label>'.
                               '<input type="radio" name="can_createuser_'.                                '<input type="'.$type.'" name="can_createuser_'.
                               $item.'" value="'.$option.'"'.$check.'/>&nbsp;'.                                $item.'" value="'.$option.'"'.$check.'/>&nbsp;'.
                               $lt{$option}.'</label>&nbsp;&nbsp;</span>';                                $lt{$option}.'</label>&nbsp;&nbsp;</span>';
             }              }
Line 1687  sub usercreation_types { Line 1733  sub usercreation_types {
                     none       => 'None',                      none       => 'None',
     );      );
     return %lt;      return %lt;
 }   }
   
 sub authtype_names {  sub authtype_names {
     my %lt = &Apache::lonlocal::texthash(      my %lt = &Apache::lonlocal::texthash(
Line 1788  sub defaults_titles { Line 1834  sub defaults_titles {
     return (\%titles);      return (\%titles);
 }  }
   
   sub print_scantronformat {
       my ($r,$dom,$confname,$settings,$rowtotal) = @_;
       my $itemcount = 1;
       my ($datatable,$css_class,$scantronurl,$is_custom,%error,%scantronurls);
       my $switchserver = &check_switchserver($dom,$confname);
       my %lt = &Apache::lonlocal::texthash (
                   default => 'Default scantron format file error',
                   custom  => 'Custom scantron format file error',
                );
       my %scantronfiles = (
           default => 'default.tab',
           custom => 'custom.tab',
       );
       foreach my $key (keys(%scantronfiles)) {
           $scantronurls{$key} = '/res/'.$dom.'/'.$confname.'/scantron/'
                                 .$scantronfiles{$key};
       }
       my @defaultinfo = &Apache::lonnet::stat_file($scantronurls{'default'});
       if ((!@defaultinfo) || ($defaultinfo[0] eq 'no_such_dir')) {
           if (!$switchserver) {
               my $servadm = $r->dir_config('lonAdmEMail');
               my ($configuserok,$author_ok) = &config_check($dom,$confname,$servadm);
               if ($configuserok eq 'ok') {
                   if ($author_ok eq 'ok') {
                       my %legacyfile = (
    default => $Apache::lonnet::perlvar{'lonTabDir'}.'/default_scantronformat.tab', 
    custom  => $Apache::lonnet::perlvar{'lonTabDir'}.'/scantronformat.tab', 
                       );
                       my %md5chk;
                       foreach my $type (keys(%legacyfile)) {
                           $md5chk{$type} = split(/ /,`md5sum $legacyfile{$type}`);
                           chop($md5chk{$type});
                       }
                       if ($md5chk{'default'} ne $md5chk{'custom'}) {
                           foreach my $type (keys(%legacyfile)) {
                               ($scantronurls{$type},$error{$type}) = 
                                   &legacy_scantronformat($r,$dom,$confname,
                                                    $type,$legacyfile{$type},
                                                    $scantronurls{$type},
                                                    $scantronfiles{$type});
                           }
                       } else {
                           ($scantronurls{'default'},$error{'default'}) =
                               &legacy_scantronformat($r,$dom,$confname,
                                             'default',$legacyfile{'default'},
                                             $scantronurls{'default'},
                                             $scantronfiles{'default'});
                       }
                   }
               }
           } else {
               $error{'default'} = &mt("Unable to copy default scantron formatfile to domain's RES space: [_1]",$switchserver);
           }
       }
       if (ref($settings) eq 'HASH') {
           if ($settings->{'scantronformat'} eq "/res/$dom/$confname/scantron/custom.tab") {
               my @info = &Apache::lonnet::stat_file($settings->{'scantronformat'});
               if ((!@info) || ($info[0] eq 'no_such_dir')) {
                   $scantronurl = '';
               } else {
                   $scantronurl = $settings->{'scantronformat'};
               }
               $is_custom = 1;
           } else {
               $scantronurl = $scantronurls{'default'};
           }
       } else {
           $scantronurl = $scantronurls{'default'};
       }
       $css_class = $itemcount%2?' class="LC_odd_row"':'';
       $datatable .= '<tr'.$css_class.'>';
       if (!$is_custom) {
           $datatable .= '<td>'.&mt('Default in use:').'<br />';
           if ($scantronurl) {
               $datatable .= '<a href="'.$scantronurl.'" target="_blank">'.
                             &mt('Default scantron format file').'</a>';
           } else {
               $datatable = &mt('File unavailable for display');
           }
           $datatable .= '</td><td valign="bottom">'.&mt('Upload:').'<br />';
       } else {
           if (keys(%error) > 0) {
               my $errorstr;
               foreach my $key (sort(keys(%error))) {
                   $errorstr .= $lt{$key}.': '.$error{$key}.'<br />';
               } 
               $datatable .= '<td>'.$errorstr.'</td><td>';
           } elsif ($scantronurl) {
               $datatable .= '<td><a href="'.$scantronurl.'" target="_blank">'                          .&mt('Custom scantron format file').'</a>'
                             .'<span class="LC_nobreak"><label>'
                             .'<input type="checkbox" name="scantronformat_del"'
                             .'" value="1" />'.&mt('Delete?').'</label></td>'
                             .'<td>'.&mt('Replace:').'</span><br />';
           }
       }
       if (keys(%error) == 0) {
           if ($switchserver) {
               $datatable .= &mt('Upload to library server: [_1]',$switchserver);
           } else {
               $datatable .='&nbsp;<input type="file" name="scantronformat" />';
           }
       }
       $datatable .= '</td></tr>';
       $$rowtotal ++;
       return $datatable;
   }
   
   sub legacy_scantronformat {
       my ($r,$dom,$confname,$file,$legacyfile,$newurl,$newfile) = @_;
       my ($url,$error);
       my @statinfo = &Apache::lonnet::stat_file($newurl);
       if ((!@statinfo) || ($statinfo[0] eq 'no_such_dir')) {
           (my $result,$url) =
               &publishlogo($r,'copy',$legacyfile,$dom,$confname,'scantron',
                            '','',$newfile);
           if ($result ne 'ok') {
               $error = &mt("An error occurred publishing the [_1] scantron format file in RES space. Error was: [_2].",$newfile,$result);
           }
       }
       return ($url,$error);
   }
   
   sub print_coursecategories {
       my ($dom,$hdritem,$settings,$rowtotal) = @_;
       my ($datatable,$css_class);
       my $itemcount = 1;
       if (ref($settings) eq 'HASH') {
           my (@cats,@trails,%allitems,%idx,@jsarray);
           &Apache::loncommon::extract_categories($settings,\@cats,\@trails,
                                                  \%allitems,\%idx,\@jsarray);
           my $maxdepth = scalar(@cats);
           my $colattrib = '';
           if ($maxdepth > 2) {
               $colattrib = ' colspan="2" ';
           }
           my @path;
           if (@cats > 0) {
               if (ref($cats[0]) eq 'ARRAY') {
                   my $numtop = @{$cats[0]};
                   my $maxnum = $numtop;
                   if ((!grep(/^instcode$/,@{$cats[0]})) || ($settings->{'instcode::0'} eq '')) {
                       $maxnum ++;
                   }
                   my $lastidx;
                   for (my $i=0; $i<$numtop; $i++) {
                       my $parent = $cats[0][$i];
                       $css_class = $itemcount%2?' class="LC_odd_row"':'';
                       my $item = &escape($parent).'::0';
                       my $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','$item','$idx{$item}'".');"';
                       $lastidx = $idx{$item};
                       $datatable .= '<tr '.$css_class.'><td><span class="LC_nobreak">'
                                     .'<select name="'.$item.'"'.$chgstr.'>';
                       for (my $k=0; $k<=$maxnum; $k++) {
                           my $vpos = $k+1;
                           my $selstr;
                           if ($k == $i) {
                               $selstr = ' selected="selected" ';
                           }
                           $datatable .= '<option value="'.$k.'"'.$selstr.'>'.$vpos.'</option>';
                       }
                       $datatable .= '</select></td><td>';
                       if ($parent eq 'instcode') {
                           $datatable .=  '<span class="LC_nobreak">'.&mt('Official courses')
                                          .'</span><br /><span class="LC_nobreak">('
                                          .&mt('with institutional codes').')</span></td>'
                                          .'<td'.$colattrib.'><span class="LC_nobreak"><label><input type="radio" name="instcode" value="1" checked="checked" />'
                                           .&mt('Display').'</label>&nbsp;'
                                           .'<label><input type="radio" name="instcode" value="0" />'
                                           .&mt('Do not display').'</label></span></td>';
                       } else {
                           $datatable .= $parent
                                         .'&nbsp;<label><input type="checkbox" name="deletecategory" '
                                         .'value="'.$item.'" />'.&mt('Delete').'</label></span></td>';
                       }
                       my $depth = 1;
                       push(@path,$parent);
                       $datatable .= &build_category_rows($itemcount,\@cats,$depth,$parent,\@path,\%idx);
                       pop(@path);
                       $datatable .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
                       $itemcount ++;
                   }
                   $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   my $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','addcategory_pos','$lastidx'".');"';
                   $datatable .= '<tr '.$css_class.'><td><span class="LC_nobreak"><select name="addcategory_pos"'.$chgstr.'>';
                   for (my $k=0; $k<=$maxnum; $k++) {
                       my $vpos = $k+1;
                       my $selstr;
                       if ($k == $numtop) {
                           $selstr = ' selected="selected" ';
                       }
                       $datatable .= '<option value="'.$k.'"'.$selstr.'>'.$vpos.'</option>';
                   }
                   $datatable .= '</select></span></td><td colspan="2">'.&mt('New:').'&nbsp;'
                                 .'<input type="text" size="20" name="addcategory_name" value="" /></td>'
                                 .'</tr>'."\n";
                   $itemcount ++;
                   if ((!grep(/^instcode$/,@{$cats[0]})) || ($settings->{'instcode::0'} eq '')) {
                       $css_class = $itemcount%2?' class="LC_odd_row"':'';
                       my $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','instcode_pos','$lastidx'".');"';
                       $datatable .= '<tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr><tr '.$css_class.'><td>'.
                                     '<span class="LC_nobreak"><select name="instcode_pos"'.$chgstr.'>';
                       for (my $k=0; $k<=$maxnum; $k++) {
                           my $vpos = $k+1;
                           my $selstr;
                           if ($k == $maxnum) {
                               $selstr = ' selected="selected" ';
                           }
                           $datatable .= '<option value="'.$k.'"'.$selstr.'>'.$vpos.'</option>';
                       }
                       $datatable .= '</select></span></td><td><span class="LC_nobreak">'
                                     .&mt('Official courses').'</span>'.'<br /><span class="LC_nobreak">('
                                     .&mt('with institutional codes').')</span></td>'
                                     .'<td><span class="LC_nobreak"><label><input type="radio" name="instcode" value="1" />'
                                     .&mt('Display').'</label>&nbsp;'
                                     .'<label><input type="radio" name="instcode" value="0" checked="checked"/>'
                                     .&mt('Do not display').'</label></span></td></tr>';
                   }
               }
           } else {
               $datatable .= &initialize_categories($itemcount);
           }
       } else {
           $datatable .= '<td class="LC_right_item">'.$hdritem->{'header'}->[0]->{'col2'}.'</td>'
                         .&initialize_categories($itemcount);
       }
       $$rowtotal += $itemcount;
       return $datatable;
   }
   
   sub coursecategories_javascript {
       my ($settings) = @_;
       my ($output,$jstext);
       if (ref($settings) eq 'HASH') {
           my (@cats,@jsarray,%idx);
           &Apache::loncommon::gather_categories($settings,\@cats,\%idx,\@jsarray);
           if (@jsarray > 0) {
               $jstext = '    var categories = Array('.scalar(@jsarray).');'."\n";
               for (my $i=0; $i<@jsarray; $i++) {
                   if (ref($jsarray[$i]) eq 'ARRAY') {
                       my $catstr = join('","',@{$jsarray[$i]});
                       $jstext .= '    categories['.$i.'] = Array("'.$catstr.'");'."\n";
                   }
               }
           }
       } else {
           $jstext  = '    var categories = Array(1);'."\n".
                      '    categories[0] = Array("instcode_pos");'."\n"; 
       }
       $output = <<"ENDSCRIPT";
   <script type="text/javascript">
   function reorderCats(form,parent,item,idx) {
       var changedVal;
   $jstext
       var newpos = 'addcategory_pos';
       var current = new Array;
       if (parent == '') {
           var has_instcode = 0;
           var maxtop = categories[idx].length;
           for (var j=0; j<maxtop; j++) {
               if (categories[idx][j] == 'instcode::0') {
                   has_instcode == 1;
               }
           }
           if (has_instcode == 0) {
               categories[idx][maxtop] = 'instcode_pos';
           }
       } else {
           newpos += '_'+parent;
       }
       var maxh = 1 + categories[idx].length;
       var current = new Array;
       var newitemVal = form.elements[newpos].options[form.elements[newpos].selectedIndex].value;
       if (item == newpos) {
           changedVal = newitemVal;
       } else {
           changedVal = form.elements[item].options[form.elements[item].selectedIndex].value;
           current[newitemVal] = newpos;
       }
       for (var i=0; i<categories[idx].length; i++) {
           var elementName = categories[idx][i];
           if (elementName != item) {
               if (form.elements[elementName]) {
                   var currVal = form.elements[elementName].options[form.elements[elementName].selectedIndex].value;
                   current[currVal] = elementName;
               }
           }
       }
       var oldVal;
       for (var j=0; j<maxh; j++) {
           if (current[j] == undefined) {
               oldVal = j;
           }
       }
       if (oldVal < changedVal) {
           for (var k=oldVal+1; k<=changedVal ; k++) {
              var elementName = current[k];
              form.elements[elementName].selectedIndex = form.elements[elementName].selectedIndex - 1;
           }
       } else {
           for (var k=changedVal; k<oldVal; k++) {
               var elementName = current[k];
               form.elements[elementName].selectedIndex = form.elements[elementName].selectedIndex + 1;
           }
       }
       return;
   }
   </script>
   
   ENDSCRIPT
       return $output;
   }
   
   sub initialize_categories {
       my ($itemcount) = @_;
       my $datatable;
       my $css_class = $itemcount%2?' class="LC_odd_row"':'';
       my $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','instcode_pos','0'".');"';
   
       $datatable = '<tr '.$css_class.'><td><span class="LC_nobreak">'
                    .'<select name="instcode_pos"><option value="0" selected="selected">1</option>'
                    .'<option value="1">2</option></select>&nbsp;'
                    .&mt('Official courses (with institutional codes)')
                    .'</span></td><td><span class="LC_nobreak">'
                    .'<label><input type="radio" name="instcode" value="1" checked="checked" />'
                    .&mt('Display').'</label>&nbsp;<label>'
                    .'<input type="radio" name="instcode" value="0" />'.&mt('Do not display')
                    .'</label></span></td></tr>';
       $itemcount ++;
       $css_class = $itemcount%2?' class="LC_odd_row"':'';
       $chgstr = ' onchange="javascript:reorderCats(this.form,'."'','addcategory_pos','0'".');"';
       $datatable .= '<tr '.$css_class.'><td><span class="LC_nobreak">'
                     .'<select name="addcategory_pos"'.$chgstr.'><option value="0">1</option>'
                     .'<option value="1" selected="selected">2</option></select>&nbsp;'
                     .&mt('Add category').'</td><td>'.&mt('Name:')
                     .'&nbsp;<input type="text" size="20" name="addcategory_name" value="" /></td></tr>';
       return $datatable;
   }
   
   sub build_category_rows {
       my ($itemcount,$cats,$depth,$parent,$path,$idx) = @_;
       my ($text,$name,$item,$chgstr);
       if (ref($cats) eq 'ARRAY') {
           my $maxdepth = scalar(@{$cats});
           if (ref($cats->[$depth]) eq 'HASH') {
               if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   my $numchildren = @{$cats->[$depth]{$parent}};
                   my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   $text .= '<td><table class="LC_datatable">';
                   my ($idxnum,$parent_name,$parent_item);
                   my $higher = $depth - 1;
                   if ($higher == 0) {
                       $parent_name = &escape($parent).'::'.$higher;
                   } else {
                       if (ref($path) eq 'ARRAY') {
                           $parent_name = &escape($parent).':'.&escape($path->[-2]).':'.$higher;
                       }
                   }
                   $parent_item = 'addcategory_pos_'.$parent_name;
                   for (my $j=0; $j<=$numchildren; $j++) {
                       if ($j < $numchildren) {
                           $name = $cats->[$depth]{$parent}[$j];
                           $item = &escape($name).':'.&escape($parent).':'.$depth;
                           $idxnum = $idx->{$item};
                       } else {
                           $name = $parent_name;
                           $item = $parent_item;
                       }
                       $chgstr = ' onchange="javascript:reorderCats(this.form,'."'$parent_name','$item','$idxnum'".');"';
                       $text .= '<tr '.$css_class.'><td><span class="LC_nobreak"><select name="'.$item.'"'.$chgstr.'>';
                       for (my $i=0; $i<=$numchildren; $i++) {
                           my $vpos = $i+1;
                           my $selstr;
                           if ($j == $i) {
                               $selstr = ' selected="selected" ';
                           }
                           $text .= '<option value="'.$i.'"'.$selstr.'>'.$vpos.'</option>';
                       }
                       $text .= '</select>&nbsp;';
                       if ($j < $numchildren) {
                           my $deeper = $depth+1;
                           $text .= $name.'&nbsp;'
                                    .'<label><input type="checkbox" name="deletecategory" value="'
                                    .$item.'" />'.&mt('Delete').'</label></span></td><td>';
                           if(ref($path) eq 'ARRAY') {
                               push(@{$path},$name);
                               $text .= &build_category_rows($itemcount,$cats,$deeper,$name,$path,$idx);
                               pop(@{$path});
                           }
                       } else {
                           $text .= &mt('New:').'&nbsp;</span><input type="textbox" size="20" name="addcategory_name_';
                           if ($j == $numchildren) {
                               $text .= $name;
                           } else {
                               $text .= $item;
                           }
                           $text .= '" value="" />';
                       }
                       $text .= '</td></tr>';
                   }
                   $text .= '</table></td>';
               } else {
                   my $higher = $depth-1;
                   if ($higher == 0) {
                       $name = &escape($parent).'::'.$higher;
                   } else {
                       if (ref($path) eq 'ARRAY') {
                           $name = &escape($parent).':'.&escape($path->[-2]).':'.$higher;
                       }
                   }
                   my $colspan;
                   if ($parent ne 'instcode') {
                       $colspan = $maxdepth - $depth - 1;
                       $text .= '<td colspan="'.$colspan.'">'.&mt('Add subcategory:').'<input type="textbox" size="20" name="subcat_'.$name.'" value="" /></td>';
                   }
               }
           }
       }
       return $text;
   }
   
 sub modifiable_userdata_row {  sub modifiable_userdata_row {
     my ($context,$role,$settings,$numinrow,$rowcount) = @_;      my ($context,$role,$settings,$numinrow,$rowcount) = @_;
Line 2106  sub modify_rolecolors { Line 2571  sub modify_rolecolors {
 sub modify_colors {  sub modify_colors {
     my ($r,$dom,$confname,$roles,$domconfig,$confhash) = @_;      my ($r,$dom,$confname,$roles,$domconfig,$confhash) = @_;
     my (%changes,%choices);      my (%changes,%choices);
     my @bgs = ('pgbg','mainbg','sidebg');      my @bgs;
     my @links = ('link','alink','vlink');      my @links = ('link','alink','vlink');
     my @logintext;      my @logintext;
     my @images;      my @images;
Line 2121  sub modify_colors { Line 2586  sub modify_colors {
         }          }
         if ($role eq 'login') {          if ($role eq 'login') {
             @images = ('img','logo','domlogo','login');              @images = ('img','logo','domlogo','login');
               @bgs = ('pgbg','mainbg','sidebg');
         } else {          } else {
             @images = ('img');              @images = ('img');
               @bgs = ('pgbg','tabbg','sidebg'); 
         }          }
         $confhash->{$role}{'font'} = $env{'form.'.$role.'_font'};          $confhash->{$role}{'font'} = $env{'form.'.$role.'_font'};
         foreach my $item (@bgs,@links,@logintext) {          foreach my $item (@bgs,@links,@logintext) {
             $confhash->{$role}{$item} = $env{'form.'.$role.'_'.$item};              $confhash->{$role}{$item} = $env{'form.'.$role.'_'.$item};
         }          }
         my ($configuserok,$author_ok,$switchserver,%currroles);          my ($configuserok,$author_ok,$switchserver) = 
         my $uhome = &Apache::lonnet::homeserver($confname,$dom,1);              &config_check($dom,$confname,$servadm);
         ($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();          my ($width,$height) = &thumb_dimensions();
         if (ref($domconfig->{$role}) ne 'HASH') {          if (ref($domconfig->{$role}) ne 'HASH') {
             $domconfig->{$role} = {};              $domconfig->{$role} = {};
Line 2169  sub modify_colors { Line 2628  sub modify_colors {
                                 $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);                                  $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 {                          } 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);                              $error = &mt("Upload of [_1] image for $role page(s) failed because an author role could not be assigned to a Domain Configuration user ([_2]) in domain: [_3].  Error was: [_4].",$choices{$img},$confname,$dom,$author_ok);
                         }                          }
                     }                      }
                 } else {                  } 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);                      $error = &mt("Upload of [_1] image for $role page(s) failed because a Domain Configuration user ([_2]) could not be created in domain: [_3].  Error was: [_4].",$choices{$img},$confname,$dom,$configuserok);
                 }                  }
                 if ($error) {                  if ($error) {
                     &Apache::lonnet::logthis($error);                      &Apache::lonnet::logthis($error);
Line 2272  sub modify_colors { Line 2731  sub modify_colors {
     return ($errors,%changes);      return ($errors,%changes);
 }  }
   
   sub config_check {
       my ($dom,$confname,$servadm) = @_;
       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);
           }
       }
       return ($configuserok,$author_ok,$switchserver);
   }
   
 sub default_change_checker {  sub default_change_checker {
     my ($role,$images,$links,$bgs,$logintext,$confhash,$changes) = @_;      my ($role,$images,$links,$bgs,$logintext,$confhash,$changes) = @_;
     foreach my $item (@{$links}) {      foreach my $item (@{$links}) {
Line 2298  sub default_change_checker { Line 2772  sub default_change_checker {
     if ($confhash->{$role}{'font'}) {      if ($confhash->{$role}{'font'}) {
         $changes->{$role}{'font'} = 1;          $changes->{$role}{'font'} = 1;
     }      }
 }   }
   
 sub display_colorchgs {  sub display_colorchgs {
     my ($dom,$changes,$roles,$confhash) = @_;      my ($dom,$changes,$roles,$confhash) = @_;
Line 2403  sub check_authorstatus { Line 2877  sub check_authorstatus {
         my $end = 0;          my $end = 0;
         $author_ok =           $author_ok = 
             &Apache::lonnet::assignrole($dom,$confname,'/'.$dom.'/',              &Apache::lonnet::assignrole($dom,$confname,'/'.$dom.'/',
                                         'au',$end,$start);                                          'au',$end,$start,'','','domconfig');
     } else {      } else {
         $author_ok = 'ok';          $author_ok = 'ok';
     }      }
Line 2411  sub check_authorstatus { Line 2885  sub check_authorstatus {
 }  }
   
 sub publishlogo {  sub publishlogo {
     my ($r,$action,$formname,$dom,$confname,$subdir,$thumbwidth,$thumbheight) = @_;      my ($r,$action,$formname,$dom,$confname,$subdir,$thumbwidth,$thumbheight,$savefileas) = @_;
     my ($output,$fname,$logourl);      my ($output,$fname,$logourl);
     if ($action eq 'upload') {      if ($action eq 'upload') {
         $fname=$env{'form.'.$formname.'.filename'};          $fname=$env{'form.'.$formname.'.filename'};
Line 2419  sub publishlogo { Line 2893  sub publishlogo {
     } else {      } else {
         ($fname) = ($formname =~ /([^\/]+)$/);          ($fname) = ($formname =~ /([^\/]+)$/);
     }      }
       if ($savefileas ne '') {
           $fname = $savefileas;
       }
     $fname=&Apache::lonnet::clean_filename($fname);      $fname=&Apache::lonnet::clean_filename($fname);
 # See if there is anything left  # See if there is anything left
     unless ($fname) { return ('error: no uploaded file'); }      unless ($fname) { return ('error: no uploaded file'); }
Line 2446  sub publishlogo { Line 2923  sub publishlogo {
         !defined(&Apache::loncommon::fileembstyle($1))) {          !defined(&Apache::loncommon::fileembstyle($1))) {
         $output = &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);          $output = &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1);
     } elsif ($file=~/\.(\d+)\.(\w+)$/) {      } 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);          $output = &mt('File name not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2);
     } elsif (-d "$filepath/$file") {      } elsif (-d "$filepath/$file") {
         $output = &mt('File name is a directory name - rename the file and re-upload');          $output = &mt('File name is a directory name - rename the file and re-upload');
     } else {      } else {
Line 3183  sub modify_usercreation { Line 3660  sub modify_usercreation {
     my @email_rule = &Apache::loncommon::get_env_multiple('form.email_rule');      my @email_rule = &Apache::loncommon::get_env_multiple('form.email_rule');
     my @contexts = ('author','course','selfcreate');      my @contexts = ('author','course','selfcreate');
     foreach my $item(@contexts) {      foreach my $item(@contexts) {
         $cancreate{$item} = $env{'form.can_createuser_'.$item};  
         if ($item eq 'selfcreate') {          if ($item eq 'selfcreate') {
               @{$cancreate{$item}} = &Apache::loncommon::get_env_multiple('form.can_createuser_'.$item);
             my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);              my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
             if (!((($domdefaults{'auth_def'} =~/^krb/) && ($domdefaults{'auth_arg_def'} ne '')) || ($domdefaults{'auth_def'} eq 'localauth'))) {              if (!((($domdefaults{'auth_def'} =~/^krb/) && ($domdefaults{'auth_arg_def'} ne '')) || ($domdefaults{'auth_def'} eq 'localauth'))) {
                 if (($cancreate{$item} eq 'any') || ($cancreate{$item} eq 'login')) {                  if (ref($cancreate{$item}) eq 'ARRAY') { 
                     $warningmsg = &mt('Although account creation has been set to be available for institutional logins, currently default authentication in this domain has not been set to support this.').' '.&mt('You need to set the default authentication type to Kerberos 4 or 5 (with a Kerberos domain specified), or to Local authentication, if the localauth module has been customized in your domain to authenticate institutional logins.');                         if (grep(/^login$/,@{$cancreate{$item}})) {
                           $warningmsg = &mt('Although account creation has been set to be available for institutional logins, currently default authentication in this domain has not been set to support this.').' '.&mt('You need to set the default authentication type to Kerberos 4 or 5 (with a Kerberos domain specified), or to Local authentication, if the localauth module has been customized in your domain to authenticate institutional logins.');   
                       }
                 }                  }
             }              }
           } else {
               $cancreate{$item} = $env{'form.can_createuser_'.$item};
         }          }
     }      }
     if (ref($curr_usercreation{'cancreate'}) eq 'HASH') {      if (ref($curr_usercreation{'cancreate'}) eq 'HASH') {
         foreach my $item (@contexts) {          foreach my $item (@contexts) {
             if ($curr_usercreation{'cancreate'}{$item} ne $cancreate{$item}) {              if ($item eq 'selfcreate') {
                 push(@{$changes{'cancreate'}},$item);                  if (ref($curr_usercreation{'cancreate'}{$item}) eq 'ARRAY') { 
             }                       foreach my $curr (@{$curr_usercreation{'cancreate'}{$item}}) {
                           if (!grep(/^$curr$/,@{$cancreate{$item}})) {
                               if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                                   push(@{$changes{'cancreate'}},$item);
                               }
                           }
                       }
                   } else {
                       if ($curr_usercreation{'cancreate'}{$item} eq '') {
                           if (@{$cancreate{$item}} > 0) {
                               if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                                   push(@{$changes{'cancreate'}},$item);
                               }
                           }
                       } else {
                           if ($curr_usercreation{'cancreate'}{$item} eq 'any') {
                               if (@{$cancreate{$item}} < 3) {
                                   if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                                       push(@{$changes{'cancreate'}},$item);
                                   }
                               }
                           } elsif ($curr_usercreation{'cancreate'}{$item} eq 'none') {
                               if (@{$cancreate{$item}} > 0) {
                                   if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                                       push(@{$changes{'cancreate'}},$item);
                                   }
                               }
                           } elsif (!grep(/^$curr_usercreation{'cancreate'}{$item}$/,@{$cancreate{$item}})) {
                               if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                                   push(@{$changes{'cancreate'}},$item);
                               }
                           }
                       }
                   }
                   if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                       foreach my $type (@{$cancreate{$item}}) {
                           if (ref($curr_usercreation{'cancreate'}{$item}) eq 'ARRAY') {
                               if (!grep(/^$type$/,@{$curr_usercreation{'cancreate'}{$item}})) {
                                   if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                                       push(@{$changes{'cancreate'}},$item);
                                   }
                               }
                           } elsif (($curr_usercreation{'cancreate'}{$item} ne 'any') &&
                                    ($curr_usercreation{'cancreate'}{$item} ne 'none')) {
                               if ($curr_usercreation{'cancreate'}{$item} ne $type) {
                                   if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
                                       push(@{$changes{'cancreate'}},$item);
                                   }
                               }
                           }
                       }
                   }
               } else {
                   if ($curr_usercreation{'cancreate'}{$item} ne $cancreate{$item}) {
                       push(@{$changes{'cancreate'}},$item);
                   }
               }
         }          }
     } elsif (ref($curr_usercreation{'cancreate'}) eq 'ARRAY') {      } elsif (ref($curr_usercreation{'cancreate'}) eq 'ARRAY') {
         foreach my $item (@contexts) {          foreach my $item (@contexts) {
Line 3304  sub modify_usercreation { Line 3841  sub modify_usercreation {
   
     my $putresult = &Apache::lonnet::put_dom('configuration',\%usercreation_hash,      my $putresult = &Apache::lonnet::put_dom('configuration',\%usercreation_hash,
                                              $dom);                                               $dom);
   
       my %selfcreatetypes = (
                                sso   => 'users authenticated by institutional single sign on',
                                login => 'users authenticated by institutional log-in',
                                email => 'users who provide a valid e-mail address for use as the username',
                             );
     if ($putresult eq 'ok') {      if ($putresult eq 'ok') {
         if (keys(%changes) > 0) {          if (keys(%changes) > 0) {
             $resulttext = &mt('Changes made:').'<ul>';              $resulttext = &mt('Changes made:').'<ul>';
Line 3312  sub modify_usercreation { Line 3855  sub modify_usercreation {
                 foreach my $type (@{$changes{'cancreate'}}) {                  foreach my $type (@{$changes{'cancreate'}}) {
                     my $chgtext =  $lt{$type}.', ';                      my $chgtext =  $lt{$type}.', ';
                     if ($type eq 'selfcreate') {                      if ($type eq 'selfcreate') {
                         if ($cancreate{$type} eq 'none') {                          if (@{$cancreate{$type}} == 0) {
                             $chgtext .= &mt('creation of a new user account is not permitted.');                              $chgtext .= &mt('creation of a new user account is not permitted.');
                         } elsif ($cancreate{$type} eq 'any') {                          } else {
                             $chgtext .= &mt('creation of a new account is permitted for users authenticated by institutional log-in and SSO, and also for e-mail addresses used as usernames.');                              $chgtext .= &mt('creation of a new account is permitted for:<ul>');
                         } elsif ($cancreate{$type} eq 'login') {                              foreach my $case (@{$cancreate{$type}}) {
                             $chgtext .= &mt('creation of a new account is only permitted for users authenticated by institutional log-in.');                                  $chgtext .= '<li>'.$selfcreatetypes{$case}.'</li>';
                         } elsif ($cancreate{$type} eq 'sso') {                              }
                             $chgtext .= &mt('creation of a new account is only permitted for users authenticated by institutional single sign on.');                              $chgtext .= '</ul>';
                         } elsif ($cancreate{$type} eq 'email') {  
                             $chgtext .= &mt('creation of a new account is only permitted for users who provide a valid e-mail address for use as the username.');  
                         }                          }
                     } else {                      } else {
                         if ($cancreate{$type} eq 'none') {                          if ($cancreate{$type} eq 'none') {
Line 3609  sub modify_defaults { Line 4150  sub modify_defaults {
     return $resulttext;      return $resulttext;
 }  }
   
   sub modify_scantron {
       my ($r,$dom,$confname,%domconfig) = @_;
       my ($resulttext,%confhash,%changes,$errors);
       my $custom = 'custom.tab';
       my $default = 'default.tab';
       my $servadm = $r->dir_config('lonAdmEMail');
       my ($configuserok,$author_ok,$switchserver) = 
           &config_check($dom,$confname,$servadm);
       if ($env{'form.scantronformat.filename'} ne '') {
           my $error;
           if ($configuserok eq 'ok') {
               if ($switchserver) {
                   $error = &mt("Upload of scantron format file is not permitted to this server: [_1]",$switchserver);
               } else {
                   if ($author_ok eq 'ok') {
                       my ($result,$scantronurl) =
                           &publishlogo($r,'upload','scantronformat',$dom,
                                        $confname,'scantron','','',$custom);
                       if ($result eq 'ok') {
                           $confhash{'scantron'}{'scantronformat'} = $scantronurl;
                           $changes{'scantronformat'} = 1;
                       } else {
                           $error = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$custom,$result);
                       }
                   } else {
                       $error = &mt("Upload of [_1] failed because an author role could not be assigned to a Domain Configuration user ([_2]) in domain: [_3].  Error was: [_4].",$custom,$confname,$dom,$author_ok);
                   }
               }
           } else {
               $error = &mt("Upload of [_1] failed because a Domain Configuration user ([_2]) could not be created in domain: [_3].  Error was: [_4].",$custom,$confname,$dom,$configuserok);
           }
           if ($error) {
               &Apache::lonnet::logthis($error);
               $errors .= '<li><span class="LC_error">'.$error.'</span></li>';
           }
       }
       if (ref($domconfig{'scantron'}) eq 'HASH') {
           if ($domconfig{'scantron'}{'scantronformat'} ne '') {
               if ($env{'form.scantronformat_del'}) {
                   $confhash{'scantron'}{'scantronformat'} = '';
                   $changes{'scantronformat'} = 1;
               }
           }
       }
       if (keys(%confhash) > 0) {
           my $putresult = &Apache::lonnet::put_dom('configuration',\%confhash,
                                                    $dom);
           if ($putresult eq 'ok') {
               if (keys(%changes) > 0) {
                   if (ref($confhash{'scantron'}) eq 'HASH') {
                       $resulttext = &mt('Changes made:').'<ul>';
                       if ($confhash{'scantron'}{'scantronformat'} eq '') {
                           $resulttext .= '<li>'.&mt('[_1] scantron format file removed; [_2] file will be used for courses in this domain.',$custom,$default).'</li>';
                       } else {
                           $resulttext .= '<li>'.&mt('Custom scantron format file ([_1]) uploaded for use with courses in this domain.',$custom).'</li>';
                       }
                       $resulttext .= '</ul>';
                   } else {
                       $resulttext = &mt('Changes made to scantron format file.');
                   }
                   $resulttext .= '</ul>';
                   &Apache::loncommon::devalidate_domconfig_cache($dom);
               } else {
                   $resulttext = &mt('No changes made to scantron format file');
               }
           } else {
               $resulttext = '<span class="LC_error">'.
                   &mt('An error occurred: [_1]',$putresult).'</span>';
           }
       } else {
           $resulttext = &mt('No changes made to scantron format file'); 
       }
       if ($errors) {
           $resulttext .= &mt('The following errors occurred: ').'<ul>'.
                          $errors.'</ul>';
       }
       return $resulttext;
   }
   
   sub modify_coursecategories {
       my ($dom,%domconfig) = @_;
       my ($resulttext,%deletions,%reorderings,%needreordering,%adds,$errors);
       my @deletecategory = &Apache::loncommon::get_env_multiple('form.deletecategory');
       if (($domconfig{'coursecategories'}{'instcode::0'} ne '')  && ($env{'form.instcode'} == 0)) {
           push (@deletecategory,'instcode::0');
       }
       my (@predelcats,@predeltrails,%predelallitems);
       if (ref($domconfig{'coursecategories'}) eq 'HASH') {
           if (@deletecategory > 0) {
               #FIXME Need to remove category from all courses using a deleted category 
               &Apache::loncommon::extract_categories($domconfig{'coursecategories'},\@predelcats,\@predeltrails,\%predelallitems);
               foreach my $item (@deletecategory) {
                   if ($domconfig{'coursecategories'}{$item} ne '') {
                       delete($domconfig{'coursecategories'}{$item});
                       $deletions{$item} = 1;
                       &recurse_cat_deletes($item,$domconfig{'coursecategories'},
                                            \%deletions);
                   }
               }
           }
           foreach my $item (keys(%{$domconfig{'coursecategories'}})) {
               my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
               if ($domconfig{'coursecategories'}{$item} ne $env{'form.'.$item}) {
                   $reorderings{$item} = 1;
                   $domconfig{'coursecategories'}{$item} = $env{'form.'.$item};
               }
               if ($env{'form.addcategory_name_'.$item} ne '') {
                   my $newcat = $env{'form.addcategory_name_'.$item};
                   my $newdepth = $depth+1;
                   my $newitem = &escape($newcat).':'.&escape($cat).':'.$newdepth;
                   $domconfig{'coursecategories'}{$newitem} = $env{'form.addcategory_pos_'.$item};
                   $adds{$newitem} = 1; 
               }
               if ($env{'form.subcat_'.$item} ne '') {
                   my $newcat = $env{'form.subcat_'.$item};
                   my $newdepth = $depth+1;
                   my $newitem = &escape($newcat).':'.&escape($cat).':'.$newdepth;
                   $domconfig{'coursecategories'}{$newitem} = 0;
                   $adds{$newitem} = 1;
               }
           }
       }
       if ($env{'form.instcode'} eq '1') {
           if (ref($domconfig{'coursecategories'}) eq 'HASH') {
               my $newitem = 'instcode::0';
               if ($domconfig{'coursecategories'}{$newitem} eq '') {  
                   $domconfig{'coursecategories'}{$newitem} = $env{'form.instcode_pos'};
                   $adds{$newitem} = 1;
               }
           } else {
               my $newitem = 'instcode::0';
               $domconfig{'coursecategories'}{$newitem} = $env{'form.instcode_pos'};
               $adds{$newitem} = 1;
           }
       }
       if ($env{'form.addcategory_name'} ne '') {
           my $newitem = &escape($env{'form.addcategory_name'}).'::0';
           $domconfig{'coursecategories'}{$newitem} = $env{'form.addcategory_pos'};
           $adds{$newitem} = 1;
       }
       if ((keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) {
           my %sort_by_deltrail;
           if (keys(%deletions) > 0) {
               foreach my $key (keys(%deletions)) {
                   if ($predelallitems{$key} ne '') {
                       $sort_by_deltrail{$predelallitems{$key}} = $predeltrails[$predelallitems{$key}];
                   }
               }
           }
           my (@chkcats,@chktrails,%chkallitems);
           &Apache::loncommon::extract_categories($domconfig{'coursecategories'},\@chkcats,\@chktrails,\%chkallitems);
           if (ref($chkcats[0]) eq 'ARRAY') {
               my $depth = 0;
               my $chg = 0;
               for (my $i=0; $i<@{$chkcats[0]}; $i++) {
                   my $name = $chkcats[0][$i];
                   my $item;
                   if ($name eq '') {
                       $chg ++;
                   } else {
                       $item = &escape($name).'::0';
                       if ($chg) {
                           $domconfig{'coursecategories'}{$item} -= $chg;
                       }
                       $depth ++; 
                       &recurse_check(\@chkcats,$domconfig{'coursecategories'},$depth,$name);
                       $depth --;
                   }
               }
           }
           my $putresult = &Apache::lonnet::put_dom('configuration',\%domconfig,$dom);
           my (@cats,@trails,%allitems);
           &Apache::loncommon::extract_categories($domconfig{'coursecategories'},\@cats,\@trails,\%allitems);
           if ($putresult eq 'ok') {
               $resulttext = &mt('Changes made:').'<ul>';
               if (keys(%deletions) > 0) {
                   $resulttext .= '<li>'.&mt('Deleted categories:').'<ul>';
                   foreach my $predeltrail (sort {$a <=> $b } (keys(%sort_by_deltrail))) { 
                       $resulttext .= '<li>'.$predeltrails[$predeltrail].'</li>';
                   }
                   $resulttext .= '</ul></li>';
               }
               if (keys(%reorderings) > 0) {
                   my %sort_by_trail;
                   $resulttext .= '<li>'.&mt('Reordered categories:').'<ul>';
                   foreach my $key (keys(%reorderings)) {
                       if ($allitems{$key} ne '') {
                           $sort_by_trail{$allitems{$key}} = $trails[$allitems{$key}];
                       }
                   }
                   foreach my $trail (sort {$a <=> $b } (keys(%sort_by_trail))) {
                       $resulttext .= '<li>'.$trails[$trail].'</li>';
                   }
                   $resulttext .= '</ul></li>';
               }
               if (keys(%adds) > 0) {
                   my %sort_by_trail;
                   $resulttext .= '<li>'.&mt('Added categories:').'<ul>';
                   foreach my $key (keys(%adds)) {
                       if ($allitems{$key} ne '') {
                           $sort_by_trail{$allitems{$key}} = $trails[$allitems{$key}];
                       }
                   }
                   foreach my $trail (sort {$a <=> $b } (keys(%sort_by_trail))) {
                       $resulttext .= '<li>'.$trails[$trail].'</li>';
                   }
                   $resulttext .= '</ul></li>';
               }
               $resulttext .= '</ul>';
           } else {
               $resulttext = '<span class="LC_error">'.
                   &mt('An error occurred: [_1]',$putresult).'</span>';
           }
       } else {
           $resulttext = &mt('No changes made to course categories');
       }
       return $resulttext;
   }
   
   sub recurse_check {
       my ($chkcats,$categories,$depth,$name) = @_;
       if (ref($chkcats->[$depth]{$name}) eq 'ARRAY') {
           my $chg = 0;
           for (my $j=0; $j<@{$chkcats->[$depth]{$name}}; $j++) {
               my $category = $chkcats->[$depth]{$name}[$j];
               my $item;
               if ($category eq '') {
                   $chg ++;
               } else {
                   my $deeper = $depth + 1;
                   $item = &escape($category).':'.&escape($name).':'.$depth;
                   if ($chg) {
                       $categories->{$item} -= $chg;
                   }
                   &recurse_check($chkcats,$categories,$deeper,$category);
                   $deeper --;
               }
           }
       }
       return;
   }
   
   sub recurse_cat_deletes {
       my ($item,$coursecategories,$deletions) = @_;
       my ($deleted,$container,$depth) = map { &unescape($_); } split(/:/,$item);
       my $subdepth = $depth + 1;
       if (ref($coursecategories) eq 'HASH') {
           foreach my $subitem (keys(%{$coursecategories})) {
               my ($child,$parent,$itemdepth) = map { &unescape($_); } split(/:/,$subitem);
               if (($parent eq $deleted) && ($itemdepth == $subdepth)) {
                   delete($coursecategories->{$subitem});
                   $deletions->{$subitem} = 1;
                   &recurse_cat_deletes($subitem,$coursecategories,$deletions);
               }  
           }
       }
       return;
   }
   
 1;  1;
Removed from v.1.45  
changed lines
  Added in v.1.53

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>