[BACK]Return to lonspreadsheet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/Attic/lonspreadsheet.pm between versions 1.79 and 1.96

version 1.79, 2002/01/22 10:05:24 version 1.96, 2002/07/05 21:44:50
Line 34 Line 34
 # 07/09,07/14,07/21,09/01,09/10,9/11,9/12,9/13,9/14,9/17,  # 07/09,07/14,07/21,09/01,09/10,9/11,9/12,9/13,9/14,9/17,
 # 10/16,10/17,10/20,11/05,11/28,12/27 Gerd Kortemeyer  # 10/16,10/17,10/20,11/05,11/28,12/27 Gerd Kortemeyer
 # 01/14/02 Matthew  # 01/14/02 Matthew
   # 02/04/02 Matthew
   
   # POD required stuff:
   
   =head1 NAME
   
   lonspreadsheet
   
   =head1 SYNOPSIS
   
   Spreadsheet interface to internal LON-CAPA data
   
   =head1 DESCRIPTION
   
   Lonspreadsheet provides course coordinators the ability to manage their
   students grades online.  The students are able to view their own grades, but
   not the grades of their peers.  The spreadsheet is highly customizable,
   offering the ability to use Perl code to manipulate data, as well as many
   built-in functions.
   
   
   =head2 Functions available to user of lonspreadsheet
   
   =over 4
   
   =cut
   
 package Apache::lonspreadsheet;  package Apache::lonspreadsheet;
                           
Line 80  my %courseopt; Line 106  my %courseopt;
 my %useropt;  my %useropt;
 my %parmhash;  my %parmhash;
   
   #
   # Some hashes for stats on timing and performance
   #
   
   my %starttimes;
   my %usedtimes;
   my %numbertimes;
   
 # Stuff that only the screen handler can know  # Stuff that only the screen handler can know
   
 my $includedir;  my $includedir;
