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

[matthew]

matthew		Tue Apr  9 14:41:11 2002 EDT

  Modified files:              
    /loncom/interface	lonspreadsheet.pm 
  Log:
  Added code to load in a spreadsheet from a file.  This code has not been
  successfully tested, but at things don't crash during normal operation.
  
  
Index: loncom/interface/lonspreadsheet.pm
diff -u loncom/interface/lonspreadsheet.pm:1.81 loncom/interface/lonspreadsheet.pm:1.82
--- loncom/interface/lonspreadsheet.pm:1.81	Mon Apr  8 14:28:03 2002
+++ loncom/interface/lonspreadsheet.pm	Tue Apr  9 14:41:11 2002
@@ -1,5 +1,5 @@
 #
-# $Id: lonspreadsheet.pm,v 1.81 2002/04/08 18:28:03 matthew Exp $
+# $Id: lonspreadsheet.pm,v 1.82 2002/04/09 18:41:11 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1149,6 +1149,35 @@
     return @alternatives; 
 }
 
+
+#
+# -------------------------------------- Parse a spreadsheet
+# 
+sub parse_sheet {
+    # $sheetxml is a scalar reference or a scalar
+    my ($sheetxml) = @_;
+    if (! ref($sheetxml)) {
+        my $tmp = $sheetxml;
+        $sheetxml = \$tmp;
+    }
+    my %f;
+    my $parser=HTML::TokeParser->new($sheetxml);
+    my $token;
+    while ($token=$parser->get_token) {
+        if ($token->[0] eq 'S') {
+            if ($token->[1] eq 'field') {
+                $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
+                    $parser->get_text('/field');
+            }
+            if ($token->[1] eq 'template') {
+                $f{'template_'.$token->[2]->{'col'}}=
+                    $parser->get_text('/template');
+            }
+        }
+    }
+    return \%f;
+}
+
 #
 # -------------------------------------- Read spreadsheet formulas for a course
 #
@@ -1160,18 +1189,33 @@
   my $cdom=&getcdom($safeeval);
   my $chome=&getchome($safeeval);
 
-# --------- There is no filename. Look for defaults in course and global, cache
-
-  unless($fn) {
+  if (! defined($fn) || $fn eq '') {
+      # There is no filename. Look for defaults in course and global, cache
       unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {
-         $fn=&Apache::lonnet::reply('get:'.$cdom.':'.$cnum.
-                                    ':environment:spreadsheet_default_'.$stype,
-                                    $chome);
-         unless (($fn) && ($fn!~/^error\:/)) {
-	     $fn='default_'.$stype;
-         }
-         $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 
+          my %tmphash = &Apache::lonnet::get('environment',
+                                             ['spreadsheet_default_'.$stype],
+                                             $cdom,$cnum);
+          my ($tmp) = keys(%tmphash);
+          if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
+              $fn = 'default_'.$stype;
+          } else {
+              $fn = $tmphash{'spreadsheet_default_'.$stype};
+          } 
+          $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 
+      }
+  } else {
+      # We do have a filename, do a get on it.
+      my %tmphash = &Apache::lonnet::get('environment',
+                                         [$fn],
+                                         $cdom,$cnum);
+      my ($tmp) = keys(%tmphash);
+      if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
+          # On error, grab the default filename
+          $fn = 'default_'.$stype;
+      } else {
+          $fn = $tmphash{$fn};
       }
+      $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 
   }
 
 # ---------------------------------------------------------- fn now has a value
@@ -1189,41 +1233,45 @@
      my %f=();
 
      if ($fn=~/^default\_/) {
-	my $sheetxml='';
-       {
+         my $sheetxml='';
          my $fh;
          my $dfn=$fn;
          $dfn=~s/\_/\./g;
          if ($fh=Apache::File->new($includedir.'/'.$dfn)) {
-               $sheetxml=join('',<$fh>);
-	 } else {
+             $sheetxml=join('',<$fh>);
+         } else {
              $sheetxml='<field row="0" col="A">"Error"</field>';
-	 }
-       }
-        my $parser=HTML::TokeParser->new(\$sheetxml);
-        my $token;
-        while ($token=$parser->get_token) {
-          if ($token->[0] eq 'S') {
- 	     if ($token->[1] eq 'field') {
- 		 $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
- 		     $parser->get_text('/field');
- 	     }
-             if ($token->[1] eq 'template') {
-                 $f{'template_'.$token->[2]->{'col'}}=
-                     $parser->get_text('/template');
+         }
+         %f=&parse_sheet(\$sheetxml);
+     } elsif($fn=~/\/*\.spreadsheet$/) {
+         my $sheetxml='';
+         my $fh;
+         my $dfn=$fn;
+         $dfn=~s/\_/\./g;
+
+         if ($fn !~ /^$Apache::lonnet::perlvar{'lonDocRoot'}\/res/) {
+             $fn = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res'.$fn;
+         }
+         if ($fn !~ /^$Apache::lonnet::perlvar{'lonDocRoot'}/) {
+             $fn = $Apache::lonnet::perlvar{'lonDocRoot'}.$fn;
+         }
+         if ($fh=Apache::File->new($fn)) {
+             $sheetxml=join('',<$fh>);
+         } else {
+             $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
+                 .$fn.'"</field>';
+         }
+         %f=&parse_sheet(\$sheetxml);
+     } else {
+         my $sheet='';
+         my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
+         my ($tmp) = keys(%tmphash);
+         unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
+             foreach (keys(%tmphash)) {
+                 $f{$_}=$tmphash{$_};
              }
-          }
-        }
-      } else {
-          my $sheet='';
-          my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
-          my ($tmp) = keys(%tmphash);
-          unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
-              foreach (keys(%tmphash)) {
-                  $f{$_}=$tmphash{$_};
-              }
-          }
-      }
+         }
+     }
 # --------------------------------------------------------------- Cache and set
        $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);  
        &setformulas($safeeval,%f);