--- loncom/interface/domainprefs.pm 2008/05/01 00:01:16 1.47 +++ loncom/interface/domainprefs.pm 2008/05/07 23:01:50 1.48 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: domainprefs.pm,v 1.47 2008/05/01 00:01:16 raeburn Exp $ +# $Id: domainprefs.pm,v 1.48 2008/05/07 23:01:50 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,7 +37,7 @@ use Apache::loncommon(); use Apache::lonhtmlcommon(); use Apache::lonlocal; use Apache::lonmsg(); -use LONCAPA(); +use LONCAPA; use LONCAPA::Enrollment; use File::Copy; use Locale::Language; @@ -70,11 +70,12 @@ sub handler { my %domconfig = &Apache::lonnet::get_dom('configuration',['login','rolecolors', 'quotas','autoenroll','autoupdate','directorysrch', - 'usercreation','usermodification','contacts','defaults','scantron'], - $dom); + 'usercreation','usermodification','contacts','defaults', + 'scantron','coursecategories'],$dom); my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll', 'autoupdate','directorysrch','contacts', - 'usercreation','usermodification','scantron'); + 'usercreation','usermodification','scantron', + 'coursecategories'); my %prefs = ( 'rolecolors' => { text => 'Default color schemes', @@ -158,6 +159,13 @@ sub handler { col2 => '', }], }, + 'coursecategories' => + { text => 'Cataloging of courses', + help => 'Domain_Course_Catalog', + header => [ {col1 => 'Categories', + col2 => '', + }], + } ); my @roles = ('student','coordinator','author','admin'); my @actions = &Apache::loncommon::get_env_multiple('form.actions'); @@ -316,9 +324,9 @@ sub handler { $r->print('

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

'."\n". '

'.&mt('Display using: ')."\n". - '  '. - ''. + '  