Line 96  sub initsheet { Line 130  sub initsheet {
     $safeeval->permit("sort");      $safeeval->permit("sort");
     $safeeval->deny(":base_io");      $safeeval->deny(":base_io");
     $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');      $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
       $safeeval->share('$@');
     my $code=<<'ENDDEFS';      my $code=<<'ENDDEFS';
 # ---------------------------------------------------- Inside of the safe space  # ---------------------------------------------------- Inside of the safe space
   
Line 139  $cfn=''; Line 174  $cfn='';
   
 $usymb='';  $usymb='';
   
   # error messages
   
   $errormsg='';
   
 sub mask {  sub mask {
     my ($lower,$upper)=@_;      my ($lower,$upper)=@_;
   
Line 215  sub mask { Line 254  sub mask {
     return '^'.$alpha.$num."\$";      return '^'.$alpha.$num."\$";
 }  }
   
   #-------------------------------------------------------
   
   =item UWCALC(hashname,modules,units,date) 
   
   returns the proportion of the module 
   weights not previously completed by the student.
   
   =over 4
   
   =item hashname 
   
   name of the hash the module dates have been inserted into
   
   =item modules 
   
   reference to a cell which contains a comma deliminated list of modules 
   covered by the assignment.
   
   =item units 
   
   reference to a cell which contains a comma deliminated list of module 
   weights with respect to the assignment
   
   =item date 
   
   reference to a cell which contains the date the assignment was completed.
   
   =back 
   
   =cut
   
   #-------------------------------------------------------
   sub UWCALC {
       my ($hashname,$modules,$units,$date) = @_;
       my @Modules = split(/,/,$modules);
       my @Units   = split(/,/,$units);
       my $total_weight;
       foreach (@Units) {
    $total_weight += $_;
       }
       my $usum=0;
       for (my $i=0; $i<=$#Modules; $i++) {
    if (&HASH($hashname,$Modules[$i]) eq $date) {
       $usum += $Units[$i];
    }
       }
       return $usum/$total_weight;
   }
   
   #-------------------------------------------------------
   
   =item CDLSUM(list) 
   
   returns the sum of the elements in a cell which contains
   a Comma Deliminate List of numerical values.
   'list' is a reference to a cell which contains a comma deliminated list.
   
   =cut
   
   #-------------------------------------------------------
   sub CDLSUM {
       my ($list)=@_;
       my $sum;
       foreach (split/,/,$list) {
    $sum += $_;
       }
       return $sum;
   }
   
   #-------------------------------------------------------
   
   =item CDLITEM(list,index) 
   
   returns the item at 'index' in a Comma Deliminated List.
   
   =over 4
   
   =item list
   
   reference to a cell which contains a comma deliminated list.
   
   =item index 
   
   the Perl index of the item requested (first element in list has
   an index of 0) 
   
   =back
   
   =cut
   
   #-------------------------------------------------------
   sub CDLITEM {
       my ($list,$index)=@_;
       my @Temp = split/,/,$list;
       return $Temp[$index];
   }
   
   #-------------------------------------------------------
   
   =item CDLHASH(name,key,value) 
   
   loads a comma deliminated list of keys into
   the hash 'name', all with a value of 'value'.
   
   =over 4
   
   =item name  
   
   name of the hash.
   
   =item key
   
   (a pointer to) a comma deliminated list of keys.
   
   =item value
   
   a single value to be entered for each key.
   
   =back
   
   =cut
   
   #-------------------------------------------------------
   sub CDLHASH {
       my ($name,$key,$value)=@_;
       my @Keys;
       my @Values;
       # Check to see if we have multiple $key values
       if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
    my $keymask = &mask($key);
    # Assume the keys are addresses
    my @Temp = grep /$keymask/,keys(%v);
    @Keys = $v{@Temp};
       } else {
    $Keys[0]= $key;
       }
       my @Temp;
       foreach $key (@Keys) {
    @Temp = (@Temp, split/,/,$key);
       }
       @Keys = @Temp;
       if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
    my $valmask = &mask($value);
    my @Temp = grep /$valmask/,keys(%v);
    @Values =$v{@Temp};
       } else {
    $Values[0]= $value;
       }
       $value = $Values[0];
       # Add values to hash
       for (my $i = 0; $i<=$#Keys; $i++) {
    my $key   = $Keys[$i];
    if (! exists ($hashes{$name}->{$key})) {
       $hashes{$name}->{$key}->[0]=$value;
    } else {
       my @Temp = sort(@{$hashes{$name}->{$key}},$value);
       $hashes{$name}->{$key} = \@Temp;
    }
       }
       return "hash '$name' updated";
   }
   
   #-------------------------------------------------------
   
   =item GETHASH(name,key,index) 
   
   returns the element in hash 'name' 
   reference by the key 'key', at index 'index' in the values list.
   
   =cut
   
   #-------------------------------------------------------
   sub GETHASH {
       my ($name,$key,$index)=@_;
       if (! defined($index)) {
    $index = 0;
       }
       if ($key =~ /^[A-z]\d+$/) {
    $key = $v{$key};
       }
       return $hashes{$name}->{$key}->[$index];
   }
   
   #-------------------------------------------------------
   
   =item CLEARHASH(name) 
   
   clears all the values from the hash 'name'
   
   =item CLEARHASH(name,key) 
   
   clears all the values from the hash 'name' associated with the given key.
   
   =cut
   
   #-------------------------------------------------------
   sub CLEARHASH {
       my ($name,$key)=@_;
       if (defined($key)) {
    if (exists($hashes{$name}->{$key})) {
       $hashes{$name}->{$key}=undef;
       return "hash '$name' key '$key' cleared";
    }
       } else {
    if (exists($hashes{$name})) {
       $hashes{$name}=undef;
       return "hash '$name' cleared";
    }
       }
       return "Error in clearing hash";
   }
   
   #-------------------------------------------------------
   
   =item HASH(name,key,value) 
   
   loads values into an internal hash.  If a key 
   already has a value associated with it, the values are sorted numerically.  
   
   =item HASH(name,key) 
   
   returns the 0th value in the hash 'name' associated with 'key'.
   
   =cut
   
   #-------------------------------------------------------
   sub HASH {
       my ($name,$key,$value)=@_;
       my @Keys;
       undef @Keys;
       my @Values;
       # Check to see if we have multiple $key values
       if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
    my $keymask = &mask($key);
    # Assume the keys are addresses
    my @Temp = grep /$keymask/,keys(%v);
    @Keys = $v{@Temp};
       } else {
    $Keys[0]= $key;
       }
       # If $value is empty, return the first value associated 
       # with the first key.
       if (! $value) {
    return $hashes{$name}->{$Keys[0]}->[0];
       }
       # Check to see if we have multiple $value(s) 
       if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
    my $valmask = &mask($value);
    my @Temp = grep /$valmask/,keys(%v);
    @Values =$v{@Temp};
       } else {
    $Values[0]= $value;
       }
       # Add values to hash
       for (my $i = 0; $i<=$#Keys; $i++) {
    my $key   = $Keys[$i];
    my $value = ($i<=$#Values ? $Values[$i] : $Values[0]);
    if (! exists ($hashes{$name}->{$key})) {
       $hashes{$name}->{$key}->[0]=$value;
    } else {
       my @Temp = sort(@{$hashes{$name}->{$key}},$value);
       $hashes{$name}->{$key} = \@Temp;
    }
       }
       return $Values[-1];
   }
   
   #-------------------------------------------------------
   
   =item NUM(range)
   
   returns the number of items in the range.
   
   =cut
   
   #-------------------------------------------------------
 sub NUM {  sub NUM {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $num= $#{@{grep(/$mask/,keys(%v))}}+1;      my $num= $#{@{grep(/$mask/,keys(%v))}}+1;
Line 234  sub BIN { Line 549  sub BIN {
 }  }
   
   
   #-------------------------------------------------------
   
   =item SUM(range)
   
   returns the sum of items in the range.
   
   =cut
   
   #-------------------------------------------------------
 sub SUM {  sub SUM {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $sum=0;      my $sum=0;
Line 243  sub SUM { Line 567  sub SUM {
     return $sum;         return $sum;   
 }  }
   
   #-------------------------------------------------------
   
   =item MEAN(range)
   
   compute the average of the items in the range.
   
   =cut
   
   #-------------------------------------------------------
 sub MEAN {  sub MEAN {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $sum=0; my $num=0;      my $sum=0; my $num=0;
Line 257  sub MEAN { Line 590  sub MEAN {
     }         }   
 }  }
   
   #-------------------------------------------------------
   
   =item STDDEV(range)
   
   compute the standard deviation of the items in the range.
   
   =cut
   
   #-------------------------------------------------------
 sub STDDEV {  sub STDDEV {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $sum=0; my $num=0;      my $sum=0; my $num=0;
Line 273  sub STDDEV { Line 615  sub STDDEV {
     return sqrt($sum/($num-1));          return sqrt($sum/($num-1));    
 }  }
   
   #-------------------------------------------------------
   
   =item PROD(range)
   
   compute the product of the items in the range.
   
   =cut
   
   #-------------------------------------------------------
 sub PROD {  sub PROD {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $prod=1;      my $prod=1;
Line 282  sub PROD { Line 633  sub PROD {
     return $prod;         return $prod;   
 }  }
   
   #-------------------------------------------------------
   
   =item MAX(range)
   
   compute the maximum of the items in the range.
   
   =cut
   
   #-------------------------------------------------------
 sub MAX {  sub MAX {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $max='-';      my $max='-';
Line 292  sub MAX { Line 652  sub MAX {
     return $max;         return $max;   
 }  }
   
   #-------------------------------------------------------
   
   =item MIN(range)
   
   compute the minimum of the items in the range.
   
   =cut
   
   #-------------------------------------------------------
 sub MIN {  sub MIN {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $min='-';      my $min='-';
Line 302  sub MIN { Line 671  sub MIN {
     return $min;         return $min;   
 }  }
   
   #-------------------------------------------------------
   
   =item SUMMAX(num,lower,upper)
   
   compute the sum of the largest 'num' items in the range from
   'lower' to 'upper'
   
   =cut
   
   #-------------------------------------------------------
 sub SUMMAX {  sub SUMMAX {
     my ($num,$lower,$upper)=@_;      my ($num,$lower,$upper)=@_;
     my $mask=mask($lower,$upper);      my $mask=mask($lower,$upper);
     my @inside=();      my @inside=();
     foreach (grep /$mask/,keys(%v)) {      foreach (grep /$mask/,keys(%v)) {
  $inside[$#inside+1]=$v{$_};   push (@inside,$v{$_});
     }      }
     @inside=sort(@inside);      @inside=sort(@inside);
     my $sum=0; my $i;      my $sum=0; my $i;
Line 317  sub SUMMAX { Line 696  sub SUMMAX {
     return $sum;         return $sum;   
 }  }
   
   #-------------------------------------------------------
   
   =item SUMMIN(num,lower,upper)
   
   compute the sum of the smallest 'num' items in the range from
   'lower' to 'upper'
   
   =cut
   
   #-------------------------------------------------------
 sub SUMMIN {  sub SUMMIN {
     my ($num,$lower,$upper)=@_;      my ($num,$lower,$upper)=@_;
     my $mask=mask($lower,$upper);      my $mask=mask($lower,$upper);
Line 364  sub expandnamed { Line 753  sub expandnamed {
     return 0;      return 0;
         }          }
     } else {      } else {
         return '$c{\''.$expression.'\'}';          # it is not a function, so it is a parameter name
           # We should do the following:
           #    1. Take the list of parameter names
           #    2. look through the list for ones that match the parameter we want
           #    3. If there are no collisions, return the one that matches
           #    4. If there is a collision, return 'bad parameter name error'
           my $returnvalue = '';
           my @matches = ();
           $#matches = -1;
           study $expression;
           foreach $parameter (keys(%c)) {
               push @matches,$parameter if ($parameter =~ /$expression/);
           }
           if ($#matches == 0) {
               $returnvalue = '$c{\''.$matches[0].'\'}';
           } else {
               $returnvalue =  "'bad parameter name : $expression'";
           }
           return $returnvalue;
     }      }
 }  }
   
Line 384  sub sett { Line 791  sub sett {
       if ($_=~/A(\d+)/) {        if ($_=~/A(\d+)/) {
  my $trow=$1;   my $trow=$1;
                 if ($trow) {                  if ($trow) {
                       # Get the name of this cell
     my $lb=$col.$trow;      my $lb=$col.$trow;
                       # Grab the template declaration
                     $t{$lb}=$f{'template_'.$col};                      $t{$lb}=$f{'template_'.$col};
                       # Replace '#' with the row number
                     $t{$lb}=~s/\#/$trow/g;                      $t{$lb}=~s/\#/$trow/g;
                       # Replace '....' with ','
                     $t{$lb}=~s/\.\.+/\,/g;                      $t{$lb}=~s/\.\.+/\,/g;
                       # Replace 'A0' with the value from 'A0'
                     $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;                      $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
                       # Replace parameters
                     $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;                      $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
                 }                  }
       }        }
Line 411  sub sett { Line 824  sub sett {
             }              }
         }          }
     }      }
       # For some reason 'A0' gets special treatment...  This seems superfluous
       # but I imagine it is here for a reason.
     $t{'A0'}=$f{'A0'};      $t{'A0'}=$f{'A0'};
     $t{'A0'}=~s/\.\.+/\,/g;      $t{'A0'}=~s/\.\.+/\,/g;
     $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;      $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
Line 418  sub sett { Line 833  sub sett {
 }  }
   
 sub calc {  sub calc {
     %v=();      undef %v;
     &sett();      &sett();
     my $notfinished=1;      my $notfinished=1;
     my $depth=0;      my $depth=0;
Line 426  sub calc { Line 841  sub calc {
  $notfinished=0;   $notfinished=0;
         foreach (keys(%t)) {          foreach (keys(%t)) {
             my $old=$v{$_};              my $old=$v{$_};
             $v{$_}=eval($t{$_});              $v{$_}=eval $t{$_};
     if ($@) {      if ($@) {
  %v=();   undef %v;
                 return $@;                  return $_.': '.$@;
             }              }
     if ($v{$_} ne $old) { $notfinished=1; }      if ($v{$_} ne $old) { $notfinished=1; }
         }          }
         $depth++;          $depth++;
         if ($depth>100) {          if ($depth>100) {
     %v=();      undef %v;
             return 'Maximum calculation depth exceeded';              return 'Maximum calculation depth exceeded';
         }          }
     }      }
Line 461  sub outrowassess { Line 876  sub outrowassess {
     my @cols=();      my @cols=();
     if ($n) {      if ($n) {
        my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n});         my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n});
         if ($rl{$usy}) {
        $cols[0]=$rl{$usy}.'<br>'.         $cols[0]=$rl{$usy}.'<br>'.
                 '<select name="sel_'.$n.'" onChange="changesheet('.$n.                  '<select name="sel_'.$n.'" onChange="changesheet('.$n.
                 ')"><option name="default">Default</option>';                  ')"><option name="default">Default</option>';
         } else { $cols[0]=''; }
        foreach (@os) {         foreach (@os) {
            $cols[0].='<option name="'.$_.'"';             $cols[0].='<option name="'.$_.'"';
             if ($ufn eq $_) {              if ($ufn eq $_) {
Line 481  sub outrowassess { Line 898  sub outrowassess {
      'n','o','p','q','r','s','t','u','v','w','x','y','z') {       'n','o','p','q','r','s','t','u','v','w','x','y','z') {
         my $fm=$f{$_.$n};          my $fm=$f{$_.$n};
         $fm=~s/[\'\"]/\&\#34;/g;          $fm=~s/[\'\"]/\&\#34;/g;
         $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};          push(@cols,"'$_$n','$fm'".'___eq___'.$v{$_.$n});
     }      }
     return @cols;      return @cols;
 }  }
Line 552  sub setrowlabels { Line 969  sub setrowlabels {
   
 sub calcsheet {  sub calcsheet {
     my $safeeval=shift;      my $safeeval=shift;
     $safeeval->reval('&calc();');      return $safeeval->reval('&calc();');
 }  }
   
 # ------------------------------------------------------------------ Get values  # ------------------------------------------------------------------ Get values
Line 840  sub outsheet { Line 1257  sub outsheet {
 #  #
 # ----------------------------------------------- Read list of available sheets  # ----------------------------------------------- Read list of available sheets
 #   # 
   
 sub othersheets {  sub othersheets {
     my ($safeeval,$stype)=@_;      my ($safeeval,$stype)=@_;
       #
     my $cnum=&getcnum($safeeval);      my $cnum=&getcnum($safeeval);
     my $cdom=&getcdom($safeeval);      my $cdom=&getcdom($safeeval);
     my $chome=&getchome($safeeval);      my $chome=&getchome($safeeval);
       #
     my @alternatives=();      my @alternatives=();
     my $result=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'.      my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum);
                                       $stype.'_spreadsheets',$chome);      my ($tmp) = keys(%results);
     if ($result!~/^error\:/) {      unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
  foreach (split(/\&/,$result)) {          @alternatives = sort (keys(%results));
             $alternatives[$#alternatives+1]=      }
             &Apache::lonnet::unescape((split(/\=/,$_))[0]);  
         }  
     }   
     return @alternatives;       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  # -------------------------------------- Read spreadsheet formulas for a course
 #  #
Line 871  sub readsheet { Line 1313  sub readsheet {
   my $cdom=&getcdom($safeeval);    my $cdom=&getcdom($safeeval);
   my $chome=&getchome($safeeval);    my $chome=&getchome($safeeval);
   
 # --------- There is no filename. Look for defaults in course and global, cache    if (! defined($fn)) {
         # There is no filename. Look for defaults in course and global, cache
   unless($fn) {  
       unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {        unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {
          $fn=&Apache::lonnet::reply('get:'.$cdom.':'.$cnum.            my %tmphash = &Apache::lonnet::get('environment',
                                     ':environment:spreadsheet_default_'.$stype,                                               ['spreadsheet_default_'.$stype],
                                     $chome);                                               $cdom,$cnum);
          unless (($fn) && ($fn!~/^error\:/)) {            my ($tmp) = keys(%tmphash);
      $fn='default_'.$stype;            if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
          }                $fn = 'default_'.$stype;
          $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn;             } else {
                 $fn = $tmphash{'spreadsheet_default_'.$stype};
             } 
             unless (($fn) && ($fn!~/^error\:/)) {
         $fn='default_'.$stype;
             }
             $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 
       }        }
   }    }
   
Line 900  sub readsheet { Line 1347  sub readsheet {
      my %f=();       my %f=();
   
      if ($fn=~/^default\_/) {       if ($fn=~/^default\_/) {
  my $sheetxml='';           my $sheetxml='';
        {  
          my $fh;           my $fh;
          my $dfn=$fn;           my $dfn=$fn;
          $dfn=~s/\_/\./g;           $dfn=~s/\_/\./g;
          if ($fh=Apache::File->new($includedir.'/'.$dfn)) {           if ($fh=Apache::File->new($includedir.'/'.$dfn)) {
                $sheetxml=join('',<$fh>);               $sheetxml=join('',<$fh>);
  } else {           } else {
              $sheetxml='<field row="0" col="A">"Error"</field>';               $sheetxml='<field row="0" col="A">"Error"</field>';
  }           }
        }           %f=%{&parse_sheet(\$sheetxml)};
         my $parser=HTML::TokeParser->new(\$sheetxml);       } elsif($fn=~/\/*\.spreadsheet$/) {
         my $token;           my $sheetxml=&Apache::lonnet::getfile
         while ($token=$parser->get_token) {               (&Apache::lonnet::filelocation('',$fn));
           if ($token->[0] eq 'S') {           if ($sheetxml == -1) {
       if ($token->[1] eq 'field') {               $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
   $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=                   .$fn.'"</field>';
       $parser->get_text('/field');           }
       }           %f=%{&parse_sheet(\$sheetxml)};
              if ($token->[1] eq 'template') {       } else {
                  $f{'template_'.$token->[2]->{'col'}}=           my $sheet='';
                      $parser->get_text('/template');           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 $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'.$fn,  
                                          $chome);  
           unless ($reply=~/^error\:/) {  
              $sheet=$reply;  
   }  
           foreach (split(/\&/,$sheet)) {  
              my ($name,$value)=split(/\=/,$_);  
              $f{&Apache::lonnet::unescape($name)}=  
         &Apache::lonnet::unescape($value);  
           }  
        }  
 # --------------------------------------------------------------- Cache and set  # --------------------------------------------------------------- Cache and set
        $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);           $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);  
        &setformulas($safeeval,%f);         &setformulas($safeeval,%f);
Line 1044  sub tmpread { Line 1481  sub tmpread {
     $fn=$tmpdir.$fn.'.tmp';      $fn=$tmpdir.$fn.'.tmp';
     my $fh;      my $fh;
     my %fo=();      my %fo=();
       my $countrows=0;
     if ($fh=Apache::File->new($fn)) {      if ($fh=Apache::File->new($fn)) {
         my $name;          my $name;
         while ($name=<$fh>) {          while ($name=<$fh>) {
Line 1051  sub tmpread { Line 1489  sub tmpread {
             my $value=<$fh>;              my $value=<$fh>;
             chomp($value);              chomp($value);
             $fo{$name}=$value;              $fo{$name}=$value;
               if ($name=~/^A(\d+)$/) {
    if ($1>$countrows) {
       $countrows=$1;
                   }
               }
         }          }
     }      }
     if ($nform eq 'changesheet') {      if ($nform eq 'changesheet') {
Line 1058  sub tmpread { Line 1501  sub tmpread {
         unless ($ENV{'form.sel_'.$nfield} eq 'Default') {          unless ($ENV{'form.sel_'.$nfield} eq 'Default') {
     $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};      $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};
         }          }
       } elsif ($nfield eq 'insertrow') {
           $countrows++;
           my $newrow=substr('000000'.$countrows,-7);
           if ($nform eq 'top') {
       $fo{'A'.$countrows}='--- '.$newrow;
           } else {
               $fo{'A'.$countrows}='~~~ '.$newrow;
           }
     } else {      } else {
        if ($nfield) { $fo{$nfield}=$nform; }         if ($nfield) { $fo{$nfield}=$nform; }
     }      }
Line 1978  $tmpdir=$r->dir_config('lonDaemons').'/t Line 2429  $tmpdir=$r->dir_config('lonDaemons').'/t
   
 # --------------------------- Get query string for limited number of parameters  # --------------------------- Get query string for limited number of parameters
   
     foreach (split(/&/,$ENV{'QUERY_STRING'})) {      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
        my ($name, $value) = split(/=/,$_);                                              ['uname','udom','usymb','ufn']);
        $value =~ tr/+/ /;  
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
        if (($name eq 'uname') || ($name eq 'udom') ||   
            ($name eq 'usymb') || ($name eq 'ufn')) {  
            unless ($ENV{'form.'.$name}) {  
               $ENV{'form.'.$name}=$value;  
    }  
        }  
     }  
   
     if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) {      if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) {
  $ENV{'form.ufn'}='default_'.$1;   $ENV{'form.ufn'}='default_'.$1;
Line 2026  $tmpdir=$r->dir_config('lonDaemons').'/t Line 2468  $tmpdir=$r->dir_config('lonDaemons').'/t
   
     function celledit(cn,cf) {      function celledit(cn,cf) {
         var cnf=prompt(cn,cf);          var cnf=prompt(cn,cf);
  if (cnf!=null) {          if (cnf!=null) {
     document.sheet.unewfield.value=cn;              document.sheet.unewfield.value=cn;
             document.sheet.unewformula.value=cnf;              document.sheet.unewformula.value=cnf;
             document.sheet.submit();              document.sheet.submit();
         }          }
Line 2039  $tmpdir=$r->dir_config('lonDaemons').'/t Line 2481  $tmpdir=$r->dir_config('lonDaemons').'/t
         document.sheet.submit();          document.sheet.submit();
     }      }
   
       function insertrow(cn) {
    document.sheet.unewfield.value='insertrow';
           document.sheet.unewformula.value=cn;
           document.sheet.submit();
       }
   
 </script>  </script>
 ENDSCRIPT  ENDSCRIPT
     $r->print('</head><body bgcolor="#FFFFFF">'.      $r->print('</head><body bgcolor="#FFFFFF">'.
Line 2255  ENDSCRIPT Line 2703  ENDSCRIPT
        }         }
     }      }
     $r->print('>');      $r->print('>');
   
     if (&gettype($asheet) eq 'classcalc') {      if (&gettype($asheet) eq 'classcalc') {
        $r->print(         $r->print(
    ' Output CSV format: <input type=checkbox name=showcsv onClick="submit()"');     ' Output CSV format: <input type=checkbox name=showcsv onClick="submit()"');
        if ($ENV{'form.showcsv'}) { $r->print(' checked'); }         if ($ENV{'form.showcsv'}) { $r->print(' checked'); }
        $r->print('>');         $r->print('>');
     }      }
   
   # ------------------------------------------------------------------ Insertrows
   
      $r->print(<<ENDINSERTBUTTONS);
   <br>
   <input type='button' onClick='insertrow("top");' 
   value='Insert Row Top'>
   <input type='button' onClick='insertrow("bottom");' 
   value='Insert Row Bottom'><br>
   ENDINSERTBUTTONS
   
 # ------------------------------------------------------------- Print out sheet  # ------------------------------------------------------------- Print out sheet
   
     &outsheet($r,$asheet);      &outsheet($r,$asheet);
Removed from v.1.79  
changed lines
  Added in v.1.96

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>