[LON-CAPA-cvs] cvs: loncom /interface domainprefs.pm loncommon.pm
raeburn
lon-capa-cvs-allow@mail.lon-capa.org
Thu, 29 May 2008 02:58:41 -0000
This is a MIME encoded message
--raeburn1212029921
Content-Type: text/plain
raeburn Wed May 28 22:58:41 2008 EDT
Modified files:
/loncom/interface domainprefs.pm loncommon.pm
Log:
&gather_categories(), &extract_categories() and &recurse_categories() used in display of interface for adding hierarchy of categories and sub-categories for use in course ccatalog moved from domainprefs.pm to loncommon.pm to be more widely available.
--raeburn1212029921
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20080528225841.txt"
Index: loncom/interface/domainprefs.pm
diff -u loncom/interface/domainprefs.pm:1.51 loncom/interface/domainprefs.pm:1.52
--- loncom/interface/domainprefs.pm:1.51 Wed May 14 21:56:44 2008
+++ loncom/interface/domainprefs.pm Wed May 28 22:58:41 2008
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set domain-wide configuration settings
#
-# $Id: domainprefs.pm,v 1.51 2008/05/15 01:56:44 raeburn Exp $
+# $Id: domainprefs.pm,v 1.52 2008/05/29 02:58:41 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1962,7 +1962,8 @@
my $itemcount = 1;
if (ref($settings) eq 'HASH') {
my (@cats,@trails,%allitems,%idx,@jsarray);
- &extract_categories($settings,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
+ &Apache::loncommon::extract_categories($settings,\@cats,\@trails,
+ \%allitems,\%idx,\@jsarray);
my $maxdepth = scalar(@cats);
my $colattrib = '';
if ($maxdepth > 2) {
@@ -2067,7 +2068,7 @@
my ($output,$jstext);
if (ref($settings) eq 'HASH') {
my (@cats,@jsarray,%idx);
- &gather_categories($settings,\@cats,\%idx,\@jsarray);
+ &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++) {
@@ -4239,7 +4240,7 @@
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);
+ &Apache::loncommon::extract_categories($domconfig{'coursecategories'},\@predelcats,\@predeltrails,\%predelallitems);
foreach my $item (@deletecategory) {
if ($domconfig{'coursecategories'}{$item} ne '') {
delete($domconfig{'coursecategories'}{$item});
@@ -4299,7 +4300,7 @@
}
}
my (@chkcats,@chktrails,%chkallitems);
- &extract_categories($domconfig{'coursecategories'},\@chkcats,\@chktrails,\%chkallitems);
+ &Apache::loncommon::extract_categories($domconfig{'coursecategories'},\@chkcats,\@chktrails,\%chkallitems);
if (ref($chkcats[0]) eq 'ARRAY') {
my $depth = 0;
my $chg = 0;
@@ -4321,7 +4322,7 @@
}
my $putresult = &Apache::lonnet::put_dom('configuration',\%domconfig,$dom);
my (@cats,@trails,%allitems);
- &extract_categories($domconfig{'coursecategories'},\@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) {
@@ -4408,89 +4409,4 @@
return;
}
-sub gather_categories {
- my ($categories,$cats,$idx,$jsarray) = @_;
- my %counters;
- my $num = 0;
- 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;
- }
- my ($escitem,$tail) = split(/:/,$item,2);
- if ($counters{$tail} eq '') {
- $counters{$tail} = $num;
- $num ++;
- }
- if (ref($idx) eq 'HASH') {
- $idx->{$item} = $counters{$tail};
- }
- if (ref($jsarray) eq 'ARRAY') {
- push(@{$jsarray->[$counters{$tail}]},$item);
- }
- }
- return;
-}
-
-sub extract_categories {
- my ($categories,$cats,$trails,$allitems,$idx,$jsarray) = @_;
- if (ref($categories) eq 'HASH') {
- &gather_categories($categories,$cats,$idx,$jsarray);
- 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) = @_;
- my $shallower = $depth - 1;
- if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
- for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
- 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 {
- 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;
- }
- }
- return;
-}
-
1;
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.654 loncom/interface/loncommon.pm:1.655
--- loncom/interface/loncommon.pm:1.654 Tue May 27 18:26:11 2008
+++ loncom/interface/loncommon.pm Wed May 28 22:58:41 2008
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.654 2008/05/27 22:26:11 www Exp $
+# $Id: loncommon.pm,v 1.655 2008/05/29 02:58:41 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -7955,7 +7955,9 @@
origmail (scalar - email address of recipient from loncapa.conf,
i.e., predates configuration by DC via domainprefs.pm
-Returns: comma separated list of addresses to which to send e-mail.
+Returns: comma separated list of addresses to which to send e-mail.
+
+=back
=cut
@@ -8006,6 +8008,172 @@
############################################################
############################################################
+=pod
+
+=head1 Course Catalog Routines
+
+=over 4
+
+=item * &gather_categories()
+
+Converts category definitions - keys of categories hash stored in
+coursecategories in configuration.db on the primary library server in a
+domain - to an array. Also generates javascript and idx hash used to
+generate Domain Coordinator interface for editing Course Categories.
+
+Inputs:
+categories (reference to hash of category definitions).
+cats (reference to array of arrays/hashes which encapsulates hierarchy of
+ categories and subcategories).
+idx (reference to hash of counters used in Domain Coordinator interface for
+ editing Course Categories).
+jsarray (reference to array of categories used to create Javascript arrays for
+ Domain Coordinator interface for editing Course Categories).
+
+Returns: nothing
+
+Side effects: populates cats, idx and jsarray.
+
+=cut
+
+sub gather_categories {
+ my ($categories,$cats,$idx,$jsarray) = @_;
+ my %counters;
+ my $num = 0;
+ 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;
+ }
+ my ($escitem,$tail) = split(/:/,$item,2);
+ if ($counters{$tail} eq '') {
+ $counters{$tail} = $num;
+ $num ++;
+ }
+ if (ref($idx) eq 'HASH') {
+ $idx->{$item} = $counters{$tail};
+ }
+ if (ref($jsarray) eq 'ARRAY') {
+ push(@{$jsarray->[$counters{$tail}]},$item);
+ }
+ }
+ return;
+}
+
+=pod
+
+=item * &extract_categories()
+
+Used to generate breadcrumb trails for course categories.
+
+Inputs:
+categories (reference to hash of category definitions).
+cats (reference to array of arrays/hashes which encapsulates hierarchy of
+ categories and subcategories).
+trails (reference to array of breacrumb trails for each category).
+allitems (reference to hash - key is category key
+ (format: escaped(name):escaped(parent category):depth in hierarchy).
+idx (reference to hash of counters used in Domain Coordinator interface for
+ editing Course Categories).
+jsarray (reference to array of categories used to create Javascript arrays for
+ Domain Coordinator interface for editing Course Categories).
+
+Returns: nothing
+
+Side effects: populates trails and allitems hash references.
+
+=cut
+
+sub extract_categories {
+ my ($categories,$cats,$trails,$allitems,$idx,$jsarray) = @_;
+ if (ref($categories) eq 'HASH') {
+ &gather_categories($categories,$cats,$idx,$jsarray);
+ 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;
+}
+
+=pod
+
+=item *&recurse_categories()
+
+Recursively used to generate breadcrumb trails for course categories.
+
+Inputs:
+cats (reference to array of arrays/hashes which encapsulates hierarchy of
+ categories and subcategories).
+depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
+category (current course category, for which breadcrumb trail is being generated).
+trails (reference to array of breacrumb trails for each category).
+allitems (reference to hash - key is category key
+ (format: escaped(name):escaped(parent category):depth in hierarchy).
+parents (array containing containers directories for current category,
+ back to top level).
+
+Returns: nothing
+
+Side effects: populates trails and allitems hash references
+
+=back
+
+=cut
+
+sub recurse_categories {
+ my ($cats,$depth,$category,$trails,$allitems,$parents) = @_;
+ my $shallower = $depth - 1;
+ if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
+ for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
+ 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 {
+ 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;
+ }
+ }
+ return;
+}
+
+############################################################
+############################################################
+
+
sub commit_customrole {
my ($udom,$uname,$url,$three,$four,$five,$start,$end) = @_;
my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
--raeburn1212029921--