[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.53 and 1.117

version 1.53, 2001/04/05 21:35:02 version 1.117, 2002/10/16 16:35:42
Line 1 Line 1
   #
   # $Id$
   #
   # Copyright Michigan State University Board of Trustees
   #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
   #
   # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
   #
   # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   #
   # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
   #
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # Spreadsheet/Grades Display Handler  # Spreadsheet/Grades Display Handler
 #  #
 # 11/11,11/15,11/27,12/04,12/05,12/06,12/07,  # POD required stuff:
 # 12/08,12/09,12/11,12/12,12/15,12/16,12/18,12/19,12/30,  
 # 01/01/01,02/01,03/01,19/01,20/01,22/01,  =head1 NAME
 # 03/05,03/08,03/10,03/12,03/13,03/15,03/17,  
 # 03/19,03/20,03/21,03/27,04/05 Gerd Kortemeyer  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 17  use Apache::lonnet; Line 60  use Apache::lonnet;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use GDBM_File;  use GDBM_File;
 use HTML::TokeParser;  use HTML::TokeParser;
   use Apache::lonhtmlcommon;
   #
   # Caches for coursewide information 
   #
   my %Section;
   
 #  #
 # Caches for previously calculated spreadsheets  # Caches for previously calculated spreadsheets
Line 52  my %courseopt; Line 100  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 68  sub initsheet { Line 124  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 77  sub initsheet { Line 134  sub initsheet {
 # v: output values  # v: output values
 # c: preloaded constants (A-column)  # c: preloaded constants (A-column)
 # rl: row label  # rl: row label
   # os: other spreadsheets (for student spreadsheet only)
   
 undef %v;   undef %sheet_values; 
 undef %t;  undef %t;
 undef %f;  undef %f;
 undef %c;  undef %c;
 undef %rl;  undef %rowlabel;
   undef @os;
   
 $maxrow=0;  $maxrow = 0;
 $sheettype='';  $sheettype = '';
   
 # filename/reference of the sheet  # filename/reference of the sheet
   $filename = '';
 $filename='';  
   
 # user data  # user data
 $uname='';  $uname = '';
 $uhome='';  $uhome = '';
 $udom='';  $udom  = '';
   
 # course data  # course data
   
 $csec='';  $csec = '';
 $chome='';  $chome= '';
 $cnum='';  $cnum = '';
 $cdom='';  $cdom = '';
 $cid='';  $cid  = '';
 $cfn='';  $coursefilename  = '';
   
 # symb  # symb
   
 $usymb='';  $usymb = '';
   
   # error messages
   $errormsg = '';
   
 sub mask {  sub mask {
     my ($lower,$upper)=@_;      my ($lower,$upper)=@_;
Line 138  sub mask { Line 199  sub mask {
     } else {      } else {
         if (length($ld)!=length($ud)) {          if (length($ld)!=length($ud)) {
            $num.='(';             $num.='(';
    map {     foreach ($ld=~m/\d/g) {
               $num.='['.$_.'-9]';                $num.='['.$_.'-9]';
            } ($ld=~m/\d/g);     }
            if (length($ud)-length($ld)>1) {             if (length($ud)-length($ld)>1) {
               $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';                $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
    }     }
            $num.='|';             $num.='|';
            map {             foreach ($ud=~m/\d/g) {
                $num.='[0-'.$_.']';                 $num.='[0-'.$_.']';
            } ($ud=~m/\d/g);             }
            $num.=')';             $num.=')';
        } else {         } else {
            my @lda=($ld=~m/\d/g);             my @lda=($ld=~m/\d/g);
Line 185  sub mask { Line 246  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(%sheet_values);
    @Keys = $sheet_values{@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(%sheet_values);
    @Values =$sheet_values{@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 = $sheet_values{$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(%sheet_values);
    @Keys = $sheet_values{@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(%sheet_values);
    @Values =$sheet_values{@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=0;      my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1;
     map {  
         $num++;  
     } grep /$mask/,keys %v;  
     return $num;         return $num;   
 }  }
   
Line 198  sub BIN { Line 532  sub BIN {
     my ($low,$high,$lower,$upper)=@_;      my ($low,$high,$lower,$upper)=@_;
     my $mask=mask($lower,$upper);      my $mask=mask($lower,$upper);
     my $num=0;      my $num=0;
     map {      foreach (grep /$mask/,keys(%sheet_values)) {
         if (($v{$_}>=$low) && ($v{$_}<=$high)) {          if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {
             $num++;              $num++;
         }          }
     } grep /$mask/,keys %v;      }
     return $num;         return $num;   
 }  }
   
   
   #-------------------------------------------------------
   
   =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;
     map {      foreach (grep /$mask/,keys(%sheet_values)) {
         $sum+=$v{$_};          $sum+=$sheet_values{$_};
     } grep /$mask/,keys %v;      }
     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;
     map {      foreach (grep /$mask/,keys(%sheet_values)) {
         $sum+=$v{$_};          $sum+=$sheet_values{$_};
         $num++;          $num++;
     } grep /$mask/,keys %v;      }
     if ($num) {      if ($num) {
        return $sum/$num;         return $sum/$num;
     } else {      } else {
Line 230  sub MEAN { Line 582  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;
     map {      foreach (grep /$mask/,keys(%sheet_values)) {
         $sum+=$v{$_};          $sum+=$sheet_values{$_};
         $num++;          $num++;
     } grep /$mask/,keys %v;      }
     unless ($num>1) { return undef; }      unless ($num>1) { return undef; }
     my $mean=$sum/$num;      my $mean=$sum/$num;
     $sum=0;      $sum=0;
     map {      foreach (grep /$mask/,keys(%sheet_values)) {
         $sum+=($v{$_}-$mean)**2;          $sum+=($sheet_values{$_}-$mean)**2;
     } grep /$mask/,keys %v;      }
     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;
     map {      foreach (grep /$mask/,keys(%sheet_values)) {
         $prod*=$v{$_};          $prod*=$sheet_values{$_};
     } grep /$mask/,keys %v;      }
     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='-';
     map {      foreach (grep /$mask/,keys(%sheet_values)) {
         unless ($max) { $max=$v{$_}; }          unless ($max) { $max=$sheet_values{$_}; }
         if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }          if (($sheet_values{$_}>$max) || ($max eq '-')) { $max=$sheet_values{$_}; }
     } grep /$mask/,keys %v;      } 
     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='-';
     map {      foreach (grep /$mask/,keys(%sheet_values)) {
         unless ($max) { $max=$v{$_}; }          unless ($max) { $max=$sheet_values{$_}; }
         if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }          if (($sheet_values{$_}<$min) || ($min eq '-')) { 
     } grep /$mask/,keys %v;              $min=$sheet_values{$_}; 
           }
       }
     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=();
     map {      foreach (grep /$mask/,keys(%sheet_values)) {
  $inside[$#inside+1]=$v{$_};   push (@inside,$sheet_values{$_});
     } grep /$mask/,keys %v;      }
     @inside=sort(@inside);      @inside=sort(@inside);
     my $sum=0; my $i;      my $sum=0; my $i;
     for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {       for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { 
Line 290  sub SUMMAX { Line 690  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);
     my @inside=();      my @inside=();
     map {      foreach (grep /$mask/,keys(%sheet_values)) {
  $inside[$#inside+1]=$v{$_};   $inside[$#inside+1]=$sheet_values{$_};
     } grep /$mask/,keys %v;      }
     @inside=sort(@inside);      @inside=sort(@inside);
     my $sum=0; my $i;      my $sum=0; my $i;
     for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {       for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { 
Line 305  sub SUMMIN { Line 715  sub SUMMIN {
     return $sum;         return $sum;   
 }  }
   
   #-------------------------------------------------------
   
   =item MINPARM(parametername)
   
   Returns the minimum value of the parameters matching the parametername.
   parametername should be a string such as 'duedate'.
   
   =cut
   
   #-------------------------------------------------------
   sub MINPARM {
       my ($expression) = @_;
       my $min = undef;
       study($expression);
       foreach $parameter (keys(%c)) {
           next if ($parameter !~ /$expression/);
           if ((! defined($min)) || ($min > $c{$parameter})) {
               $min = $c{$parameter} 
           }
       }
       return $min;
   }
   
   #-------------------------------------------------------
   
   =item MAXPARM(parametername)
   
   Returns the maximum value of the parameters matching the input parameter name.
   parametername should be a string such as 'duedate'.
   
   =cut
   
   #-------------------------------------------------------
   sub MAXPARM {
       my ($expression) = @_;
       my $max = undef;
       study($expression);
       foreach $parameter (keys(%c)) {
           next if ($parameter !~ /$expression/);
           if ((! defined($min)) || ($max < $c{$parameter})) {
               $max = $c{$parameter} 
           }
       }
       return $max;
   }
   
   #--------------------------------------------------------
   sub expandnamed {
       my $expression=shift;
       if ($expression=~/^\&/) {
    my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/);
    my @vars=split(/\W+/,$formula);
           my %values=();
           undef %values;
    foreach ( @vars ) {
               my $varname=$_;
               if ($varname=~/\D/) {
                  $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;
                  $varname=~s/$var/\(\\w\+\)/g;
          foreach (keys(%c)) {
     if ($_=~/$varname/) {
         $values{$1}=1;
                     }
                  }
       }
           }
           if ($func eq 'EXPANDSUM') {
               my $result='';
       foreach (keys(%values)) {
                   my $thissum=$formula;
                   $thissum=~s/$var/$_/g;
                   $result.=$thissum.'+';
               } 
               $result=~s/\+$//;
               return $result;
           } else {
       return 0;
           }
       } else {
           # 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].'\'}';
           } elsif ($#matches > 0) {
               # more than one match.  Look for a concise one
               $returnvalue =  "'non-unique parameter name : $expression'";
               foreach (@matches) {
                   if (/^$expression$/) {
                       $returnvalue = '$c{\''.$_.'\'}';
                   }
               }
           } else {
               $returnvalue =  "'bad parameter name : $expression'";
           }
           return $returnvalue;
       }
   }
   
 sub sett {  sub sett {
     %t=();      %t=();
     my $pattern='';      my $pattern='';
Line 313  sub sett { Line 832  sub sett {
     } else {      } else {
         $pattern='[A-Z]';          $pattern='[A-Z]';
     }      }
     map {      # Deal with the template row
  if ($_=~/template\_(\w)/) {      foreach (keys(%f)) {
   my $col=$1;   next if ($_!~/template\_(\w)/);
           unless ($col=~/^$pattern/) {          my $col=$1;
             map {          next if ($col=~/^$pattern/);
       if ($_=~/A(\d+)/) {          foreach (keys(%f)) {
  my $trow=$1;              next if ($_!~/A(\d+)/);
                 if ($trow) {              my $trow=$1;
     my $lb=$col.$trow;              next if (! $trow);
                     $t{$lb}=$f{'template_'.$col};              # Get the name of this cell
                     $t{$lb}=~s/\#/$trow/g;              my $lb=$col.$trow;
                     $t{$lb}=~s/\.\.+/\,/g;              # Grab the template declaration
                     $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;              $t{$lb}=$f{'template_'.$col};
                     $t{$lb}=~s/(^|[^\"\'])\[(\w+)\]/$1\$c\{\'$2\'\}/g;              # Replace '#' with the row number
                 }              $t{$lb}=~s/\#/$trow/g;
       }              # Replace '....' with ','
             } keys %f;              $t{$lb}=~s/\.\.+/\,/g;
   }              # Replace 'A0' with the value from 'A0'
       }              $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
     } keys %f;              # Replace parameters
     map {              $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
  if (($f{$_}) && ($_!~/template\_/)) {          }
       }
       # Deal with the normal cells
       foreach (keys(%f)) {
    if (exists($f{$_}) && ($_!~/template\_/)) {
             my $matches=($_=~/^$pattern(\d+)/);              my $matches=($_=~/^$pattern(\d+)/);
             if  (($matches) && ($1)) {              if  (($matches) && ($1)) {
         unless ($f{$_}=~/^\!/) {          unless ($f{$_}=~/^\!/) {
Line 343  sub sett { Line 866  sub sett {
             } else {              } else {
        $t{$_}=$f{$_};         $t{$_}=$f{$_};
                $t{$_}=~s/\.\.+/\,/g;                 $t{$_}=~s/\.\.+/\,/g;
                $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;                 $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
                $t{$_}=~s/(^|[^\"\'])\[([\w\.]+)\]/$1\$c\{\'$2\'\}/g;                 $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
             }              }
         }          }
     } keys %f;      }
       # For inserted lines, [B-Z] is also valid
       unless ($sheettype eq 'assesscalc') {
          foreach (keys(%f)) {
      if ($_=~/[B-Z](\d+)/) {
          if ($f{'A'.$1}=~/^[\~\-]/) {
              $t{$_}=$f{$_};
                     $t{$_}=~s/\.\.+/\,/g;
                     $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
                     $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
                  }
              }
          }
       }
       # 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\$sheet_values\{\'$2\'\}/g;
     $t{'A0'}=~s/(^|[^\"\'])\[([\w\.]+)\]/$1\$c\{\'$2\'\}/g;      $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
 }  }
   
 sub calc {  sub calc {
     %v=();      undef %sheet_values;
     &sett();      &sett();
     my $notfinished=1;      my $notfinished=1;
       my $lastcalc='';
     my $depth=0;      my $depth=0;
     while ($notfinished) {      while ($notfinished) {
  $notfinished=0;   $notfinished=0;
         map {          foreach (keys(%t)) {
             my $old=$v{$_};              my $old=$sheet_values{$_};
             $v{$_}=eval($t{$_});              $sheet_values{$_}=eval $t{$_};
     if ($@) {      if ($@) {
  %v=();   undef %sheet_values;
                 return $@;                  return $_.': '.$@;
             }              }
     if ($v{$_} ne $old) { $notfinished=1; }      if ($sheet_values{$_} ne $old) { $notfinished=1; $lastcalc=$_; }
         } keys %t;          }
         $depth++;          $depth++;
         if ($depth>100) {          if ($depth>100) {
     %v=();      undef %sheet_values;
             return 'Maximum calculation depth exceeded';              return $lastcalc.': Maximum calculation depth exceeded';
         }          }
     }      }
     return '';      return '';
Line 382  sub calc { Line 921  sub calc {
 sub templaterow {  sub templaterow {
     my @cols=();      my @cols=();
     $cols[0]='<b><font size=+1>Template</font></b>';      $cols[0]='<b><font size=+1>Template</font></b>';
     map {      foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
        'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
        'a','b','c','d','e','f','g','h','i','j','k','l','m',
        'n','o','p','q','r','s','t','u','v','w','x','y','z') {
         my $fm=$f{'template_'.$_};          my $fm=$f{'template_'.$_};
         $fm=~s/[\'\"]/\&\#34;/g;          $fm=~s/[\'\"]/\&\#34;/g;
         $cols[$#cols+1]="'template_$_','$fm'".'___eq___'.$fm;          push(@cols,"'template_$_','$fm'".'___eq___'.$fm);
     } ('A','B','C','D','E','F','G','H','I','J','K','L','M',      }
        'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',  
        'a','b','c','d','e','f','g','h','i','j','k','l','m',  
        'n','o','p','q','r','s','t','u','v','w','x','y','z');  
     return @cols;      return @cols;
 }  }
   
   #
   # This is actually used for the student spreadsheet, not the assessment sheet
   # Do not be fooled by the name!
   #
 sub outrowassess {  sub outrowassess {
       # $n is the current row number
     my $n=shift;      my $n=shift;
     my @cols=();      my @cols=();
     if ($n) {      if ($n) {
        $cols[0]=$rl{$f{'A'.$n}};          my ($usy,$ufn)=split(/__&&&\__/,$f{'A'.$n});
           if ($rowlabel{$usy}) {
               $cols[0]=$rowlabel{$usy}.'<br>'.
                   '<select name="sel_'.$n.'" onChange="changesheet('.$n.')">'.
                       '<option name="default">Default</option>';
           } else { 
               $cols[0]=''; 
           }
           foreach (@os) {
               $cols[0].='<option name="'.$_.'"';
               if ($ufn eq $_) {
                   $cols[0].=' selected';
               }
               $cols[0].='>'.$_.'</option>';
           }
           $cols[0].='</select>';
     } else {      } else {
        $cols[0]='<b><font size=+1>Export</font></b>';          $cols[0]='<b><font size=+1>Export</font></b>';
     }      }
     map {      foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
        'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
        'a','b','c','d','e','f','g','h','i','j','k','l','m',
        '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___'.$sheet_values{$_.$n});
     } ('A','B','C','D','E','F','G','H','I','J','K','L','M',      }
        'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',  
        'a','b','c','d','e','f','g','h','i','j','k','l','m',  
        'n','o','p','q','r','s','t','u','v','w','x','y','z');  
     return @cols;      return @cols;
 }  }
   
Line 416  sub outrow { Line 975  sub outrow {
     my $n=shift;      my $n=shift;
     my @cols=();      my @cols=();
     if ($n) {      if ($n) {
        $cols[0]=$rl{$f{'A'.$n}};         $cols[0]=$rowlabel{$f{'A'.$n}};
     } else {      } else {
        $cols[0]='<b><font size=+1>Export</font></b>';         $cols[0]='<b><font size=+1>Export</font></b>';
     }      }
     map {      foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
        'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
        'a','b','c','d','e','f','g','h','i','j','k','l','m',
        '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___'.$sheet_values{$_.$n});
     } ('A','B','C','D','E','F','G','H','I','J','K','L','M',      }
        'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',  
        'a','b','c','d','e','f','g','h','i','j','k','l','m',  
        'n','o','p','q','r','s','t','u','v','w','x','y','z');  
     return @cols;      return @cols;
 }  }
   
 sub exportrowa {  sub exportrowa {
     my @exportarray=();      my @exportarray=();
     map {      foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
  $exportarray[$#exportarray+1]=$v{$_.'0'};       'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
     } ('A','B','C','D','E','F','G','H','I','J','K','L','M',   push(@exportarray,$sheet_values{$_.'0'});
        'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');      } 
     return @exportarray;      return @exportarray;
 }  }
   
Line 447  ENDDEFS Line 1006  ENDDEFS
 }  }
   
 # ------------------------------------------------ Add or change formula values  # ------------------------------------------------ Add or change formula values
   
 sub setformulas {  sub setformulas {
     my ($safeeval,%f)=@_;      my ($safeeval,%f)=@_;
     %{$safeeval->varglob('f')}=%f;      %{$safeeval->varglob('f')}=%f;
 }  }
   
 # ------------------------------------------------ Add or change formula values  # ------------------------------------------------ Add or change formula values
   
 sub setconstants {  sub setconstants {
     my ($safeeval,%c)=@_;      my ($safeeval,%c)=@_;
     %{$safeeval->varglob('c')}=%c;      %{$safeeval->varglob('c')}=%c;
 }  }
   
 # ------------------------------------------------ Add or change formula values  # --------------------------------------------- Set names of other spreadsheets
   sub setothersheets {
       my ($safeeval,@os)=@_;
       @{$safeeval->varglob('os')}=@os;
   }
   
   # ------------------------------------------------ Add or change formula values
 sub setrowlabels {  sub setrowlabels {
     my ($safeeval,%rl)=@_;      my ($safeeval,%rowlabel)=@_;
     %{$safeeval->varglob('rl')}=%rl;      %{$safeeval->varglob('rowlabel')}=%rowlabel;
 }  }
   
 # ------------------------------------------------------- Calculate spreadsheet  # ------------------------------------------------------- Calculate spreadsheet
   
 sub calcsheet {  sub calcsheet {
     my $safeeval=shift;      my $safeeval=shift;
     $safeeval->reval('&calc();');      return $safeeval->reval('&calc();');
 }  
   
 # ------------------------------------------------------------------ Get values  
   
 sub getvalues {  
     my $safeeval=shift;  
     return $safeeval->reval('%v');  
 }  }
   
 # ---------------------------------------------------------------- Get formulas  # ---------------------------------------------------------------- Get formulas
   
 sub getformulas {  sub getformulas {
     my $safeeval=shift;      my $safeeval=shift;
     return %{$safeeval->varglob('f')};      return %{$safeeval->varglob('f')};
 }  }
   
 # -------------------------------------------------------------------- Get type  # ----------------------------------------------------- Get value of $f{'A'.$n}
   sub getfa {
 sub gettype {      my ($safeeval,$n)=@_;
     my $safeeval=shift;      return $safeeval->reval('$f{"A'.$n.'"}');
     return $safeeval->reval('$sheettype');  
 }  
   
 # ------------------------------------------------------------------ Set maxrow  
   
 sub setmaxrow {  
     my ($safeeval,$row)=@_;  
     $safeeval->reval('$maxrow='.$row.';');  
 }  
   
 # ------------------------------------------------------------------ Get maxrow  
   
 sub getmaxrow {  
     my $safeeval=shift;  
     return $safeeval->reval('$maxrow');  
 }  
   
 # ---------------------------------------------------------------- Set filename  
   
 sub setfilename {  
     my ($safeeval,$fn)=@_;  
     $safeeval->reval('$filename="'.$fn.'";');  
 }  
   
 # ---------------------------------------------------------------- Get filename  
   
 sub getfilename {  
     my $safeeval=shift;  
     return $safeeval->reval('$filename');  
 }  
   
 # --------------------------------------------------------------- Get course ID  
   
 sub getcid {  
     my $safeeval=shift;  
     return $safeeval->reval('$cid');  
 }  
   
 # --------------------------------------------------------- Get course filename  
   
 sub getcfn {  
     my $safeeval=shift;  
     return $safeeval->reval('$cfn');  
 }  
   
 # ----------------------------------------------------------- Get course number  
   
 sub getcnum {  
     my $safeeval=shift;  
     return $safeeval->reval('$cnum');  
 }  
   
 # ------------------------------------------------------------- Get course home  
   
 sub getchome {  
     my $safeeval=shift;  
     return $safeeval->reval('$chome');  
 }  
   
 # ----------------------------------------------------------- Get course domain  
   
 sub getcdom {  
     my $safeeval=shift;  
     return $safeeval->reval('$cdom');  
 }  
   
 # ---------------------------------------------------------- Get course section  
   
 sub getcsec {  
     my $safeeval=shift;  
     return $safeeval->reval('$csec');  
 }  
   
 # --------------------------------------------------------------- Get user name  
   
 sub getuname {  
     my $safeeval=shift;  
     return $safeeval->reval('$uname');  
 }  
   
 # ------------------------------------------------------------- Get user domain  
   
 sub getudom {  
     my $safeeval=shift;  
     return $safeeval->reval('$udom');  
 }  
   
 # --------------------------------------------------------------- Get user home  
   
 sub getuhome {  
     my $safeeval=shift;  
     return $safeeval->reval('$uhome');  
 }  
   
 # -------------------------------------------------------------------- Get symb  
   
 sub getusymb {  
     my $safeeval=shift;  
     return $safeeval->reval('$usymb');  
 }  }
   
 # ------------------------------------------------------------- Export of A-row  # ------------------------------------------------------------- Export of A-row
   
 sub exportdata {  sub exportdata {
     my $safeeval=shift;      my $safeeval=shift;
     return $safeeval->reval('&exportrowa()');      return $safeeval->reval('&exportrowa()');
 }  }
   
   
 # ========================================================== End of Spreadsheet  # ========================================================== End of Spreadsheet
 # =============================================================================  # =============================================================================
   
Line 609  sub exportdata { Line 1063  sub exportdata {
 # --------------------------------------------- Produce output row n from sheet  # --------------------------------------------- Produce output row n from sheet
   
 sub rown {  sub rown {
     my ($safeeval,$n)=@_;      my ($safeeval,$n,$sheetdata)=@_;
     my $defaultbg;      my $defaultbg;
     my $rowdata='';      my $rowdata='';
       my $dataflag=0;
     unless ($n eq '-') {      unless ($n eq '-') {
        $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';          $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
     } else {      } else {
        $defaultbg='#E0FF';          $defaultbg='#E0FF';
     }      }
     if ((($n-1)/25)==int(($n-1)/25)) {      unless ($ENV{'form.showcsv'}) {
         my $what='Student';          $rowdata.="\n<tr><td><b><font size=+1>$n</font></b></td>";
         if (&gettype($safeeval) eq 'assesscalc') {      } else {
     $what='Item';          $rowdata.="\n".'"'.$n.'"';
  } elsif (&gettype($safeeval) eq 'studentcalc') {  
             $what='Assessment';  
         }  
  $rowdata.="</table>\n<br><table border=2>".  
         '<tr><td>&nbsp;<td>'.$what.'</td>';  
         map {  
            $rowdata.='<td>'.$_.'</td>';  
         } ('A','B','C','D','E','F','G','H','I','J','K','L','M',  
            'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',  
            'a','b','c','d','e','f','g','h','i','j','k','l','m',  
            'n','o','p','q','r','s','t','u','v','w','x','y','z');  
         $rowdata.='</tr>';  
     }      }
     $rowdata.="\n<tr><td><b><font size=+1>$n</font></b></td>";  
     my $showf=0;      my $showf=0;
     my $proc;      my $proc;
     my $maxred;      my $maxred=1;
     if (&gettype($safeeval) eq 'assesscalc') {      my $sheettype=$sheetdata->{'sheettype'};
       if ($sheettype eq 'studentcalc') {
         $proc='&outrowassess';          $proc='&outrowassess';
         $maxred=1;          $maxred=26;
     } else {      } else {
         $proc='&outrow';          $proc='&outrow';
       }
       if ($sheettype eq 'assesscalc') {
           $maxred=1;
       } else {
         $maxred=26;          $maxred=26;
     }      }
     if ($n eq '-') { $proc='&templaterow'; $n=-1; }      if (&getfa($safeeval,$n)=~/^[\~\-]/) { $maxred=1; }
     map {      if ($n eq '-') { 
        my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');          $proc='&templaterow'; 
        my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);          $n=-1; 
        if ($showf==0) { $vl=$_; }          $dataflag=1; 
        if ($showf<=$maxred) { $bgcolor='#FFDDDD'; }      }
        if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }       foreach ($safeeval->reval($proc.'('.$n.')')) {
        if (($showf>$maxred) || ((!$n) && ($showf>0))) {          my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
    if ($vl eq '') {          my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
        $vl='<font size=+2 color='.$bgcolor.'>&#35;</font>';          if ((($vl ne '') || ($vl eq '0')) &&
            }              (($showf==1) || ($sheettype ne 'studentcalc'))) { $dataflag=1; }
            $rowdata.=          if ($showf==0) { $vl=$_; }
        '<td bgcolor='.$bgcolor.'><a href="javascript:celledit('.$fm.');">'.$vl.          unless ($ENV{'form.showcsv'}) {
        '</a></td>';              if ($showf<=$maxred) { $bgcolor='#FFDDDD'; }
        } else {              if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; } 
            $rowdata.='<td bgcolor='.$bgcolor.'>&nbsp;'.$vl.'&nbsp;</td>';              if (($showf>$maxred) || ((!$n) && ($showf>0))) {
        }                  if ($vl eq '') {
        $showf++;                      $vl='<font size=+2 color='.$bgcolor.'>&#35;</font>';
     } $safeeval->reval($proc.'('.$n.')');                  }
     return $rowdata.'</tr>';                  $rowdata.='<td bgcolor='.$bgcolor.'>';
                   if ($ENV{'request.role'} =~ /^st\./) {
                       $rowdata.=$vl;
                   } else {
                       $rowdata.='<a href="javascript:celledit('.$fm.');">'.
                           $vl.'</a>';
                   }
                   $rowdata.='</td>';
               } else {
                   $rowdata.='<td bgcolor='.$bgcolor.'>&nbsp;'.$vl.'&nbsp;</td>';
               }
           } else {
               $rowdata.=',"'.$vl.'"';
           }
           $showf++;
       }  # End of foreach($safeval...)
       if ($ENV{'form.showall'} || ($dataflag)) {
           return $rowdata.($ENV{'form.showcsv'}?'':'</tr>');
       } else {
           return '';
       }
 }  }
   
 # ------------------------------------------------------------- Print out sheet  # ------------------------------------------------------------- Print out sheet
   
 sub outsheet {  sub outsheet {
     my ($r,$safeeval)=@_;      my ($r,$safeeval,$sheetdata)=@_;
     my $maxred;      my $maxred = 26;    # The maximum number of cells to show as 
     my $realm;                          # red (uneditable) 
     if (&gettype($safeeval) eq 'assesscalc') {                          # To make student sheets uneditable could we 
                           # set $maxred = 52?
                           #
       my $realm='Course'; # 'assessment', 'user', or 'course' sheet
       if ($sheetdata->{'sheettype'} eq 'assesscalc') {
         $maxred=1;          $maxred=1;
         $realm='Assessment';          $realm='Assessment';
     } elsif (&gettype($safeeval) eq 'studentcalc') {      } elsif ($sheetdata->{'sheettype'} eq 'studentcalc') {
         $maxred=26;          $maxred=26;
         $realm='User';          $realm='User';
     } else {  
         $maxred=26;  
         $realm='Course';  
     }      }
     my $maxyellow=52-$maxred;      #
     my $tabledata=      # Column label
         '<table border=2><tr><th colspan=2 rowspan=2><font size=+2>'.      my $tabledata;
                   $realm.'</font></th>'.      if ($ENV{'form.showcsv'}) {
           $tabledata='<pre>';
       } else { 
           $tabledata='<table border=2><tr><th colspan=2 rowspan=2>'.
               '<font size=+2>'.$realm.'</font></th>'.
                   '<td bgcolor=#FFDDDD colspan='.$maxred.                    '<td bgcolor=#FFDDDD colspan='.$maxred.
                   '><b><font size=+1>Import</font></b></td>'.                    '><b><font size=+1>Import</font></b></td>'.
                   '<td colspan='.$maxyellow.                    '<td colspan='.(52-$maxred).
   '><b><font size=+1>Calculations</font></b></td></tr><tr>';    '><b><font size=+1>Calculations</font></b></td></tr><tr>';
     my $showf=0;          my $showf=0;
     map {          foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
         $showf++;                   'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
         if ($showf<=$maxred) {                    'a','b','c','d','e','f','g','h','i','j','k','l','m',
            $tabledata.='<td bgcolor="#FFDDDD">';                    'n','o','p','q','r','s','t','u','v','w','x','y','z') {
         } else {              $showf++;
            $tabledata.='<td>';              if ($showf<=$maxred) { 
                   $tabledata.='<td bgcolor="#FFDDDD">'; 
               } else {
                   $tabledata.='<td>';
               }
               $tabledata.="<b><font size=+1>$_</font></b></td>";
         }          }
         $tabledata.="<b><font size=+1>$_</font></b></td>";          $tabledata.='</tr>'.&rown($safeeval,'-',$sheetdata).
     } ('A','B','C','D','E','F','G','H','I','J','K','L','M',              &rown($safeeval,0,$sheetdata);
        'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',      }
        'a','b','c','d','e','f','g','h','i','j','k','l','m',  
        'n','o','p','q','r','s','t','u','v','w','x','y','z');  
     $tabledata.='</tr>';  
     my $row;  
     my $maxrow=&getmaxrow($safeeval);  
     $tabledata.=&rown($safeeval,'-');  
     $r->print($tabledata);      $r->print($tabledata);
     for ($row=0;$row<=$maxrow;$row++) {      #
         $r->print(&rown($safeeval,$row));      # Prepare to output rows
       my $row;
       my $maxrow=$sheetdata->{'maxrow'};
       #
       my @sortby=();
       my @sortidx=();
       for ($row=1;$row<=$maxrow;$row++) {
           push (@sortby, $safeeval->reval('$f{"A'.$row.'"}'));
           push (@sortidx, $row-1);
       }
       @sortidx=sort { lc($sortby[$a]) cmp lc($sortby[$b]); } @sortidx;
       #
       # Determine the type of child spreadsheets
       my $what='Student';
       if ($sheetdata->{'sheettype'} eq 'assesscalc') {
           $what='Item';
       } elsif ($sheetdata->{'sheettype'} eq 'studentcalc') {
           $what='Assessment';
       }
       #
       # Loop through the rows and output them one at a time
       my $n=0;
       for ($row=0;$row<$maxrow;$row++) {
           my $thisrow=&rown($safeeval,$sortidx[$row]+1,$sheetdata);
           if ($thisrow) {
               if (($n/25==int($n/25)) && (!$ENV{'form.showcsv'})) {
                   $r->print("</table>\n<br>\n");
                   $r->rflush();
                   $r->print('<table border=2><tr><td>&nbsp;<td>'.$what.'</td>');
                   $r->print('<td>'.
                             join('</td><td>',
                                  (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
                                         'abcdefghijklmnopqrstuvwxyz'))).
                             "</td></tr>\n");
               }
               $n++;
               $r->print($thisrow);
           }
     }      }
     $r->print('</table>');      $r->print($ENV{'form.showcsv'}?'</pre>':'</table>');
 }  }
   
 #  #
 # -------------------------------------- Read spreadsheet formulas for a course  # ----------------------------------------------- Read list of available sheets
 #  # 
   sub othersheets {
 sub readsheet {      my ($safeeval,$stype,$sheetdata)=@_;
   my ($safeeval,$fn)=@_;      #
   my $stype=&gettype($safeeval);      my $cnum  = $sheetdata->{'cnum'};
   my $cnum=&getcnum($safeeval);      my $cdom  = $sheetdata->{'cdom'};
   my $cdom=&getcdom($safeeval);      my $chome = $sheetdata->{'chome'};
   my $chome=&getchome($safeeval);      #
       my @alternatives=();
 # --------- There is no filename. Look for defaults in course and global, cache      my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum);
       my ($tmp) = keys(%results);
   unless($fn) {      unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
       unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {          @alternatives = sort (keys(%results));
          $fn=&Apache::lonnet::reply('get:'.$cdom.':'.$cnum.      }
                                     ':environment:spreadsheet_default_'.$stype,      return @alternatives; 
                                     $chome);  }
          unless (($fn) && ($fn!~/^error\:/)) {  
      $fn='default_'.$stype;  
          }  
          $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn;   
       }  
   }  
   
 # ---------------------------------------------------------- fn now has a value  
   
   &setfilename($safeeval,$fn);  #
   # -------------------------------------- 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;
   }
   
 # ------------------------------------------------------ see if sheet is cached  #
   my $fstring='';  # -------------------------------------- Read spreadsheet formulas for a course
   if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) {  #
       &setformulas($safeeval,split(/\_\_\_\;\_\_\_/,$fstring));  sub readsheet {
   } else {      my ($safeeval,$sheetdata,$fn)=@_;
       #
 # ---------------------------------------------------- Not cached, need to read      my $stype = $sheetdata->{'sheettype'};
       my $cnum  = $sheetdata->{'cnum'};
      my %f=();      my $cdom  = $sheetdata->{'cdom'};
       my $chome = $sheetdata->{'chome'};
      if ($fn=~/^default\_/) {      #
  my $sheetxml='';      if (! defined($fn)) {
        {          # There is no filename. Look for defaults in course and global, cache
          my $fh;          unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {
          if ($fh=Apache::File->new($includedir.              my %tmphash = &Apache::lonnet::get('environment',
                          '/default.'.&gettype($safeeval))) {                                                 ['spreadsheet_default_'.$stype],
                $sheetxml=join('',<$fh>);                                                 $cdom,$cnum);
           }              my ($tmp) = keys(%tmphash);
        }              if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
         my $parser=HTML::TokeParser->new(\$sheetxml);                  $fn = 'default_'.$stype;
         my $token;              } else {
         while ($token=$parser->get_token) {                  $fn = $tmphash{'spreadsheet_default_'.$stype};
           if ($token->[0] eq 'S') {              } 
       if ($token->[1] eq 'field') {              unless (($fn) && ($fn!~/^error\:/)) {
   $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=                  $fn='default_'.$stype;
       $parser->get_text('/field');              }
       }              $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 
              if ($token->[1] eq 'template') {          }
                  $f{'template_'.$token->[2]->{'col'}}=      }
                      $parser->get_text('/template');      # $fn now has a value
              }      $sheetdata->{'filename'} = $fn;
           }      # see if sheet is cached
         }      my $fstring='';
       } else {      if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) {
           my $sheet='';          &setformulas($safeeval,split(/\_\_\_\;\_\_\_/,$fstring));
           my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'.$fn,      } else {
                                          $chome);          # Not cached, need to read
           unless ($reply=~/^error\:/) {          my %f=();
              $sheet=$reply;          if ($fn=~/^default\_/) {
   }              my $sheetxml='';
           map {              my $fh;
              my ($name,$value)=split(/\=/,$_);              my $dfn=$fn;
              $f{&Apache::lonnet::unescape($name)}=              $dfn=~s/\_/\./g;
         &Apache::lonnet::unescape($value);              if ($fh=Apache::File->new($includedir.'/'.$dfn)) {
           } split(/\&/,$sheet);                  $sheetxml=join('',<$fh>);
        }              } else {
 # --------------------------------------------------------------- Cache and set                  $sheetxml='<field row="0" col="A">"Error"</field>';
        $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);                }
        &setformulas($safeeval,%f);              %f=%{&parse_sheet(\$sheetxml)};
           } elsif($fn=~/\/*\.spreadsheet$/) {
               my $sheetxml=&Apache::lonnet::getfile
                   (&Apache::lonnet::filelocation('',$fn));
               if ($sheetxml == -1) {
                   $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{$_};
                   }
               }
           }
           # Cache and set
           $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);  
           &setformulas($safeeval,%f);
     }      }
 }  }
   
 # -------------------------------------------------------- Make new spreadsheet  # -------------------------------------------------------- Make new spreadsheet
   
 sub makenewsheet {  sub makenewsheet {
     my ($uname,$udom,$stype,$usymb)=@_;      my ($uname,$udom,$stype,$usymb)=@_;
       my %sheetdata=();
       $sheetdata{'uname'} = $uname;
       $sheetdata{'udom'}  = $udom;
       $sheetdata{'sheettype'} = $stype;
       $sheetdata{'usymb'} = $usymb;
       $sheetdata{'cid'}   = $ENV{'request.course.id'};
       $sheetdata{'csec'}  = $Section{$uname.':'.$udom};
       $sheetdata{'coursefilename'}   = $ENV{'request.course.fn'};
       $sheetdata{'cnum'}  = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
       $sheetdata{'cdom'}  = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
       $sheetdata{'chome'} = $ENV{'course.'.$ENV{'request.course.id'}.'.home'};
       $sheetdata{'uhome'} = &Apache::lonnet::homeserver($uname,$udom);
       
     my $safeeval=initsheet($stype);      my $safeeval=initsheet($stype);
     $safeeval->reval(      #
        '$uname="'.$uname.      # Place all the %sheetdata items into the safe space
       '";$udom="'.$udom.      my $initstring = '';
       '";$uhome="'.&Apache::lonnet::homeserver($uname,$udom).      foreach (keys(%sheetdata)) {
       '";$sheettype="'.$stype.          $initstring.= qq{\$$_="$sheetdata{$_}";};
       '";$usymb="'.$usymb.      }
       '";$csec="'.&Apache::lonnet::usection($udom,$uname,      $safeeval->reval($initstring);
                                             $ENV{'request.course.id'}).      return $safeeval,\%sheetdata;
       '";$cid="'.$ENV{'request.course.id'}.  
       '";$cfn="'.$ENV{'request.course.fn'}.  
       '";$cnum="'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.  
       '";$cdom="'.$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.  
       '";$chome="'.$ENV{'course.'.$ENV{'request.course.id'}.'.home'}.'";');  
     return $safeeval;  
 }  }
   
 # ------------------------------------------------------------ Save spreadsheet  # ------------------------------------------------------------ Save spreadsheet
   
 sub writesheet {  sub writesheet {
   my ($safeeval,$makedef)=@_;      my ($safeeval,$makedef,$sheetdata)=@_;
   my $cid=&getcid($safeeval);      my $cid=$sheetdata->{'cid'};
   if (&Apache::lonnet::allowed('opa',$cid)) {      if (&Apache::lonnet::allowed('opa',$cid)) {
     my %f=&getformulas($safeeval);          my %f=&getformulas($safeeval);
     my $stype=&gettype($safeeval);          my $stype= $sheetdata->{'sheettype'};
     my $cnum=&getcnum($safeeval);          my $cnum = $sheetdata->{'cnum'};
     my $cdom=&getcdom($safeeval);          my $cdom = $sheetdata->{'cdom'};
     my $chome=&getchome($safeeval);          my $chome= $sheetdata->{'chome'};
     my $fn=&getfilename($safeeval);          my $fn   = $sheetdata->{'filename'};
           # Cache new sheet
 # ------------------------------------------------------------- Cache new sheet          $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
     $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);              # Write sheet
 # ----------------------------------------------------------------- Write sheet          my $sheetdata='';
     my $sheetdata='';          foreach (keys(%f)) {
     map {              unless ($f{$_} eq 'import') {
        $sheetdata.=&Apache::lonnet::escape($_).'='.                  $sheetdata.=&Apache::lonnet::escape($_).'='.
    &Apache::lonnet::escape($f{$_}).'&';                      &Apache::lonnet::escape($f{$_}).'&';
     } keys %f;              }
     $sheetdata=~s/\&$//;          }
     my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'.          $sheetdata=~s/\&$//;
               $sheetdata,$chome);          my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'.
     if ($reply eq 'ok') {                                           $sheetdata,$chome);
           $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.          if ($reply eq 'ok') {
               $stype.'_spreadsheets:'.              $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.
               &Apache::lonnet::escape($fn).'='.$ENV{'user.name'},                                            $stype.'_spreadsheets:'.
               $chome);                                            &Apache::lonnet::escape($fn).
           if ($reply eq 'ok') {                                            '='.$ENV{'user.name'}.'@'.
               if ($makedef) {                                             $ENV{'user.domain'},
                 return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum.                                            $chome);
                                 ':environment:spreadsheet_default_'.$stype.'='.              if ($reply eq 'ok') {
                                 &Apache::lonnet::escape($fn),                  if ($makedef) { 
                                 $chome);                      return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum.
       } else {                                                    ':environment:'.
   return $reply;                                                    'spreadsheet_default_'.
          }                                                    $stype.'='.
    } else {                                                    &Apache::lonnet::escape($fn),
        return $reply;                                                    $chome);
            }                  } 
       } else {                  return $reply;
   return $reply;              } 
       }              return $reply;
   }          } 
   return 'unauthorized';          return $reply;
       }
       return 'unauthorized';
 }  }
   
 # ----------------------------------------------- Make a temp copy of the sheet  # ----------------------------------------------- Make a temp copy of the sheet
 # "Modified workcopy" - interactive only  # "Modified workcopy" - interactive only
 #  #
   
 sub tmpwrite {  sub tmpwrite {
     my $safeeval=shift;      my ($safeeval,$sheetdata) = @_;
     my $fn=$ENV{'user.name'}.'_'.      my $fn=$ENV{'user.name'}.'_'.
            $ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'.          $ENV{'user.domain'}.'_spreadsheet_'.$sheetdata->{'usymb'}.'_'.
            &getfilename($safeeval);             $sheetdata->{'filename'};
     $fn=~s/\W/\_/g;      $fn=~s/\W/\_/g;
     $fn=$tmpdir.$fn.'.tmp';      $fn=$tmpdir.$fn.'.tmp';
     my $fh;      my $fh;
Line 883  sub tmpwrite { Line 1437  sub tmpwrite {
 }  }
   
 # ---------------------------------------------------------- Read the temp copy  # ---------------------------------------------------------- Read the temp copy
   
 sub tmpread {  sub tmpread {
     my ($safeeval,$nfield,$nform)=@_;      my ($safeeval,$sheetdata,$nfield,$nform)=@_;
     my $fn=$ENV{'user.name'}.'_'.      my $fn=$ENV{'user.name'}.'_'.
            $ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'.             $ENV{'user.domain'}.'_spreadsheet_'.$sheetdata->{'usymb'}.'_'.
            &getfilename($safeeval);             $sheetdata->{'filename'};
     $fn=~s/\W/\_/g;      $fn=~s/\W/\_/g;
     $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 900  sub tmpread { Line 1454  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') {
           $fo{'A'.$nfield}=(split(/\_\_\&\&\&\_\_/,$fo{'A'.$nfield}))[0];
           unless ($ENV{'form.sel_'.$nfield} eq 'Default') {
       $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 {
          if ($nfield) { $fo{$nfield}=$nform; }
     }      }
     if ($nfield) { $fo{$nfield}=$nform; }  
     &setformulas($safeeval,%fo);      &setformulas($safeeval,%fo);
 }  }
   
 # ================================================================== Parameters  ##################################################
 # -------------------------------------------- Figure out a cascading parameter  ##################################################
 #  
 # For this function to work  
 #  
 # * parmhash needs to be tied  
 # * courseopt and useropt need to be initialized for this user and course  
 #  
   
 sub parmval {  
     my ($what,$safeeval)=@_;  
     my $cid=&getcid($safeeval);  
     my $csec=&getcsec($safeeval);  
     my $uname=&getuname($safeeval);  
     my $udom=&getudom($safeeval);  
     my $symb=&getusymb($safeeval);  
   
     unless ($symb) { return ''; }  
     my $result='';  
   
     my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);  
 # ----------------------------------------------------- Cascading lookup scheme  
        my $rwhat=$what;  
        $what=~s/^parameter\_//;  
        $what=~s/\_/\./;  
   
        my $symbparm=$symb.'.'.$what;  
        my $mapparm=$mapname.'___(all).'.$what;  
        my $usercourseprefix=$uname.'_'.$udom.'_'.$cid;  
   
        my $seclevel=  =pod
             $usercourseprefix.'.['.  
  $csec.'].'.$what;  
        my $seclevelr=  
             $usercourseprefix.'.['.  
  $csec.'].'.$symbparm;  
        my $seclevelm=  
             $usercourseprefix.'.['.  
  $csec.'].'.$mapparm;  
   
        my $courselevel=  =item &parmval()
             $usercourseprefix.'.'.$what;  
        my $courselevelr=  
             $usercourseprefix.'.'.$symbparm;  
        my $courselevelm=  
             $usercourseprefix.'.'.$mapparm;  
   
 # ---------------------------------------------------------- fourth, check user  Determine the value of a parameter.
         
       if ($uname) {   
   
        if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; }  Inputs: $what, the parameter needed, $safeeval, the safe space
   
        if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; }  Returns: The value of a parameter, or '' if none.
   
        if ($useropt{$courselevel}) { return $useropt{$courselevel}; }  This function cascades through the possible levels searching for a value for
   a parameter.  The levels are checked in the following order:
   user, course (at section level and course level), map, and lonnet::metadata.
   This function uses %parmhash, which must be tied prior to calling it.
   This function also requires %courseopt and %useropt to be initialized for
   this user and course.
   
       }  =cut
   
 # --------------------------------------------------------- third, check course  ##################################################
        ##################################################
        if ($csec) {  sub parmval {
        my ($what,$safeeval,$sheetdata)=@_;
         if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; }      my $symb  = $sheetdata->{'usymb'};
       unless ($symb) { return ''; }
         if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; }        #
       my $cid   = $sheetdata->{'cid'};
         if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }      my $csec  = $sheetdata->{'csec'};
         my $uname = $sheetdata->{'uname'};
       }      my $udom  = $sheetdata->{'udom'};
       my $result='';
        if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; }      #
       my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
        if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }      # Cascading lookup scheme
       my $rwhat=$what;
        if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }      $what =~ s/^parameter\_//;
       $what =~ s/\_([^\_]+)$/\.$1/;
 # ----------------------------------------------------- second, check map parms      #
       my $symbparm = $symb.'.'.$what;
        my $thisparm=$parmhash{$symbparm};      my $mapparm  = $mapname.'___(all).'.$what;
        if ($thisparm) { return $thisparm; }      my $usercourseprefix = $uname.'_'.$udom.'_'.$cid;
       #
 # -------------------------------------------------------- first, check default      my $seclevel  = $usercourseprefix.'.['.$csec.'].'.$what;
       my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm;
        return &Apache::lonnet::metadata($fn,$rwhat.'.default');      my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm;
               #
       my $courselevel  = $usercourseprefix.'.'.$what;
       my $courselevelr = $usercourseprefix.'.'.$symbparm;
       my $courselevelm = $usercourseprefix.'.'.$mapparm;
       # fourth, check user
       if (defined($uname)) {
           return $useropt{$courselevelr} if (defined($useropt{$courselevelr}));
           return $useropt{$courselevelm} if (defined($useropt{$courselevelm}));
           return $useropt{$courselevel}  if (defined($useropt{$courselevel}));
       }
       # third, check course
       if (defined($csec)) {
           return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr}));
           return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm}));
           return $courseopt{$seclevel}  if (defined($courseopt{$seclevel}));
       }
       #
       return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr}));
       return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm}));
       return $courseopt{$courselevel}  if (defined($courseopt{$courselevel}));
       # second, check map parms
       my $thisparm = $parmhash{$symbparm};
       return $thisparm if (defined($thisparm));
       # first, check default
       return &Apache::lonnet::metadata($fn,$rwhat.'.default');
 }  }
   
 # ---------------------------------------------- Update rows for course listing  # ---------------------------------------------- Update rows for course listing
   
 sub updateclasssheet {  sub updateclasssheet {
     my $safeeval=shift;      my ($safeeval,$sheetdata) = @_;
     my $cnum=&getcnum($safeeval);      my $cnum  =$sheetdata->{'cnum'};
     my $cdom=&getcdom($safeeval);      my $cdom  =$sheetdata->{'cdom'};
     my $cid=&getcid($safeeval);      my $cid   =$sheetdata->{'cid'};
     my $chome=&getchome($safeeval);      my $chome =$sheetdata->{'chome'};
       #
 # ---------------------------------------------- Read class list and row labels      %Section = ();
   
     my $classlst=&Apache::lonnet::reply      #
                                  ('dump:'.$cdom.':'.$cnum.':classlist',$chome);      # Read class list and row labels
       my %classlist;
       my @tmp = &Apache::lonnet::dump('classlist',$cdom,$cnum);
       if ($tmp[0] !~ /^error/) {
           %classlist = @tmp;
       } else {
           return 'Could not access course data';
       }
       undef @tmp;
       #
     my %currentlist=();      my %currentlist=();
     my $now=time;      my $now=time;
     unless ($classlst=~/^error\:/) {      foreach my $student (keys(%classlist)) {
         map {          my ($end,$start)=split(/\:/,$classlist{$student});
             my ($name,$value)=split(/\=/,$_);          my $active=1;
             my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));          $active = 0 if (($end) && ($now>$end));
             my $active=1;          $active = 1 if ($ENV{'form.Status'} eq 'Any');
             if (($end) && ($now>$end)) { $active=0; }          $active = !$active if ($ENV{'form.Status'} eq 'Expired');
             if ($active) {          if ($active) {
                 my $rowlabel='';              my $rowlabel='';
                 $name=&Apache::lonnet::unescape($name);              my ($studentName,$studentDomain)=split(/\:/,$student);
                 my ($sname,$sdom)=split(/\:/,$name);              my $studentSection=&Apache::lonnet::usection($studentDomain,
                 my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);                                                           $studentName,$cid);
                 if ($ssec==-1) {              $Section{$studentName.':'.$studentDomain} = $studentSection;
                     $rowlabel='<font color=red>Data not available: '.$name.  #            if ($studentSection==-1) {
       '</font>';  #                unless ($ENV{'form.showcsv'}) {
                 } else {  #                    $rowlabel='<font color=red>Data not available: '.
                     my %reply=&Apache::lonnet::idrget($sdom,$sname);  #                        $studentName.'</font>';
                     my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.  #                } else {
       ':environment:firstname&middlename&lastname&generation',  #                    $rowlabel='ERROR","'.$studentName.
                       &Apache::lonnet::homeserver($sname,$sdom));  #                        '","Data not available","","","';
                     $rowlabel='<a href="/adm/studentcalc?uname='.$sname.  #                }
                               '&udom='.$sdom.'">'.  #            } else {
                               $ssec.'&nbsp;'.$reply{$sname}.'<br>';                  my %reply=&Apache::lonnet::idrget($studentDomain,$studentName);
                     map {                  my %studentInformation=&Apache::lonnet::get
                         $rowlabel.=&Apache::lonnet::unescape($_).' ';                      ('environment',
                     } split(/\&/,$reply);                       ['lastname','generation','firstname','middlename','id'],
                        $studentDomain,$studentName);
                   if (! $ENV{'form.showcsv'}) {
                       $rowlabel='<a href="/adm/studentcalc?uname='.$studentName.
                           '&udom='.$studentDomain.'">'.
                               $studentSection.'&nbsp;';
                       foreach ('id','firstname','middlename',
                                'lastname','generation'){
                           $rowlabel.=$studentInformation{$_}."&nbsp;";
                       }
                     $rowlabel.='</a>';                      $rowlabel.='</a>';
                   } else {
                       $rowlabel= '"'.join('","',
                                           ($studentSection,
                                            $studentInformation{'id'},
                                            $studentInformation{'firstname'},
                                            $studentInformation{'middlename'},
                                            $studentInformation{'lastname'},
                                            $studentInformation{'generation'})
                                           ).'"';
                 }                  }
  $currentlist{&Apache::lonnet::unescape($name)}=$rowlabel;   #           }
             }              $currentlist{$student}=$rowlabel;
         } split(/\&/,$classlst);          } # end of if ($active)
 #      } # end of foreach my $student (keys(%classlist))
 # -------------------- Find discrepancies between the course row table and this      #
 #      # Find discrepancies between the course row table and this
         my %f=&getformulas($safeeval);      #
         my $changed=0;      my %f=&getformulas($safeeval);
       my $changed=0;
         my $maxrow=0;      #
         my %existing=();      my $maxrow=0;
       my %existing=();
 # ----------------------------------------------------------- Now obsolete rows      #
  map {      # Now obsolete rows
     if ($_=~/^A(\d+)/) {      foreach (keys(%f)) {
                 $maxrow=($1>$maxrow)?$1:$maxrow;          if ($_=~/^A(\d+)/) {
                 $existing{$f{$_}}=1;              $maxrow=($1>$maxrow)?$1:$maxrow;
  unless ((defined($currentlist{$f{$_}})) || (!$1)) {              $existing{$f{$_}}=1;
    $f{$_}='!!! Obsolete';              unless ((defined($currentlist{$f{$_}})) || (!$1) ||
                    $changed=1;                      ($f{$_}=~/^(\~\~\~|\-\-\-)/)) {
                 }                  $f{$_}='!!! Obsolete';
                   $changed=1;
             }              }
         } keys %f;          }
       }
 # -------------------------------------------------------- New and unknown keys      #
            # New and unknown keys
         map {      foreach (sort keys(%currentlist)) {
             unless ($existing{$_}) {          unless ($existing{$_}) {
  $changed=1;              $changed=1;
                 $maxrow++;              $maxrow++;
                 $f{'A'.$maxrow}=$_;              $f{'A'.$maxrow}=$_;
             }          }
         } sort keys %currentlist;          
        
         if ($changed) { &setformulas($safeeval,%f); }  
   
         &setmaxrow($safeeval,$maxrow);  
         &setrowlabels($safeeval,%currentlist);  
   
     } else {  
         return 'Could not access course data';  
     }      }
       if ($changed) { &setformulas($safeeval,%f); }
       #
       $sheetdata->{'maxrow'} = $maxrow;
       &setrowlabels($safeeval,%currentlist);
 }  }
   
 # ----------------------------------- Update rows for student and assess sheets  # ----------------------------------- Update rows for student and assess sheets
   
 sub updatestudentassesssheet {  sub updatestudentassesssheet {
     my $safeeval=shift;      my ($safeeval,$sheetdata) = @_;
     my %bighash;      my %bighash;
     my $stype=&gettype($safeeval);      my $stype=$sheetdata->{'sheettype'};
       my $uname=$sheetdata->{'uname'};
       my $udom =$sheetdata->{'udom'};
     my %current=();      my %current=();
     unless ($updatedata{$ENV{'request.course.fn'}.'_'.$stype}) {      if  ($updatedata
 # -------------------------------------------------------------------- Tie hash           {$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}) {
       if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',          %current=split(/\_\_\_\;\_\_\_/,
                        &GDBM_READER,0640)) {                         $updatedata{$ENV{'request.course.fn'}.
 # --------------------------------------------------------- Get all assessments                                         '_'.$stype.'_'.$uname.'_'.$udom});
       } else {
  my %allkeys=('timestamp' =>           # Tie hash
                      'Timestamp of Last Transaction<br>timestamp');          tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
         my %allassess=();              &GDBM_READER(),0640);
           if (! tied(%bighash)) {
               return 'Could not access course data';
           }
           # Get all assessments
           my %allkeys=('timestamp' => 
                        'Timestamp of Last Transaction<br>timestamp',
                        'subnumber' =>
                        'Number of Submissions<br>subnumber',
                        'tutornumber' =>
                        'Number of Tutor Responses<br>tutornumber',
                        'totalpoints' =>
                        'Total Points Granted<br>totalpoints');
         my $adduserstr='';          my $adduserstr='';
         if ((&getuname($safeeval) ne $ENV{'user.name'}) ||          if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})){
             (&getudom($safeeval) ne $ENV{'user.domain'})) {              $adduserstr='&uname='.$uname.'&udom='.$udom;
             $adduserstr='&uname='.&getuname($safeeval).          }
  '&udom='.&getudom($safeeval);          my %allassess =
         }              ('_feedback' =>'<a href="/adm/assesscalc?usymb=_feedback'.
                $adduserstr.'">Feedback</a>',
         map {               '_evaluation' =>'<a href="/adm/assesscalc?usymb=_evaluation'.
     if ($_=~/^src\_(\d+)\.(\d+)$/) {               $adduserstr.'">Evaluation</a>',
        my $mapid=$1;               '_tutoring' =>'<a href="/adm/assesscalc?usymb=_tutoring'.
                my $resid=$2;               $adduserstr.'">Tutoring</a>',
                my $id=$mapid.'.'.$resid;               '_discussion' =>'<a href="/adm/assesscalc?usymb=_discussion'.
                my $srcf=$bighash{$_};               $adduserstr.'">Discussion</a>'
                if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {               );
                  my $symb=          while (($_,undef) = each(%bighash)) {
                      &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).              next if ($_!~/^src\_(\d+)\.(\d+)$/);
     '___'.$resid.'___'.              my $mapid=$1;
     &Apache::lonnet::declutter($srcf);              my $resid=$2;
  $allassess{$symb}=              my $id=$mapid.'.'.$resid;
             '<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'.              my $srcf=$bighash{$_};
                      $bighash{'title_'.$id}.'</a>';              if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
                  if ($stype eq 'assesscalc') {                  my $symb=
                    map {                      &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
                        if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) {                          '___'.$resid.'___'.&Apache::lonnet::declutter($srcf);
   my $key=$_;                  $allassess{$symb}=
                           my $display=                      '<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'.
       &Apache::lonnet::metadata($srcf,$key.'.display');                          $bighash{'title_'.$id}.'</a>';
                           unless ($display) {                  next if ($stype ne 'assesscalc');
                               $display.=                  foreach my $key (split(/\,/,
          &Apache::lonnet::metadata($srcf,$key.'.name');                                         &Apache::lonnet::metadata($srcf,'keys')
                           }                                         )) {
                           $display.='<br>'.$key;                      next if ($key !~ /^(stores|parameter)_/);
                           $allkeys{$key}=$display;                      my $display=
        }                          &Apache::lonnet::metadata($srcf,$key.'.display');
                    } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));                      unless ($display) {
          }                          $display.=
       }                              &Apache::lonnet::metadata($srcf,$key.'.name');
    }                      }
         } keys %bighash;                      $display.='<br>'.$key;
                       $allkeys{$key}=$display;
                   } # end of foreach
               }
           } # end of foreach (keys(%bighash))
         untie(%bighash);          untie(%bighash);
               #
 #          # %allkeys has a list of storage and parameter displays by unikey
 # %allkeys has a list of storage and parameter displays by unikey          # %allassess has a list of all resource displays by symb
 # %allassess has a list of all resource displays by symb          #
 #  
   
         if ($stype eq 'assesscalc') {          if ($stype eq 'assesscalc') {
     %current=%allkeys;              %current=%allkeys;
         } elsif ($stype eq 'studentcalc') {          } elsif ($stype eq 'studentcalc') {
             %current=%allassess;              %current=%allassess;
         }          }
         $updatedata{$ENV{'request.course.fn'}.'_'.$stype}=          $updatedata{$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}=
     join('___;___',%current);              join('___;___',%current);
     } else {          # Get current from cache
         return 'Could not access course data';  
     }  
 # ------------------------------------------------------ Get current from cache  
     } else {  
         %current=split(/\_\_\_\;\_\_\_/,  
        $updatedata{$ENV{'request.course.fn'}.'_'.$stype});  
     }      }
 # -------------------- Find discrepancies between the course row table and this      # Find discrepancies between the course row table and this
 #      #
         my %f=&getformulas($safeeval);      my %f=&getformulas($safeeval);
         my $changed=0;      my $changed=0;
   
         my $maxrow=0;  
         my %existing=();  
   
 # ----------------------------------------------------------- Now obsolete rows  
  map {  
     if ($_=~/^A(\d+)/) {  
                 $maxrow=($1>$maxrow)?$1:$maxrow;  
                 $existing{$f{$_}}=1;  
  unless ((defined($current{$f{$_}})) || (!$1)) {  
    $f{$_}='!!! Obsolete';  
                    $changed=1;  
                 }  
             }  
         } keys %f;  
   
 # -------------------------------------------------------- New and unknown keys  
        
         map {  
             unless ($existing{$_}) {  
  $changed=1;  
                 $maxrow++;  
                 $f{'A'.$maxrow}=$_;  
             }  
         } keys %current;          
           
         if ($changed) { &setformulas($safeeval,%f); }      my $maxrow=0;
       my %existing=();
         &setmaxrow($safeeval,$maxrow);      # Now obsolete rows
         &setrowlabels($safeeval,%current);      foreach (keys(%f)) {
            next if ($_!~/^A(\d+)/);
         undef %current;          $maxrow=($1>$maxrow)?$1:$maxrow;
         undef %existing;          my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});
           $existing{$usy}=1;
           unless ((defined($current{$usy})) || (!$1) ||
                   ($f{$_}=~/^(\~\~\~|\-\-\-)/)){
               $f{$_}='!!! Obsolete';
               $changed=1;
           } elsif ($ufn) {
               $current{$usy}
               =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/;
           }
       }
       # New and unknown keys
       foreach (keys(%current)) {
           unless ($existing{$_}) {
               $changed=1;
               $maxrow++;
               $f{'A'.$maxrow}=$_;
           }
       }
       if ($changed) { &setformulas($safeeval,%f); }
       $sheetdata->{'maxrow'} = $maxrow;
       &setrowlabels($safeeval,%current);
       #
       undef %current;
       undef %existing;
 }  }
   
 # ------------------------------------------------ Load data for one assessment  # ------------------------------------------------ Load data for one assessment
   
 sub loadstudent {  sub loadstudent {
     my $safeeval=shift;      my ($safeeval,$sheetdata)=@_;
     my %c=();      my %c=();
     my %f=&getformulas($safeeval);      my %f=&getformulas($safeeval);
     $cachedassess=&getuname($safeeval).':'.&getudom($safeeval);      $cachedassess=$sheetdata->{'uname'}.':'.$sheetdata->{'udom'};
     %cachedstores=();      # Get ALL the student preformance data
     {      my @tmp = &Apache::lonnet::dump($sheetdata->{'cid'},
       my $reply=&Apache::lonnet::reply('dump:'.&getudom($safeeval).':'.                                      $sheetdata->{'udom'},
                                                &getuname($safeeval).':'.                                      $sheetdata->{'uname'},
                                                &getcid($safeeval),                                      undef);
                                                &getuhome($safeeval));      if ($tmp[0] !~ /^error:/) {
       unless ($reply=~/^error\:/) {          %cachedstores = @tmp;
          map {  
             my ($name,$value)=split(/\=/,$_);  
             $cachedstores{&Apache::lonnet::unescape($name)}=  
                   &Apache::lonnet::unescape($value);  
          } split(/\&/,$reply);  
       }  
     }      }
       undef @tmp;
       # 
     my @assessdata=();      my @assessdata=();
     map {      foreach (keys(%f)) {
  if ($_=~/^A(\d+)/) {   next if ($_!~/^A(\d+)/);
    my $row=$1;          my $row=$1;
            unless (($f{$_}=~/^\!/) || ($row==0)) {          next if (($f{$_}=~/^[\!\~\-]/) || ($row==0));
       @assessdata=&exportsheet(&getuname($safeeval),          my ($usy,$ufn)=split(/__&&&\__/,$f{$_});
                                        &getudom($safeeval),          @assessdata=&exportsheet($sheetdata->{'uname'},
                                        'assesscalc',$f{$_});                                   $sheetdata->{'udom'},
               my $index=0;                                   'assesscalc',$usy,$ufn);
               map {          my $index=0;
                   if ($assessdata[$index]) {          foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
      my $col=$_;                   'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
      if ($assessdata[$index]=~/\D/) {              if ($assessdata[$index]) {
                          $c{$col.$row}="'".$assessdata[$index]."'";                  my $col=$_;
       } else {                  if ($assessdata[$index]=~/\D/) {
          $c{$col.$row}=$assessdata[$index];                      $c{$col.$row}="'".$assessdata[$index]."'";
      }                  } else {
                      unless ($col eq 'A') {                       $c{$col.$row}=$assessdata[$index];
  $f{$col.$row}='import';                  }
                      }                  unless ($col eq 'A') { 
   }                      $f{$col.$row}='import';
                   $index++;                  }
               } ('A','B','C','D','E','F','G','H','I','J','K','L','M',              }
                  'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');              $index++;
    }  
         }          }
     } keys %f;      }
     $cachedassess='';      $cachedassess='';
     undef %cachedstores;      undef %cachedstores;
     &setformulas($safeeval,%f);      &setformulas($safeeval,%f);
Line 1252  sub loadstudent { Line 1837  sub loadstudent {
 }  }
   
 # --------------------------------------------------- Load data for one student  # --------------------------------------------------- Load data for one student
   #
 sub loadcourse {  sub loadcourse {
     my ($safeeval,$r)=@_;      my ($safeeval,$sheetdata,$r)=@_;
     my %c=();      my %c=();
     my %f=&getformulas($safeeval);      my %f=&getformulas($safeeval);
     my $total=0;      my $total=0;
     map {      foreach (keys(%f)) {
  if ($_=~/^A(\d+)/) {   if ($_=~/^A(\d+)/) {
     unless ($f{$_}=~/^\!/) { $total++; }      unless ($f{$_}=~/^[\!\~\-]/) { $total++; }
         }          }
     } keys %f;      }
     my $now=0;      my $now=0;
     my $since=time;      my $since=time;
     $r->print(<<ENDPOP);      $r->print(<<ENDPOP);
Line 1277  sub loadcourse { Line 1862  sub loadcourse {
 </script>  </script>
 ENDPOP  ENDPOP
     $r->rflush();      $r->rflush();
     map {      foreach (keys(%f)) {
  if ($_=~/^A(\d+)/) {   next if ($_!~/^A(\d+)/);
    my $row=$1;          my $row=$1;
            unless (($f{$_}=~/^\!/)  || ($row==0)) {          next if (($f{$_}=~/^[\!\~\-]/)  || ($row==0));
       my @studentdata=&exportsheet(split(/\:/,$f{$_}),          my @studentdata=&exportsheet(split(/\:/,$f{$_}),
                                            'studentcalc');                                       'studentcalc');
               undef %userrdatas;          undef %userrdatas;
               $now++;          $now++;
               $r->print('<script>popwin.document.popremain.remaining.value="'.          $r->print('<script>popwin.document.popremain.remaining.value="'.
                   $now.'/'.$total.': '.int((time-$since)/$now*($total-$now)).                    $now.'/'.$total.': '.int((time-$since)/$now*($total-$now)).
                         ' secs remaining";</script>');                    ' secs remaining";</script>');
               $r->rflush();           $r->rflush(); 
           #
               my $index=0;          my $index=0;
               map {          foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
                   if ($studentdata[$index]) {                   'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
      my $col=$_;              if ($studentdata[$index]) {
      if ($studentdata[$index]=~/\D/) {                  my $col=$_;
                          $c{$col.$row}="'".$studentdata[$index]."'";                  if ($studentdata[$index]=~/\D/) {
       } else {                      $c{$col.$row}="'".$studentdata[$index]."'";
          $c{$col.$row}=$studentdata[$index];                  } else {
      }                      $c{$col.$row}=$studentdata[$index];
                      unless ($col eq 'A') {                   }
  $f{$col.$row}='import';                  unless ($col eq 'A') { 
                      }                      $f{$col.$row}='import';
   }                  }
                   $index++;                  $index++;
               } ('A','B','C','D','E','F','G','H','I','J','K','L','M',              }
                  'N','O','P','Q','R','S','T','U','V','W','X','Y','Z');  
    }  
         }          }
     } keys %f;      }
     &setformulas($safeeval,%f);      &setformulas($safeeval,%f);
     &setconstants($safeeval,%c);      &setconstants($safeeval,%c);
     $r->print('<script>popwin.close()</script>');      $r->print('<script>popwin.close()</script>');
Line 1316  ENDPOP Line 1899  ENDPOP
 }  }
   
 # ------------------------------------------------ Load data for one assessment  # ------------------------------------------------ Load data for one assessment
   #
 sub loadassessment {  sub loadassessment {
     my $safeeval=shift;      my ($safeeval,$sheetdata)=@_;
   
     my $uhome=&getuhome($safeeval);      my $uhome = $sheetdata->{'uhome'};
     my $uname=&getuname($safeeval);      my $uname = $sheetdata->{'uname'};
     my $udom=&getudom($safeeval);      my $udom  = $sheetdata->{'udom'};
     my $symb=&getusymb($safeeval);      my $symb  = $sheetdata->{'usymb'};
     my $cid=&getcid($safeeval);      my $cid   = $sheetdata->{'cid'};
     my $cnum=&getcnum($safeeval);      my $cnum  = $sheetdata->{'cnum'};
     my $cdom=&getcdom($safeeval);      my $cdom  = $sheetdata->{'cdom'};
     my $chome=&getchome($safeeval);      my $chome = $sheetdata->{'chome'};
   
     my $namespace;      my $namespace;
     unless ($namespace=$cid) { return ''; }      unless ($namespace=$cid) { return ''; }
       # Get stored values
 # ----------------------------------------------------------- Get stored values      my %returnhash=();
       if ($cachedassess eq $uname.':'.$udom) {
    my %returnhash=();          #
           # get data out of the dumped stores
    if ($cachedassess eq $uname.':'.$udom) {          # 
 #          my $version=$cachedstores{'version:'.$symb};
 # get data out of the dumped stores          my $scope;
 #           for ($scope=1;$scope<=$version;$scope++) {
               foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) {
        my $version=$cachedstores{'version:'.$symb};                  $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};
        my $scope;              } 
        for ($scope=1;$scope<=$version;$scope++) {          }
            map {      } else {
                $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};          #
            } split(/\:/,$cachedstores{$scope.':keys:'.$symb});           # restore individual
        }          #
           %returnhash = &Apache::lonnet::restore($symb,$namespace,$udom,$uname);
    } else {          for (my $version=1;$version<=$returnhash{'version'};$version++) {
 #              foreach (split(/\:/,$returnhash{$version.':keys'})) {
 # restore individual                  $returnhash{$_}=$returnhash{$version.':'.$_};
 #              } 
           }
     my $answer=&Apache::lonnet::reply(  
        "restore:$udom:$uname:".  
        &Apache::lonnet::escape($namespace).":".  
        &Apache::lonnet::escape($symb),$uhome);  
     map {  
  my ($name,$value)=split(/\=/,$_);  
         $returnhash{&Apache::lonnet::unescape($name)}=  
                     &Apache::lonnet::unescape($value);  
     } split(/\&/,$answer);  
     my $version;  
     for ($version=1;$version<=$returnhash{'version'};$version++) {  
        map {  
           $returnhash{$_}=$returnhash{$version.':'.$_};  
        } split(/\:/,$returnhash{$version.':keys'});  
     }      }
    }      #
 # ----------------------------- returnhash now has all stores for this resource      # returnhash now has all stores for this resource
       # convert all "_" to "." to be able to use libraries, multiparts, etc
 # ---------------------------- initialize coursedata and userdata for this user      #
       # This is dumb.  It is also necessary :(
       my @oldkeys=keys %returnhash;
       #
       foreach my $name (@oldkeys) {
           my $value=$returnhash{$name};
           delete $returnhash{$name};
           $name=~s/\_/\./g;
           $returnhash{$name}=$value;
       }
       # initialize coursedata and userdata for this user
     undef %courseopt;      undef %courseopt;
     undef %useropt;      undef %useropt;
   
     my $userprefix=$uname.'_'.$udom.'_';      my $userprefix=$uname.'_'.$udom.'_';
   
     unless ($uhome eq 'no_host') {       unless ($uhome eq 'no_host') { 
 # -------------------------------------------------------------- Get coursedata          # Get coursedata
       unless          unless ((time-$courserdatas{$cid.'.last_cache'})<240) {
         ((time-$courserdatas{$cid.'.last_cache'})<240) {              my %Tmp = &Apache::lonnet::dump('resourcedata',$cdom,$cnum);
          my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.              $courserdatas{$cid}=\%Tmp;
               ':resourcedata',$chome);  
          if ($reply!~/^error\:/) {  
             $courserdatas{$cid}=$reply;  
             $courserdatas{$cid.'.last_cache'}=time;              $courserdatas{$cid.'.last_cache'}=time;
          }          }
       }          while (my ($name,$value) = each(%{$courserdatas{$cid}})) {
       map {              $courseopt{$userprefix.$name}=$value;
          my ($name,$value)=split(/\=/,$_);          }
          $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=          # Get userdata (if present)
                     &Apache::lonnet::unescape($value);            unless ((time-$userrdatas{$uname.'@'.$udom.'.last_cache'})<240) {
       } split(/\&/,$courserdatas{$cid});              my %Tmp = &Apache::lonnet::dump('resourcedata',$udom,$uname);
 # --------------------------------------------------- Get userdata (if present)              $userrdatas{$cid} = \%Tmp;
       unless              # Most of the time the user does not have a 'resourcedata.db' 
         ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {              # file.  We need to cache that we got nothing instead of bothering
          my $reply=              # with requesting it every time.
        &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);              $userrdatas{$uname.'@'.$udom.'.last_cache'}=time;
          if ($reply!~/^error\:/) {          }
      $userrdatas{$uname.'___'.$udom}=$reply;          while (my ($name,$value) = each(%{$userrdatas{$cid}})) {
      $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;              $useropt{$userprefix.$name}=$value;
          }          }
       }  
       map {  
          my ($name,$value)=split(/\=/,$_);  
          $useropt{$userprefix.&Apache::lonnet::unescape($name)}=  
           &Apache::lonnet::unescape($value);  
       } split(/\&/,$userrdatas{$uname.'___'.$udom});  
     }      }
 # ----------------- now courseopt, useropt initialized for this user and course      # now courseopt, useropt initialized for this user and course
 # (used by parmval)      # (used by parmval)
       #
    my %c=();      # Load keys for this assessment only
       #
    if (tie(%parmhash,'GDBM_File',      my %thisassess=();
            &getcfn($safeeval).'_parms.db',&GDBM_READER,0640)) {      my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb);
     my %f=&getformulas($safeeval);      foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) {
     map {          $thisassess{$_}=1;
  if ($_=~/^A/) {      } 
             unless ($f{$_}=~/^\!/) {      #
         if ($f{$_}=~/^parameter/) {      # Load parameters
                   my $val=&parmval($f{$_},$safeeval);      #
                   $c{$_}=$val;      my %c=();
                   $c{$f{$_}}=$val;      if (tie(%parmhash,'GDBM_File',
        } else {              $sheetdata->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) {
   my $key=$f{$_};          my %f=&getformulas($safeeval);
                   my $ckey=$key;          foreach (keys(%f))  {
                   $key=~s/^stores\_/resource\./;              next if ($_!~/^A/);
                   $key=~s/\_/\./;              next if  ($f{$_}=~/^[\!\~\-]/);
            $c{$_}=$returnhash{$key};              if ($f{$_}=~/^parameter/) {
                   $c{$ckey}=$returnhash{$key};                  if ($thisassess{$f{$_}}) {
        }                      my $val=&parmval($f{$_},$safeeval,$sheetdata);
    }                      $c{$_}=$val;
                       $c{$f{$_}}=$val;
                   }
               } else {
                   my $key=$f{$_};
                   my $ckey=$key;
                   $key=~s/^stores\_/resource\./;
                   $key=~s/\_/\./g;
                   $c{$_}=$returnhash{$key};
                   $c{$ckey}=$returnhash{$key};
               }
         }          }
     } keys %f;          untie(%parmhash);
     untie(%parmhash);      }
    }      &setconstants($safeeval,%c);
    &setconstants($safeeval,%c);  
 }  }
   
 # --------------------------------------------------------- Various form fields  # --------------------------------------------------------- Various form fields
Line 1446  sub loadassessment { Line 2025  sub loadassessment {
 sub textfield {  sub textfield {
     my ($title,$name,$value)=@_;      my ($title,$name,$value)=@_;
     return "\n<p><b>$title:</b><br>".      return "\n<p><b>$title:</b><br>".
            '<input type=text name="'.$name.'" size=80 value="'.$value.'">';          '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
 }  }
   
 sub hiddenfield {  sub hiddenfield {
Line 1457  sub hiddenfield { Line 2036  sub hiddenfield {
 sub selectbox {  sub selectbox {
     my ($title,$name,$value,%options)=@_;      my ($title,$name,$value,%options)=@_;
     my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';      my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
     map {      foreach (sort keys(%options)) {
         $selout.='<option value="'.$_.'"';          $selout.='<option value="'.$_.'"';
         if ($_ eq $value) { $selout.=' selected'; }          if ($_ eq $value) { $selout.=' selected'; }
         $selout.='>'.$options{$_}.'</option>';          $selout.='>'.$options{$_}.'</option>';
     } sort keys %options;      }
     return $selout.'</select>';      return $selout.'</select>';
 }  }
   
Line 1471  sub selectbox { Line 2050  sub selectbox {
 #  #
   
 sub updatesheet {  sub updatesheet {
     my $safeeval=shift;      my ($safeeval,$sheetdata)=@_;
     my $stype=&gettype($safeeval);      my $stype=$sheetdata->{'sheettype'};
     if ($stype eq 'classcalc') {      if ($stype eq 'classcalc') {
  return &updateclasssheet($safeeval);   return &updateclasssheet($safeeval,$sheetdata);
     } else {      } else {
         return &updatestudentassesssheet($safeeval);          return &updatestudentassesssheet($safeeval,$sheetdata);
     }      }
 }  }
   
Line 1486  sub updatesheet { Line 2065  sub updatesheet {
 #  #
   
 sub loadrows {  sub loadrows {
     my ($safeeval,$r)=@_;      my ($safeeval,$sheetdata,$r)=@_;
     my $stype=&gettype($safeeval);      my $stype=$sheetdata->{'sheettype'};
     if ($stype eq 'classcalc') {      if ($stype eq 'classcalc') {
  &loadcourse($safeeval,$r);   &loadcourse($safeeval,$sheetdata,$r);
     } elsif ($stype eq 'studentcalc') {      } elsif ($stype eq 'studentcalc') {
         &loadstudent($safeeval);          &loadstudent($safeeval,$sheetdata);
     } else {      } else {
         &loadassessment($safeeval);          &loadassessment($safeeval,$sheetdata);
     }      }
 }  }
   
Line 1503  sub checkthis { Line 2082  sub checkthis {
     my ($keyname,$time)=@_;      my ($keyname,$time)=@_;
     return ($time<$expiredates{$keyname});      return ($time<$expiredates{$keyname});
 }  }
   
 sub forcedrecalc {  sub forcedrecalc {
     my ($uname,$udom,$stype,$usymb)=@_;      my ($uname,$udom,$stype,$usymb)=@_;
     my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;      my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
Line 1534  sub forcedrecalc { Line 2114  sub forcedrecalc {
 #  #
   
 sub exportsheet {  sub exportsheet {
  my ($uname,$udom,$stype,$usymb,$fn)=@_;      my ($uname,$udom,$stype,$usymb,$fn)=@_;
  my @exportarr=();      my @exportarr=();
 #      if (($usymb=~/^\_(\w+)/) && (!$fn)) {
 # Check if cached          $fn='default_'.$1;
 #      }
       #
  my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;      # Check if cached
  my $found='';      #
       my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
  if ($oldsheets{$key}) {      my $found='';
      map {      if ($oldsheets{$key}) {
          my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);          foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
          if ($name eq $fn) {  
      $found=$value;  
          }  
      } split(/\_\_\_\&\_\_\_/,$oldsheets{$key});  
  }  
   
  unless ($found) {  
      &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));  
      if ($oldsheets{$key}) {  
         map {  
             my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);              my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
             if ($name eq $fn) {              if ($name eq $fn) {
         $found=$value;                  $found=$value;
             }              }
         } split(/\_\_\_\&\_\_\_/,$oldsheets{$key});          }
      }      }
  }      unless ($found) {
 #          &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));
 # Check if still valid          if ($oldsheets{$key}) {
 #              foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
  if ($found) {                  my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
      if (&forcedrecalc($uname,$udom,$stype,$usymb)) {                  if ($name eq $fn) {
  $found='';                      $found=$value;
      }                  }
  }              } 
            }
  if ($found) {      }
 #      #
 # Return what was cached      # Check if still valid
 #      #
      @exportarr=split(/\_\_\_\;\_\_\_/,$found);      if ($found) {
           if (&forcedrecalc($uname,$udom,$stype,$usymb)) {
  } else {              $found='';
 #          }
 # Not cached      }
 #              if ($found) {
           #
     my $thissheet=&makenewsheet($uname,$udom,$stype,$usymb);          # Return what was cached
     &readsheet($thissheet,$fn);          #
     &updatesheet($thissheet);          @exportarr=split(/\_\_\_\;\_\_\_/,$found);
     &loadrows($thissheet);  
     &calcsheet($thissheet);   
     @exportarr=&exportdata($thissheet);  
 #  
 # Store now  
 #  
     my $cid=$ENV{'request.course.id'};   
     my $current='';  
     if ($stype eq 'studentcalc') {  
        $current=&Apache::lonnet::reply('get:'.  
                                      $ENV{'course.'.$cid.'.domain'}.':'.  
                                      $ENV{'course.'.$cid.'.num'}.  
      ':nohist_calculatedsheets:'.  
                                      &Apache::lonnet::escape($key),  
                                      $ENV{'course.'.$cid.'.home'});  
     } else {      } else {
        $current=&Apache::lonnet::reply('get:'.          #
                                      &getudom($thissheet).':'.          # Not cached
                                      &getuname($thissheet).          #        
      ':nohist_calculatedsheets_'.          my ($thissheet,$sheetdata)=&makenewsheet($uname,$udom,$stype,$usymb);
                                      $ENV{'request.course.id'}.':'.          &readsheet($thissheet,$sheetdata,$fn);
                                      &Apache::lonnet::escape($key),          &updatesheet($thissheet,$sheetdata);
                                      &getuhome($thissheet));          &loadrows($thissheet,$sheetdata);
           &calcsheet($thissheet); 
     }          @exportarr=&exportdata($thissheet);
     my %currentlystored=();          #
     unless ($current=~/^error\:/) {          # Store now
        map {          #
            my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);          my $cid=$ENV{'request.course.id'}; 
            $currentlystored{$name}=$value;          my $current='';
        } split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current));          if ($stype eq 'studentcalc') {
     }              $current=&Apache::lonnet::reply('get:'.
     $currentlystored{$fn}=join('___;___',@exportarr);                                              $ENV{'course.'.$cid.'.domain'}.':'.
                                               $ENV{'course.'.$cid.'.num'}.
     my $newstore='';                                              ':nohist_calculatedsheets:'.
     map {                                              &Apache::lonnet::escape($key),
         if ($newstore) { $newstore.='___&___'; }                                              $ENV{'course.'.$cid.'.home'});
         $newstore.=$_.'___=___'.$currentlystored{$_};          } else {
     } keys %currentlystored;              $current=&Apache::lonnet::reply('get:'.$sheetdata->{'udom'}.':'.
     my $now=time;                                              $sheetdata->{'uname'}.
     if ($stype eq 'studentcalc') {                                              ':nohist_calculatedsheets_'.
        &Apache::lonnet::reply('put:'.                                              $ENV{'request.course.id'}.':'.
                          $ENV{'course.'.$cid.'.domain'}.':'.                                              &Apache::lonnet::escape($key),
                          $ENV{'course.'.$cid.'.num'}.                                              $sheetdata->{'uhome'});
  ':nohist_calculatedsheets:'.          }
                          &Apache::lonnet::escape($key).'='.          my %currentlystored=();
  &Apache::lonnet::escape($newstore).'&'.          unless ($current=~/^error\:/) {
                          &Apache::lonnet::escape($key).'.time='.$now,              foreach (split(/___&\___/,&Apache::lonnet::unescape($current))) {
                          $ENV{'course.'.$cid.'.home'});                  my ($name,$value)=split(/___=___/,$_);
    } else {                  $currentlystored{$name}=$value;
        &Apache::lonnet::reply('put:'.              }
                          &getudom($thissheet).':'.          }
                          &getuname($thissheet).          $currentlystored{$fn}=join('___;___',@exportarr);
  ':nohist_calculatedsheets_'.          #
                          $ENV{'request.course.id'}.':'.          my $newstore='';
                          &Apache::lonnet::escape($key).'='.          foreach (keys(%currentlystored)) {
  &Apache::lonnet::escape($newstore).'&'.              if ($newstore) { $newstore.='___&___'; }
                          &Apache::lonnet::escape($key).'.time='.$now,              $newstore.=$_.'___=___'.$currentlystored{$_};
                          &getuhome($thissheet));          }
    }          my $now=time;
  }          if ($stype eq 'studentcalc') {
  return @exportarr;              &Apache::lonnet::reply('put:'.
                                      $ENV{'course.'.$cid.'.domain'}.':'.
                                      $ENV{'course.'.$cid.'.num'}.
                                      ':nohist_calculatedsheets:'.
                                      &Apache::lonnet::escape($key).'='.
                                      &Apache::lonnet::escape($newstore).'&'.
                                      &Apache::lonnet::escape($key).'.time='.$now,
                                      $ENV{'course.'.$cid.'.home'});
           } else {
               &Apache::lonnet::reply('put:'.
                                      $sheetdata->{'udom'}.':'.
                                      $sheetdata->{'uname'}.
                                      ':nohist_calculatedsheets_'.
                                      $ENV{'request.course.id'}.':'.
                                      &Apache::lonnet::escape($key).'='.
                                      &Apache::lonnet::escape($newstore).'&'.
                                      &Apache::lonnet::escape($key).'.time='.$now,
                                      $sheetdata->{'uhome'});
           }
       }
       return @exportarr;
 }  }
   
 # ============================================================ Expiration Dates  # ============================================================ Expiration Dates
 #  #
 # Load previously cached student spreadsheets for this course  # Load previously cached student spreadsheets for this course
 #  #
   
 sub expirationdates {  sub expirationdates {
     undef %expiredates;      undef %expiredates;
     my $cid=$ENV{'request.course.id'};      my $cid=$ENV{'request.course.id'};
Line 1663  sub expirationdates { Line 2238  sub expirationdates {
      ':nohist_expirationdates',       ':nohist_expirationdates',
                                      $ENV{'course.'.$cid.'.home'});                                       $ENV{'course.'.$cid.'.home'});
     unless ($reply=~/^error\:/) {      unless ($reply=~/^error\:/) {
  map {   foreach (split(/\&/,$reply)) {
             my ($name,$value)=split(/\=/,$_);              my ($name,$value)=split(/\=/,$_);
             $expiredates{&Apache::lonnet::unescape($name)}              $expiredates{&Apache::lonnet::unescape($name)}
                         =&Apache::lonnet::unescape($value);                          =&Apache::lonnet::unescape($value);
         } split(/\&/,$reply);          }
     }      }
 }  }
   
Line 1684  sub cachedcsheets { Line 2259  sub cachedcsheets {
      ':nohist_calculatedsheets',       ':nohist_calculatedsheets',
                                      $ENV{'course.'.$cid.'.home'});                                       $ENV{'course.'.$cid.'.home'});
     unless ($reply=~/^error\:/) {      unless ($reply=~/^error\:/) {
  map {   foreach ( split(/\&/,$reply)) {
             my ($name,$value)=split(/\=/,$_);              my ($name,$value)=split(/\=/,$_);
             $oldsheets{&Apache::lonnet::unescape($name)}              $oldsheets{&Apache::lonnet::unescape($name)}
                       =&Apache::lonnet::unescape($value);                        =&Apache::lonnet::unescape($value);
         } split(/\&/,$reply);          }
     }      }
 }  }
   
Line 1706  sub cachedssheets { Line 2281  sub cachedssheets {
                                       $ENV{'request.course.id'},                                        $ENV{'request.course.id'},
                                      $shome);                                       $shome);
     unless ($reply=~/^error\:/) {      unless ($reply=~/^error\:/) {
  map {   foreach ( split(/\&/,$reply)) {
             my ($name,$value)=split(/\=/,$_);              my ($name,$value)=split(/\=/,$_);
             $oldsheets{&Apache::lonnet::unescape($name)}              $oldsheets{&Apache::lonnet::unescape($name)}
                       =&Apache::lonnet::unescape($value);                        =&Apache::lonnet::unescape($value);
         } split(/\&/,$reply);          }
     }      }
     $loadedcaches{$sname.'_'.$sdom}=1;      $loadedcaches{$sname.'_'.$sdom}=1;
   }    }
Line 1726  sub cachedssheets { Line 2301  sub cachedssheets {
 # Interactive call to screen  # Interactive call to screen
 #  #
 #  #
   
   
 sub handler {  sub handler {
     my $r=shift;      my $r=shift;
   
       # Check this server
       my $loaderror=&Apache::lonnet::overloaderror($r);
       if ($loaderror) { return $loaderror; }
       # Check the course homeserver
       $loaderror= &Apache::lonnet::overloaderror($r,
                         $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
       if ($loaderror) { return $loaderror; } 
       
     if ($r->header_only) {      if ($r->header_only) {
       $r->content_type('text/html');          $r->content_type('text/html');
       $r->send_http_header;          $r->send_http_header;
       return OK;          return OK;
       }
       # Global directory configs
       $includedir = $r->dir_config('lonIncludes');
       $tmpdir = $r->dir_config('lonDaemons').'/tmp/';
       # Needs to be in a course
       if (! $ENV{'request.course.fn'}) { 
           # Not in a course, or not allowed to modify parms
           $ENV{'user.error.msg'}=
               $r->uri.":opa:0:0:Cannot modify spreadsheet";
           return HTTP_NOT_ACCEPTABLE; 
       }
       # Get query string for limited number of parameters
       &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                               ['uname','udom','usymb','ufn']);
       if ($ENV{'request.role'} =~ /^st\./) {
           delete $ENV{'form.unewfield'}   if (exists($ENV{'form.unewfield'}));
           delete $ENV{'form.unewformula'} if (exists($ENV{'form.unewformula'}));
       }
       if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) {
           $ENV{'form.ufn'}='default_'.$1;
       }
       # Interactive loading of specific sheet?
       if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {
           $ENV{'form.ufn'}=$ENV{'form.loadthissheet'};
     }      }
       #
 # ---------------------------------------------------- Global directory configs      # Determine the user name and domain for the sheet.
   
 $includedir=$r->dir_config('lonIncludes');  
 $tmpdir=$r->dir_config('lonDaemons').'/tmp/';  
   
 # ----------------------------------------------------- Needs to be in a course  
   
   if ($ENV{'request.course.fn'}) {   
   
 # --------------------------- Get query string for limited number of parameters  
   
     map {  
        my ($name, $value) = split(/=/,$_);  
        $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;  
    }  
        }  
     } (split(/&/,$ENV{'QUERY_STRING'}));  
   
 # ------------------------------------------- Nothing there? Must be login user  
   
     my $aname;      my $aname;
     my $adom;      my $adom;
   
     unless ($ENV{'form.uname'}) {      unless ($ENV{'form.uname'}) {
  $aname=$ENV{'user.name'};          $aname=$ENV{'user.name'};
         $adom=$ENV{'user.domain'};          $adom=$ENV{'user.domain'};
     } else {      } else {
         $aname=$ENV{'form.uname'};          $aname=$ENV{'form.uname'};
         $adom=$ENV{'form.udom'};          $adom=$ENV{'form.udom'};
     }      }
       #
 # ------------------------------------------------------------------- Open page      # Open page
   
     $r->content_type('text/html');      $r->content_type('text/html');
     $r->header_out('Cache-control','no-cache');      $r->header_out('Cache-control','no-cache');
     $r->header_out('Pragma','no-cache');      $r->header_out('Pragma','no-cache');
     $r->send_http_header;      $r->send_http_header;
       # Screen output
 # --------------------------------------------------------------- Screen output  
   
     $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');      $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
     $r->print(<<ENDSCRIPT);      if ($ENV{'request.role'} !~ /^st\./) {
           $r->print(<<ENDSCRIPT);
 <script language="JavaScript">  <script language="JavaScript">
   
     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();
         }          }
     }      }
   
 </script>      function changesheet(cn) {
 ENDSCRIPT   document.sheet.unewfield.value=cn;
     $r->print('</head><body bgcolor="#FFFFFF">'.          document.sheet.unewformula.value='changesheet';
        '<img align=right src=/adm/lonIcons/lonlogos.gif>'.          document.sheet.submit();
        '<h1>LON-CAPA Spreadsheet</h1>'.      }
        '<form action="'.$r->uri.'" name=sheet method=post>'.  
        &hiddenfield('uname',$ENV{'form.uname'}).  
        &hiddenfield('udom',$ENV{'form.udom'}).  
        &hiddenfield('usymb',$ENV{'form.usymb'}).  
        &hiddenfield('unewfield','').  
        &hiddenfield('unewformula',''));  
   
 # ---------------------- Make sure that this gets out, even if user hits "stop"      function insertrow(cn) {
    document.sheet.unewfield.value='insertrow';
           document.sheet.unewformula.value=cn;
           document.sheet.submit();
       }
   
   </script>
   ENDSCRIPT
       }
       $r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet').
                 '<form action="'.$r->uri.'" name=sheet method=post>');
       $r->print(&hiddenfield('uname',$ENV{'form.uname'}).
                 &hiddenfield('udom',$ENV{'form.udom'}).
                 &hiddenfield('usymb',$ENV{'form.usymb'}).
                 &hiddenfield('unewfield','').
                 &hiddenfield('unewformula',''));
     $r->rflush();      $r->rflush();
       #
 # ---------------------------------------- Read new sheet or modified worksheet      # Full recalc?
       if ($ENV{'form.forcerecalc'}) {
           $r->print('<h4>Completely Recalculating Sheet ...</h4>');
           undef %spreadsheets;
           undef %courserdatas;
           undef %userrdatas;
           undef %defaultsheets;
           undef %updatedata;
       }
       # Read new sheet or modified worksheet
     $r->uri=~/\/(\w+)$/;      $r->uri=~/\/(\w+)$/;
       my ($sheet,$sheetdata)=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'});
     my $asheet=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'});      #
       # If a new formula had been entered, go from work copy
 # ------------------------ If a new formula had been entered, go from work copy  
   
     if ($ENV{'form.unewfield'}) {      if ($ENV{'form.unewfield'}) {
         $r->print('<h2>Modified Workcopy</h2>');          $r->print('<h2>Modified Workcopy</h2>');
         $ENV{'form.unewformula'}=~s/\'/\"/g;          $ENV{'form.unewformula'}=~s/\'/\"/g;
         $r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='.          $r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='.
                   $ENV{'form.unewformula'}.'<p>');                    $ENV{'form.unewformula'}.'<p>');
         &setfilename($asheet,$ENV{'form.ufn'});          $sheetdata->{'filename'} = $ENV{'form.ufn'};
  &tmpread($asheet,          &tmpread($sheet,$sheetdata,
                  $ENV{'form.unewfield'},$ENV{'form.unewformula'});                   $ENV{'form.unewfield'},$ENV{'form.unewformula'});
       } elsif ($ENV{'form.saveas'}) {
      } elsif ($ENV{'form.saveas'}) {          $sheetdata->{'filename'} = $ENV{'form.ufn'};
         &setfilename($asheet,$ENV{'form.ufn'});          &tmpread($sheet,$sheetdata);
  &tmpread($asheet);  
     } else {      } else {
         &readsheet($asheet,$ENV{'form.ufn'});          &readsheet($sheet,$sheetdata,$ENV{'form.ufn'});
     }      }
       # Print out user information
 # -------------------------------------------------- Print out user information      unless ($sheetdata->{'sheettype'} eq 'classcalc') {
           $r->print('<p><b>User:</b> '.$sheetdata->{'uname'}.
     unless (&gettype($asheet) eq 'classcalc') {                    '<br><b>Domain:</b> '.$sheetdata->{'udom'});
         $r->print('<p><b>User:</b> '.&getuname($asheet).          $r->print('<br><b>Section/Group:</b> '.$sheetdata->{'csec'});
                   '<br><b>Domain:</b> '.&getudom($asheet));          if ($ENV{'form.usymb'}) {
         if (&getcsec($asheet) eq '-1') {              $r->print('<br><b>Assessment:</b> <tt>'.
            $r->print('<h3><font color=red>'.                        $ENV{'form.usymb'}.'</tt>');
                      'Not a student in this course</font></h3>');  
         } else {  
            $r->print('<br><b>Section/Group:</b> '.&getcsec($asheet));  
         }          }
     }      }
       #
 # ---------------------------------------------------------------- Course title      # Check user permissions
       if (($sheetdata->{'sheettype'} eq 'classcalc'       ) || 
     $r->print('<h1>'.          ($sheetdata->{'uname'}     ne $ENV{'user.name'} ) ||
             $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.'</h1>');          ($sheetdata->{'udom'}      ne $ENV{'user.domain'})) {
           unless (&Apache::lonnet::allowed('vgr',$sheetdata->{'cid'})) {
 # ---------------------------------------------------- See if user can see this              $r->print('<h1>Access Permission Denied</h1>'.
                         '</form></body></html>');
     if ((&gettype($asheet) eq 'classcalc') ||   
         (&getuname($asheet) ne $ENV{'user.name'}) ||  
         (&getudom($asheet) ne $ENV{'user.domain'})) {  
         unless (&Apache::lonnet::allowed('vgr',&getcid($asheet))) {  
     $r->print(  
            '<h1>Access Permission Denied</h1></form></body></html>');  
             return OK;              return OK;
         }          }
     }      }
       # Additional options
 # ---------------------------------------------------- See if something to save      $r->print('<br />'.
                 '<input type="submit" name="forcerecalc" '.
     if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {                'value="Completely Recalculate Sheet"><p>');
         my $fname='';      if ($sheetdata->{'sheettype'} eq 'assesscalc') {
  if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) {          $r->print('<p><font size=+2>'.
             $fname=~s/\W/\_/g;                    '<a href="/adm/studentcalc?'.
             if ($fname eq 'default') { $fname='course_default'; }                    'uname='.$sheetdata->{'uname'}.
             $fname.='_'.&gettype($asheet);                    '&udom='.$sheetdata->{'udom'}.'">'.
             &setfilename($asheet,$fname);                    'Level up: Student Sheet</a></font><p>');
             $ENV{'form.ufn'}=$fname;      }
     $r->print('<p>Saving spreadsheet: '.      if (($sheetdata->{'sheettype'} eq 'studentcalc') && 
                          &writesheet($asheet,$ENV{'form.makedefufn'}).'<p>');          (&Apache::lonnet::allowed('vgr',$sheetdata->{'cid'}))) {
  }          $r->print ('<p><font size=+2><a href="/adm/classcalc">'.
     }  
   
 # ------------------------------------------------ Write the modified worksheet  
   
    $r->print('<b>Current sheet:</b> '.&getfilename($asheet).'<p>');  
   
    &tmpwrite($asheet);  
   
 # ---------------------------------------------------------- Additional options  
   
     $r->print(  
  '<input type=submit name=forcerecalc value="Completely Recalculate Sheet"><p>'  
  );  
     if (&gettype($asheet) eq 'assesscalc') {  
        $r->print ('<p><font size=+2><a href="/adm/studentcalc?uname='.  
                                                &getuname($asheet).  
                                                '&udom='.&getudom($asheet).  
                   '">Level up: Student Sheet</a></font><p>');  
     }  
       
     if ((&gettype($asheet) eq 'studentcalc') &&   
         (&Apache::lonnet::allowed('vgr',&getcid($asheet)))) {  
        $r->print (  
                    '<p><font size=+2><a href="/adm/classcalc">'.  
                    'Level up: Course Sheet</a></font><p>');                     'Level up: Course Sheet</a></font><p>');
     }      }
           # Save dialog
   
 # ----------------------------------------------------------------- Save dialog  
   
   
     if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {      if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
         my $fname=$ENV{'form.ufn'};          my $fname=$ENV{'form.ufn'};
         $fname=~s/\_[^\_]+$//;          $fname=~s/\_[^\_]+$//;
         if ($fname eq 'default') { $fname='course_default'; }          if ($fname eq 'default') { $fname='course_default'; }
         $r->print('<input type=submit name=saveas value="Save as ...">'.          $r->print('<input type=submit name=saveas value="Save as ...">'.
               '<input type=text size=20 name=newfn value="'.$fname.                    '<input type=text size=20 name=newfn value="'.$fname.'">'.
               '"> (make default: <input type=checkbox name="makedefufn">)<p>');                    'make default: <input type=checkbox name="makedefufn"><p>');
     }      }
       $r->print(&hiddenfield('ufn',$sheetdata->{'filename'}));
     $r->print(&hiddenfield('ufn',&getfilename($asheet)));      # Load dialog
       if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
 # --------------------------------------------------------------- Cached sheets          $r->print('<p><input type=submit name=load value="Load ...">'.
                     '<select name="loadthissheet">'.
                     '<option name="default">Default</option>');
           foreach (&othersheets($sheet,$sheetdata->{'sheettype'},$sheetdata)) {
               $r->print('<option name="'.$_.'"');
               if ($ENV{'form.ufn'} eq $_) {
                   $r->print(' selected');
               }
               $r->print('>'.$_.'</option>');
           } 
           $r->print('</select><p>');
           if ($sheetdata->{'sheettype'} eq 'studentcalc') {
               &setothersheets($sheet,
                               &othersheets($sheet,'assesscalc',$sheetdata));
           }
       }
       # Cached sheets
     &expirationdates();      &expirationdates();
   
     undef %oldsheets;      undef %oldsheets;
     undef %loadedcaches;      undef %loadedcaches;
       if ($sheetdata->{'sheettype'} eq 'classcalc') {
     if (&gettype($asheet) eq 'classcalc') {          $r->print("Loading previously calculated student sheets ...\n");
         $r->print("Loading previously calculated student sheets ...<br>\n");  
         $r->rflush();          $r->rflush();
         &cachedcsheets();          &cachedcsheets();
     } elsif (&gettype($asheet) eq 'studentcalc') {      } elsif ($sheetdata->{'sheettype'} eq 'studentcalc') {
         $r->print("Loading previously calculated assessment sheets ...<br>\n");          $r->print("Loading previously calculated assessment sheets ...\n");
         $r->rflush();          $r->rflush();
         &cachedssheets(&getuname($asheet),&getudom($asheet),          &cachedssheets($sheetdata->{'uname'},$sheetdata->{'udom'},
                        &getuhome($asheet));                         $sheetdata->{'uhome'});
     }      }
       # Update sheet, load rows
 # ----------------------------------------------------- Update sheet, load rows  
   
     $r->print("Loaded sheet(s), updating rows ...<br>\n");      $r->print("Loaded sheet(s), updating rows ...<br>\n");
     $r->rflush();      $r->rflush();
       #
     &updatesheet($asheet);      &updatesheet($sheet,$sheetdata);
       $r->print("Updated rows, loading row data ...\n");
     $r->print("Updated rows, loading row data ...<br>\n");  
     $r->rflush();      $r->rflush();
       #
     &loadrows($asheet,$r);      &loadrows($sheet,$sheetdata,$r);
   
     $r->print("Loaded row data, calculating sheet ...<br>\n");      $r->print("Loaded row data, calculating sheet ...<br>\n");
     $r->rflush();      $r->rflush();
       #
     my $calcoutput=&calcsheet($asheet);      my $calcoutput=&calcsheet($sheet);
     $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');      $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');
       # See if something to save
     &outsheet($r,$asheet);      if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
           my $fname='';
           if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) {
               $fname=~s/\W/\_/g;
               if ($fname eq 'default') { $fname='course_default'; }
               $fname.='_'.$sheetdata->{'sheettype'};
               $sheetdata->{'filename'} = $fname;
               $ENV{'form.ufn'}=$fname;
               $r->print('<p>Saving spreadsheet: '.
                         &writesheet($sheet,$ENV{'form.makedefufn'},$sheetdata).
                         '<p>');
           }
       }
       #
       # Write the modified worksheet
       $r->print('<b>Current sheet:</b> '.$sheetdata->{'filename'}.'<p>');
       &tmpwrite($sheet,$sheetdata);
       if ($sheetdata->{'sheettype'} eq 'studentcalc') {
           $r->print('<br>Show rows with empty A column: ');
       } else {
           $r->print('<br>Show empty rows: ');
       } 
       #
       $r->print(&hiddenfield('userselhidden','true').
                 '<input type="checkbox" name="showall" onClick="submit()"');
       #
       if ($ENV{'form.showall'}) { 
           $r->print(' checked'); 
       } else {
           unless ($ENV{'form.userselhidden'}) {
               unless 
                   ($ENV{'course.'.$ENV{'request.course.id'}.'.hideemptyrows'} eq 'yes') {
                       $r->print(' checked');
                       $ENV{'form.showall'}=1;
                   }
           }
       }
       $r->print('>');
       #
       # CSV format checkbox (classcalc sheets only)
       if ($sheetdata->{'sheettype'} eq 'classcalc') {
           $r->print(' Output CSV format: <input type="checkbox" '.
                     'name="showcsv" onClick="submit()"');
           if ($ENV{'form.showcsv'}) { $r->print(' checked'); }
           $r->print('>');
       }
       #
       # Buttons to insert rows
       $r->print('&nbsp;Student Status: '.
                 &Apache::lonhtmlcommon::StatusOptions
                 ($ENV{'form.Status'},'sheet'));
       $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
       &outsheet($r,$sheet,$sheetdata);
     $r->print('</form></body></html>');      $r->print('</form></body></html>');
       #  Done
 # ------------------------------------------------------------------------ Done  
   } else {  
 # ----------------------------- Not in a course, or not allowed to modify parms  
       $ENV{'user.error.msg'}=  
         $r->uri.":opa:0:0:Cannot modify spreadsheet";  
       return HTTP_NOT_ACCEPTABLE;   
   }  
     return OK;      return OK;
   
 }  }
   
 1;  1;
 __END__  __END__
   
   
   
   
Removed from v.1.53  
changed lines
  Added in v.1.117

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