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

[bowersj2]

bowersj2		Wed May 14 14:01:16 2003 EDT

  Modified files:              
    /loncom/interface	lonnavmaps.pm 
  Log:
  First cut at storing response types and response ids. 
  
  I doubt this is completely right, but it's probably 80-90%, so I thought I'd 
  commit it so people looking for this can tell me what's wrong.
  
  
Index: loncom/interface/lonnavmaps.pm
diff -u loncom/interface/lonnavmaps.pm:1.186 loncom/interface/lonnavmaps.pm:1.187
--- loncom/interface/lonnavmaps.pm:1.186	Mon May 12 15:22:39 2003
+++ loncom/interface/lonnavmaps.pm	Wed May 14 14:01:16 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Navigate Maps Handler
 #
-# $Id: lonnavmaps.pm,v 1.186 2003/05/12 19:22:39 bowersj2 Exp $
+# $Id: lonnavmaps.pm,v 1.187 2003/05/14 18:01:16 bowersj2 Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3097,6 +3097,15 @@
 B<parts> may return an array with fewer parts in it then countParts
 might lead you to believe.
 
+=item * B<responseType>($part):
+
+Returns the response type of the part, without the word "response" on the
+end. Example return values: 'string', 'essay', 'numeric', etc.
+
+=item * B<responseId>($part):
+
+Retreives the response ID for the given part, which may be an empty string.
+
 =back
 
 =cut
@@ -3126,16 +3135,24 @@
     return scalar(@{$parts}) + $delta;
 }
 
-sub partType {
+sub responseType {
     my $self = shift;
     my $part = shift;
 
     $self->extractParts();
-    return $self->{PART_TYPE}->{$part};
+    return $self->{RESPONSE_TYPE}->{$part};
+}
+
+sub responseId {
+    my $self = shift;
+    my $part = shift;
+
+    $self->extractParts();
+    return $self->{RESPONSE_IDS}->{$part};
 }
 
 # Private function: Extracts the parts information, both part names and
-# part types, and saves it
+# part types, and saves it. 
 sub extractParts { 
     my $self = shift;
     
@@ -3149,6 +3166,7 @@
     # Retrieve part count, if this is a problem
     if ($self->is_problem()) {
         my $metadata = &Apache::lonnet::metadata($self->src(), 'packages');
+        print $metadata;
         if (!$metadata) {
             $self->{RESOURCE_ERROR} = 1;
             $self->{PARTS} = [];
@@ -3174,6 +3192,40 @@
         
         my @sortedParts = sort keys %parts;
         $self->{PARTS} = \@sortedParts;
+
+        my %responseIdHash;
+        my %responseTypeHash;
+
+        # Now, the unfortunate thing about this is that parts, part name, and
+        # response if are delimited by underscores, but both the part
+        # name and response id can themselves have underscores in them.
+        # So we have to use our knowlege of part names to figure out 
+        # where the part names begin and end, and even then, it is possible
+        # to construct ambiguous situations.
+        foreach (split /,/, $metadata) {
+            if ($_ =~ /^([a-zA-Z]+)response_(.*)/) {
+                my $responseType = $1;
+                my $partStuff = $2;
+                my $partIdSoFar = '';
+                my @partChunks = split /_/, $partStuff;
+                my $i = 0;
+
+                for ($i = 0; $i < scalar(@partChunks); $i++) {
+                    if ($partIdSoFar) { $partIdSoFar .= '_'; }
+                    $partIdSoFar .= $partChunks[$i];
+                    if ($parts{$partIdSoFar}) {
+                        my @otherChunks = @partChunks[$i+1..$#partChunks];
+                        my $responseId = join('_', @otherChunks);
+                        $responseIdHash{$partIdSoFar} = $responseId;
+                        $responseTypeHash{$partIdSoFar} = $responseType;
+                        last;
+                    }
+                }
+            }
+        }
+
+        $self->{RESPONSE_IDS} = \%responseIdHash;
+        $self->{RESPONSE_TYPES} = \%responseTypeHash;
     }
 
     return;