[LON-CAPA-cvs] cvs: loncom /interface loncommon.pm

raeburn lon-capa-cvs-allow@mail.lon-capa.org
Mon, 07 Jul 2008 15:10:24 -0000


raeburn		Mon Jul  7 11:10:24 2008 EDT

  Modified files:              
    /loncom/interface	loncommon.pm 
  Log:
  - &extract_categories() and &recurse_categories() take extra arg - subcats - to
    accumulate all subcategories (recursive) within a category.
  
  
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.664 loncom/interface/loncommon.pm:1.665
--- loncom/interface/loncommon.pm:1.664	Sun Jul  6 01:01:52 2008
+++ loncom/interface/loncommon.pm	Mon Jul  7 11:10:23 2008
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.664 2008/07/06 05:01:52 raeburn Exp $
+# $Id: loncommon.pm,v 1.665 2008/07/07 15:10:23 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -8340,6 +8340,9 @@
 jsarray (reference to array of categories used to create Javascript arrays for
          Domain Coordinator interface for editing Course Categories).
 
+subcats (reference to hash of arrays containing all subcategories within each 
+         category, -recursive)
+
 Returns: nothing
 
 Side effects: populates trails and allitems hash references.
@@ -8347,7 +8350,7 @@
 =cut
 
 sub extract_categories {
-    my ($categories,$cats,$trails,$allitems,$idx,$jsarray) = @_;
+    my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
     if (ref($categories) eq 'HASH') {
         &gather_categories($categories,$cats,$idx,$jsarray);
         if (ref($cats->[0]) eq 'ARRAY') {
@@ -8368,7 +8371,14 @@
                 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);
+                        if (ref($subcats) eq 'HASH') {
+                            push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
+                        }
+                        &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
+                    }
+                } else {
+                    if (ref($subcats) eq 'HASH') {
+                        $subcats->{$item} = [];
                     }
                 }
             }
@@ -8407,7 +8417,7 @@
 =cut
 
 sub recurse_categories {
-    my ($cats,$depth,$category,$trails,$allitems,$parents) = @_;
+    my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
     my $shallower = $depth - 1;
     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
@@ -8420,7 +8430,21 @@
             }
             my $deeper = $depth+1;
             push(@{$parents},$category);
-            &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents);
+            if (ref($subcats) eq 'HASH') {
+                my $subcat = &escape($name).':'.$category.':'.$depth;
+                for (my $j=@{$parents}; $j>=0; $j--) {
+                    my $higher;
+                    if ($j > 0) {
+                        $higher = &escape($parents->[$j]).':'.
+                                  &escape($parents->[$j-1]).':'.$j;
+                    } else {
+                        $higher = &escape($parents->[$j]).'::'.$j;
+                    }
+                    push(@{$subcats->{$higher}},$subcat);
+                }
+            }
+            &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
+                                $subcats);
             pop(@{$parents});
         }
     } else {