'); $r->print(&print_footer($r,$phase,'display','Go')); $r->print(''); @@ -352,7 +360,9 @@ sub process_changes { } elsif ($action eq 'defaults') { $output = &modify_defaults($dom,$r); } elsif ($action eq 'scantron') { - $output = &modify_scantron($r,$dom,$confname,\%domconfig); + $output = &modify_scantron($r,$dom,$confname,%domconfig); + } elsif ($action eq 'coursecategories') { + $output = &modify_coursecategories($dom,%domconfig); } return $output; } @@ -460,10 +470,11 @@ sub print_config_box { $output .= ' '.$item->{'header'}->[0]->{'col1'}.''; } + my $colspan = ($action eq 'coursecategories')?' colspan="2"':''; $output .= ' - '.$item->{'header'}->[0]->{'col2'}.' + '.$item->{'header'}->[0]->{'col2'}.' '; - $rowtotal ++; + $rowtotal ++; if ($action eq 'login') { $output .= &print_login($dom,$confname,$phase,$settings,\$rowtotal); } elsif ($action eq 'quotas') { @@ -478,6 +489,8 @@ sub print_config_box { $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 .= ' @@ -498,7 +511,7 @@ function changePage(formname,newphase) { numchecked = 0; if (formname == document.pickactions) { if (formname.actions.length > 0) { - for (var i = 0; i 'None', ); return %lt; -} +} sub authtype_names { my %lt = &Apache::lonlocal::texthash( @@ -1922,6 +1935,208 @@ sub legacy_scantronformat { return ($url,$error); } +sub print_coursecategories { + my ($dom,$item,$settings,$rowtotal) = @_; + my ($datatable,$css_class); + my $itemcount = 1; + # FIXME Need to add javascrpt to update other select boxes when one is changed. + if (ref($settings) eq 'HASH') { + my (@cats,@trails,%allitems); + &extract_categories($settings,\@cats,\@trails,\%allitems); + 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 ++; + } + 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'; + $datatable .= '' + .''; + if ($parent eq 'instcode') { + $datatable .= ''.&mt('Official courses') + .'
(' + .&mt('with institutional codes').')' + .' ' + .''; + } else { + $datatable .= $parent + .' '; + } + my $depth = 1; + push(@path,$parent); + $datatable .= &build_category_rows($itemcount,\@cats,$depth,$parent,\@path); + pop(@path); + $datatable .= ''; + $itemcount ++; + } + $css_class = $itemcount%2?' class="LC_odd_row"':''; + $datatable .= ''.&mt('New:').' ' + .'' + .''."\n"; + $itemcount ++; + if ((!grep(/^instcode$/,@{$cats[0]})) || ($settings->{'instcode::0'} eq '')) { + $css_class = $itemcount%2?' class="LC_odd_row"':''; + $datatable .= ''. + '' + .&mt('Official courses').''.'
(' + .&mt('with institutional codes').')' + .' ' + .''; + } + } + } else { + $datatable .= &initialize_categories($itemcount); + } + } else { + $datatable .= ''.$item->{'header'}->[0]->{'col2'}.'' + .&initialize_categories($itemcount); + } + $$rowtotal += $itemcount; + return $datatable; +} + +sub initialize_categories { + my ($itemcount) = @_; + my $datatable; + my $css_class = $itemcount%2?' class="LC_odd_row"':''; + $datatable = '' + .' ' + .&mt('Official courses (with institutional codes)') + .'' + .' '; + $itemcount ++; + $css_class = $itemcount%2?' class="LC_odd_row"':''; + $datatable .= '' + .' ' + .&mt('Add category').''.&mt('Name:') + .' '; + return $datatable; +} + +sub build_category_rows { + my ($itemcount,$cats,$depth,$parent,$path) = @_; + my ($text,$name,$item); + 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 .= ''; + for (my $j=0; $j<=$numchildren; $j++) { + if ($j == $numchildren) { + my $higher = $depth-1; + if ($higher == 0) { + $name = &escape($parent).'::'.$higher; + } else { + if (ref($path) eq 'ARRAY') { + $name = &escape($parent).':'.&escape($path->[-2]).':'.$higher; + } + } + $item = 'addcategory_pos_'.$name; + } else { + $name = $cats->[$depth]{$parent}[$j]; + $item = &escape($name).':'.&escape($parent).':'.$depth; + } + $text .= ''; + } + $text .= '
 '; + if ($j < $numchildren) { + my $deeper = $depth+1; + $text .= $name.' ' + .''; + if(ref($path) eq 'ARRAY') { + push(@{$path},$name); + $text .= &build_category_rows($itemcount,$cats,$deeper,$name,$path); + pop(@{$path}); + } + } else { + $text .= &mt('New:').' '; + } + $text .= '
'; + } 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 .= ''.&mt('Add subcategory:').''; + } + } + } + } + return $text; +} + sub modifiable_userdata_row { my ($context,$role,$settings,$numinrow,$rowcount) = @_; my $rolename; @@ -2438,7 +2653,7 @@ sub default_change_checker { if ($confhash->{$role}{'font'}) { $changes->{$role}{'font'} = 1; } -} +} sub display_colorchgs { my ($dom,$changes,$roles,$confhash) = @_; @@ -3753,7 +3968,7 @@ sub modify_defaults { } sub modify_scantron { - my ($r,$dom,$confname,$domconfig) = @_; + my ($r,$dom,$confname,%domconfig) = @_; my ($resulttext,%confhash,%changes,$errors); my $custom = 'custom.tab'; my $default = 'default.tab'; @@ -3772,7 +3987,7 @@ sub modify_scantron { $confname,'scantron','','',$custom); if ($result eq 'ok') { $confhash{'scantron'}{'scantronformat'} = $scantronurl; - $changes{'scantron'}{'scantronformat'} = 1; + $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); } @@ -3788,13 +4003,11 @@ sub modify_scantron { $errors .= '
  • '.$error.'
    • '; } } - if (ref($domconfig) eq 'HASH') { - if (ref($domconfig->{'scantron'}) eq 'HASH') { - if ($domconfig->{'scantron'}{'scantronformat'} ne '') { - if ($env{'form.scantronformat_del'}) { - $confhash{'scantron'}{'scantronformat'} = ''; - $changes{'scantron'}{'scantronformat'} = 1; - } + if (ref($domconfig{'scantron'}) eq 'HASH') { + if ($domconfig{'scantron'}{'scantronformat'} ne '') { + if ($env{'form.scantronformat_del'}) { + $confhash{'scantron'}{'scantronformat'} = ''; + $changes{'scantronformat'} = 1; } } } @@ -3803,15 +4016,16 @@ sub modify_scantron { $dom); if ($putresult eq 'ok') { if (keys(%changes) > 0) { - $resulttext = &mt('Changes made:').''; &Apache::loncommon::devalidate_domconfig_cache($dom); @@ -3832,4 +4046,251 @@ sub modify_scantron { 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 + &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); + &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); + &extract_categories($domconfig{'coursecategories'},\@cats,\@trails,\%allitems); + if ($putresult eq 'ok') { + $resulttext = &mt('Changes made:').''; + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + } 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; +} + +sub extract_categories { + my ($categories,$cats,$trails,$allitems) = @_; + if (ref($categories) eq 'HASH') { + foreach my $item (keys(%{$categories})) { + my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item); + if ($container eq '' && $depth == 0) { + $cats->[$depth][$categories->{$item}] = $cat; + } else { + $cats->[$depth]{$container}[$categories->{$item}] = $cat; + } + } + if (ref($cats->[0]) eq 'ARRAY') { + for (my $i=0; $i<@{$cats->[0]}; $i++) { + my $name = $cats->[0][$i]; + my $item = &escape($name).'::0'; + my $trailstr; + if ($name eq 'instcode') { + $trailstr = &mt('Official courses (with institutional codes)'); + } else { + $trailstr = $name; + } + if ($allitems->{$item} eq '') { + push(@{$trails},$trailstr); + $allitems->{$item} = scalar(@{$trails})-1; + } + my @parents = ($name); + if (ref($cats->[1]{$name}) eq 'ARRAY') { + for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) { + my $category = $cats->[1]{$name}[$j]; + &recurse_categories($cats,2,$category,$trails,$allitems,\@parents); + } + } + } + } + } + return; +} + +sub recurse_categories { + my ($cats,$depth,$category,$trails,$allitems,$parents) = @_; + if (ref($cats->[$depth]{$category}) eq 'ARRAY') { + for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) { + my $shallower = $depth - 1; + my $name = $cats->[$depth]{$category}[$k]; + my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower; + my $trailstr = join(' -> ',(@{$parents},$category)); + if ($allitems->{$item} eq '') { + push(@{$trails},$trailstr); + $allitems->{$item} = scalar(@{$trails})-1; + } + my $deeper = $depth+1; + push(@{$parents},$category); + &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents); + pop(@{$parents}); + } + } else { + $depth --; + my $item = &escape($category).':'.&escape($parents->[-1]).':'.$depth; + my $trailstr = join(' -> ',(@{$parents},$category)); + if ($allitems->{$item} eq '') { + push(@{$trails},$trailstr); + $allitems->{$item} = scalar(@{$trails})-1; + } + } + return; +} + 1;