Diff for /loncom/interface/Attic/lonspreadsheet.pm between versions 1.55 and 1.87

version 1.55, 2001/07/20 02:05:33 version 1.87, 2002/04/18 20:21:38
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
 #  #
Line 6 Line 31
 # 01/01/01,02/01,03/01,19/01,20/01,22/01,  # 01/01/01,02/01,03/01,19/01,20/01,22/01,
 # 03/05,03/08,03/10,03/12,03/13,03/15,03/17,  # 03/05,03/08,03/10,03/12,03/13,03/15,03/17,
 # 03/19,03/20,03/21,03/27,04/05,04/09,  # 03/19,03/20,03/21,03/27,04/05,04/09,
 # 07/09,07/14 Gerd Kortemeyer  # 07/09,07/14,07/21,09/01,09/10,9/11,9/12,9/13,9/14,9/17,
   # 10/16,10/17,10/20,11/05,11/28,12/27 Gerd Kortemeyer
   # 01/14/02 Matthew
   # 02/04/02 Matthew
   
   # POD required stuff:
   
   =head1 NAME
   
   lonspreadsheet
   
   =head1 SYNOPSIS
   
   Spreadsheet interface to internal LON-CAPA data
   
   =head1 DESCRIPTION
   
   Lonspreadsheet provides course coordinators the ability to manage their
   students grades online.  The students are able to view their own grades, but
   not the grades of their peers.  The spreadsheet is highly customizable,
   offering the ability to use Perl code to manipulate data, as well as many
   built-in functions.
   
   
   =head2 Functions available to user of lonspreadsheet
   
   =over 4
   
   =cut
   
 package Apache::lonspreadsheet;  package Apache::lonspreadsheet;
                           
Line 69  sub initsheet { Line 122  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');
       $safehole->wrap(\&send_msg,     $safeeval,"&send_msg");
       $safehole->wrap(\&send_crit_msg,$safeeval,"&send_crit_msg");
     my $code=<<'ENDDEFS';      my $code=<<'ENDDEFS';
 # ---------------------------------------------------- Inside of the safe space  # ---------------------------------------------------- Inside of the safe space
   
Line 87  undef %c; Line 142  undef %c;
 undef %rl;  undef %rl;
 undef @os;  undef @os;
   
     undef $nfield;  
     undef $nsheet;  
   
 $maxrow=0;  $maxrow=0;
 $sheettype='';  $sheettype='';
   
Line 144  sub mask { Line 196  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 191  sub mask { Line 243  sub mask {
     return '^'.$alpha.$num."\$";      return '^'.$alpha.$num."\$";
 }  }
   
   #-------------------------------------------------------
   
   =item UWCALC(hashname,modules,units,date) 
   
   returns the proportion of the module 
   weights not previously completed by the student.
   
   =over 4
   
   =item hashname 
   
   name of the hash the module dates have been inserted into
   
   =item modules 
   
   reference to a cell which contains a comma deliminated list of modules 
   covered by the assignment.
   
   =item units 
   
   reference to a cell which contains a comma deliminated list of module 
   weights with respect to the assignment
   
   =item date 
   
   reference to a cell which contains the date the assignment was completed.
   
   =back 
   
   =cut
   
   #-------------------------------------------------------
   sub UWCALC {
       my ($hashname,$modules,$units,$date) = @_;
       my @Modules = split(/,/,$modules);
       my @Units   = split(/,/,$units);
       my $total_weight;
       foreach (@Units) {
    $total_weight += $_;
       }
       my $usum=0;
       for (my $i=0; $i<=$#Modules; $i++) {
    if (&HASH($hashname,$Modules[$i]) eq $date) {
       $usum += $Units[$i];
    }
       }
       return $usum/$total_weight;
   }
   
   #-------------------------------------------------------
   
   =item CDLSUM(list) 
   
   returns the sum of the elements in a cell which contains
   a Comma Deliminate List of numerical values.
   'list' is a reference to a cell which contains a comma deliminated list.
   
   =cut
   
   #-------------------------------------------------------
   sub CDLSUM {
       my ($list)=@_;
       my $sum;
       foreach (split/,/,$list) {
    $sum += $_;
       }
       return $sum;
   }
   
   #-------------------------------------------------------
   
   =item CDLITEM(list,index) 
   
   returns the item at 'index' in a Comma Deliminated List.
   
   =over 4
   
   =item list
   
   reference to a cell which contains a comma deliminated list.
   
   =item index 
   
   the Perl index of the item requested (first element in list has
   an index of 0) 
   
   =back
   
   =cut
   
   #-------------------------------------------------------
   sub CDLITEM {
       my ($list,$index)=@_;
       my @Temp = split/,/,$list;
       return $Temp[$index];
   }
   
   #-------------------------------------------------------
   
   =item CDLHASH(name,key,value) 
   
   loads a comma deliminated list of keys into
   the hash 'name', all with a value of 'value'.
   
   =over 4
   
   =item name  
   
   name of the hash.
   
   =item key
   
   (a pointer to) a comma deliminated list of keys.
   
   =item value
   
   a single value to be entered for each key.
   
   =back
   
   =cut
   
   #-------------------------------------------------------
   sub CDLHASH {
       my ($name,$key,$value)=@_;
       my @Keys;
       my @Values;
       # Check to see if we have multiple $key values
       if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
    my $keymask = &mask($key);
    # Assume the keys are addresses
    my @Temp = grep /$keymask/,keys(%v);
    @Keys = $v{@Temp};
       } else {
    $Keys[0]= $key;
       }
       my @Temp;
       foreach $key (@Keys) {
    @Temp = (@Temp, split/,/,$key);
       }
       @Keys = @Temp;
       if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
    my $valmask = &mask($value);
    my @Temp = grep /$valmask/,keys(%v);
    @Values =$v{@Temp};
       } else {
    $Values[0]= $value;
       }
       $value = $Values[0];
       # Add values to hash
       for (my $i = 0; $i<=$#Keys; $i++) {
    my $key   = $Keys[$i];
    if (! exists ($hashes{$name}->{$key})) {
       $hashes{$name}->{$key}->[0]=$value;
    } else {
       my @Temp = sort(@{$hashes{$name}->{$key}},$value);
       $hashes{$name}->{$key} = \@Temp;
    }
       }
       return "hash '$name' updated";
   }
   
   #-------------------------------------------------------
   
   =item GETHASH(name,key,index) 
   
   returns the element in hash 'name' 
   reference by the key 'key', at index 'index' in the values list.
   
   =cut
   
   #-------------------------------------------------------
   sub GETHASH {
       my ($name,$key,$index)=@_;
       if (! defined($index)) {
    $index = 0;
       }
       if ($key =~ /^[A-z]\d+$/) {
    $key = $v{$key};
       }
       return $hashes{$name}->{$key}->[$index];
   }
   
   #-------------------------------------------------------
   
   =item CLEARHASH(name) 
   
   clears all the values from the hash 'name'
   
   =item CLEARHASH(name,key) 
   
   clears all the values from the hash 'name' associated with the given key.
   
   =cut
   
   #-------------------------------------------------------
   sub CLEARHASH {
       my ($name,$key)=@_;
       if (defined($key)) {
    if (exists($hashes{$name}->{$key})) {
       $hashes{$name}->{$key}=undef;
       return "hash '$name' key '$key' cleared";
    }
       } else {
    if (exists($hashes{$name})) {
       $hashes{$name}=undef;
       return "hash '$name' cleared";
    }
       }
       return "Error in clearing hash";
   }
   
   #-------------------------------------------------------
   
   =item HASH(name,key,value) 
   
   loads values into an internal hash.  If a key 
   already has a value associated with it, the values are sorted numerically.  
   
   =item HASH(name,key) 
   
   returns the 0th value in the hash 'name' associated with 'key'.
   
   =cut
   
   #-------------------------------------------------------
   sub HASH {
       my ($name,$key,$value)=@_;
       my @Keys;
       undef @Keys;
       my @Values;
       # Check to see if we have multiple $key values
       if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
    my $keymask = &mask($key);
    # Assume the keys are addresses
    my @Temp = grep /$keymask/,keys(%v);
    @Keys = $v{@Temp};
       } else {
    $Keys[0]= $key;
       }
       # If $value is empty, return the first value associated 
       # with the first key.
       if (! $value) {
    return $hashes{$name}->{$Keys[0]}->[0];
       }
       # Check to see if we have multiple $value(s) 
       if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
    my $valmask = &mask($value);
    my @Temp = grep /$valmask/,keys(%v);
    @Values =$v{@Temp};
       } else {
    $Values[0]= $value;
       }
       # Add values to hash
       for (my $i = 0; $i<=$#Keys; $i++) {
    my $key   = $Keys[$i];
    my $value = ($i<=$#Values ? $Values[$i] : $Values[0]);
    if (! exists ($hashes{$name}->{$key})) {
       $hashes{$name}->{$key}->[0]=$value;
    } else {
       my @Temp = sort(@{$hashes{$name}->{$key}},$value);
       $hashes{$name}->{$key} = \@Temp;
    }
       }
       return $Values[-1];
   }
   
   #-------------------------------------------------------
   
   =item NUM(range)
   
   returns the number of items in the range.
   
   =cut
   
   #-------------------------------------------------------
 sub NUM {  sub NUM {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $num=0;      my $num= $#{@{grep(/$mask/,keys(%v))}}+1;
     map {  
         $num++;  
     } grep /$mask/,keys %v;  
     return $num;         return $num;   
 }  }
   
Line 204  sub BIN { Line 529  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(%v)) {
         if (($v{$_}>=$low) && ($v{$_}<=$high)) {          if (($v{$_}>=$low) && ($v{$_}<=$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(%v)) {
         $sum+=$v{$_};          $sum+=$v{$_};
     } 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(%v)) {
         $sum+=$v{$_};          $sum+=$v{$_};
         $num++;          $num++;
     } grep /$mask/,keys %v;      }
     if ($num) {      if ($num) {
        return $sum/$num;         return $sum/$num;
     } else {      } else {
Line 236  sub MEAN { Line 579  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(%v)) {
         $sum+=$v{$_};          $sum+=$v{$_};
         $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(%v)) {
         $sum+=($v{$_}-$mean)**2;          $sum+=($v{$_}-$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(%v)) {
         $prod*=$v{$_};          $prod*=$v{$_};
     } 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(%v)) {
         unless ($max) { $max=$v{$_}; }          unless ($max) { $max=$v{$_}; }
         if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }          if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }
     } 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(%v)) {
         unless ($max) { $max=$v{$_}; }          unless ($max) { $max=$v{$_}; }
         if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }          if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }
     } grep /$mask/,keys %v;      }
     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(%v)) {
  $inside[$#inside+1]=$v{$_};   push (@inside,$v{$_});
     } 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 296  sub SUMMAX { Line 685  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(%v)) {
  $inside[$#inside+1]=$v{$_};   $inside[$#inside+1]=$v{$_};
     } 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 311  sub SUMMIN { Line 710  sub SUMMIN {
     return $sum;         return $sum;   
 }  }
   
   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 {
           return '$c{\''.$expression.'\'}';
       }
   }
   
 sub sett {  sub sett {
     %t=();      %t=();
     my $pattern='';      my $pattern='';
Line 319  sub sett { Line 754  sub sett {
     } else {      } else {
         $pattern='[A-Z]';          $pattern='[A-Z]';
     }      }
     map {      foreach (keys(%f)) {
  if ($_=~/template\_(\w)/) {   if ($_=~/template\_(\w)/) {
   my $col=$1;    my $col=$1;
           unless ($col=~/^$pattern/) {            unless ($col=~/^$pattern/) {
             map {      foreach (keys(%f)) {
       if ($_=~/A(\d+)/) {        if ($_=~/A(\d+)/) {
  my $trow=$1;   my $trow=$1;
                 if ($trow) {                  if ($trow) {
Line 332  sub sett { Line 767  sub sett {
                     $t{$lb}=~s/\#/$trow/g;                      $t{$lb}=~s/\#/$trow/g;
                     $t{$lb}=~s/\.\.+/\,/g;                      $t{$lb}=~s/\.\.+/\,/g;
                     $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;                      $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
                     $t{$lb}=~s/(^|[^\"\'])\[(\w+)\]/$1\$c\{\'$2\'\}/g;                      $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
                 }                  }
       }        }
             } keys %f;      }
   }    }
       }        }
     } keys %f;      }
     map {      foreach (keys(%f)) {
  if (($f{$_}) && ($_!~/template\_/)) {   if (($f{$_}) && ($_!~/template\_/)) {
             my $matches=($_=~/^$pattern(\d+)/);              my $matches=($_=~/^$pattern(\d+)/);
             if  (($matches) && ($1)) {              if  (($matches) && ($1)) {
Line 350  sub sett { Line 785  sub sett {
        $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\$v\{\'$2\'\}/g;
                $t{$_}=~s/(^|[^\"\'])\[([\w\.]+)\]/$1\$c\{\'$2\'\}/g;                 $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
             }              }
         }          }
     } keys %f;      }
     $t{'A0'}=$f{'A0'};      $t{'A0'}=$f{'A0'};
     $t{'A0'}=~s/\.\.+/\,/g;      $t{'A0'}=~s/\.\.+/\,/g;
     $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;      $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
     $t{'A0'}=~s/(^|[^\"\'])\[([\w\.]+)\]/$1\$c\{\'$2\'\}/g;      $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
 }  }
   
 sub calc {  sub calc {
Line 367  sub calc { Line 802  sub calc {
     my $depth=0;      my $depth=0;
     while ($notfinished) {      while ($notfinished) {
  $notfinished=0;   $notfinished=0;
         map {          foreach (keys(%t)) {
             my $old=$v{$_};              my $old=$v{$_};
             $v{$_}=eval($t{$_});              $v{$_}=eval($t{$_});
     if ($@) {      if ($@) {
Line 375  sub calc { Line 810  sub calc {
                 return $@;                  return $@;
             }              }
     if ($v{$_} ne $old) { $notfinished=1; }      if ($v{$_} ne $old) { $notfinished=1; }
         } keys %t;          }
         $depth++;          $depth++;
         if ($depth>100) {          if ($depth>100) {
     %v=();      %v=();
Line 388  sub calc { Line 823  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;          $cols[$#cols+1]="'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;
 }  }
   
Line 404  sub outrowassess { Line 839  sub outrowassess {
     my @cols=();      my @cols=();
     if ($n) {      if ($n) {
        my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n});         my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n});
        $cols[0]=$rl{$f{'A'.$n}}.'<br>'.         $cols[0]=$rl{$usy}.'<br>'.
                 '<select name="sel_'.$n.'" onChange="changesheet('.$n.                  '<select name="sel_'.$n.'" onChange="changesheet('.$n.
                 ')"><option name="default">Default</option>';                  ')"><option name="default">Default</option>';
        map {         foreach (@os) {
            $cols[0].='<option name="'.$_.'"';             $cols[0].='<option name="'.$_.'"';
             if ($ufn eq $_) {              if ($ufn eq $_) {
                $cols[0].=' selected';                 $cols[0].=' selected';
             }              }
             $cols[0].='>'.$_.'</option>';              $cols[0].='>'.$_.'</option>';
        } @os;         }
        $cols[0].='</select>';         $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___'.$v{$_.$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 437  sub outrow { Line 872  sub outrow {
     } 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};          $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$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',
        'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
  $exportarray[$#exportarray+1]=$v{$_.'0'};   $exportarray[$#exportarray+1]=$v{$_.'0'};
     } ('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 @exportarray;      return @exportarray;
 }  }
   
Line 532  sub getmaxrow { Line 967  sub getmaxrow {
     my $safeeval=shift;      my $safeeval=shift;
     return $safeeval->reval('$maxrow');      return $safeeval->reval('$maxrow');
 }  }
 # -------------------------------------------- Store which sheet needs changing  
   
 sub changesheet {  
     my ($safeeval,$nfield,$nsheet)=@_;  
     $safeeval->reval('$nfield='.$nfield.'; $nsheet='.$nsheet.';');  
 }  
   
 # ---------------------------------------------------------------- Set filename  # ---------------------------------------------------------------- Set filename
   
Line 643  sub rown { Line 1072  sub rown {
     my ($safeeval,$n)=@_;      my ($safeeval,$n)=@_;
     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;
     if (&gettype($safeeval) eq 'studentcalc') {      my $sheettype=&gettype($safeeval);
       if ($sheettype eq 'studentcalc') {
         $proc='&outrowassess';          $proc='&outrowassess';
         $maxred=26;          $maxred=26;
     } else {      } else {
         $proc='&outrow';          $proc='&outrow';
     }      }
     if (&gettype($safeeval) eq 'assesscalc') {      if ($sheettype eq 'assesscalc') {
         $maxred=1;          $maxred=1;
     } else {      } else {
         $maxred=26;          $maxred=26;
     }      }
     if ($n eq '-') { $proc='&templaterow'; $n=-1; }      if ($n eq '-') { $proc='&templaterow'; $n=-1; $dataflag=1; }
     map {      foreach ($safeeval->reval($proc.'('.$n.')')) {
        my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');         my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
        my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);         my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
          if ((($vl ne '') || ($vl eq '0')) &&
              (($showf==1) || ($sheettype ne 'studentcalc'))) { $dataflag=1; }
        if ($showf==0) { $vl=$_; }         if ($showf==0) { $vl=$_; }
         unless ($ENV{'form.showcsv'}) {
        if ($showf<=$maxred) { $bgcolor='#FFDDDD'; }         if ($showf<=$maxred) { $bgcolor='#FFDDDD'; }
        if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }          if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; } 
        if (($showf>$maxred) || ((!$n) && ($showf>0))) {         if (($showf>$maxred) || ((!$n) && ($showf>0))) {
Line 697  sub rown { Line 1118  sub rown {
        } else {         } else {
            $rowdata.='<td bgcolor='.$bgcolor.'>&nbsp;'.$vl.'&nbsp;</td>';             $rowdata.='<td bgcolor='.$bgcolor.'>&nbsp;'.$vl.'&nbsp;</td>';
        }         }
         } else {
     $rowdata.=',"'.$vl.'"';
         }
        $showf++;         $showf++;
     } $safeeval->reval($proc.'('.$n.')');      }  # End of foreach($safeval...)
     return $rowdata.'</tr>';      if ($ENV{'form.showall'} || ($dataflag)) {
          return $rowdata.($ENV{'form.showcsv'}?'':'</tr>');
       } else {
          return '';
       }
 }  }
   
 # ------------------------------------------------------------- Print out sheet  # ------------------------------------------------------------- Print out sheet
Line 719  sub outsheet { Line 1147  sub outsheet {
         $realm='Course';          $realm='Course';
     }      }
     my $maxyellow=52-$maxred;      my $maxyellow=52-$maxred;
     my $tabledata=      my $tabledata;
       unless ($ENV{'form.showcsv'}) {
          $tabledata=
         '<table border=2><tr><th colspan=2 rowspan=2><font size=+2>'.          '<table border=2><tr><th colspan=2 rowspan=2><font size=+2>'.
                   $realm.'</font></th>'.                    $realm.'</font></th>'.
                   '<td bgcolor=#FFDDDD colspan='.$maxred.                    '<td bgcolor=#FFDDDD colspan='.$maxred.
Line 727  sub outsheet { Line 1157  sub outsheet {
                   '<td colspan='.$maxyellow.                    '<td colspan='.$maxyellow.
   '><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',
        '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') {
         $showf++;          $showf++;
         if ($showf<=$maxred) {           if ($showf<=$maxred) { 
            $tabledata.='<td bgcolor="#FFDDDD">';              $tabledata.='<td bgcolor="#FFDDDD">'; 
Line 735  sub outsheet { Line 1168  sub outsheet {
            $tabledata.='<td>';             $tabledata.='<td>';
         }          }
         $tabledata.="<b><font size=+1>$_</font></b></td>";          $tabledata.="<b><font size=+1>$_</font></b></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',      $tabledata.='</tr>'.&rown($safeeval,'-').&rown($safeeval,0);
        'a','b','c','d','e','f','g','h','i','j','k','l','m',     } else { $tabledata='<pre>'; }
        'n','o','p','q','r','s','t','u','v','w','x','y','z');  
     $tabledata.='</tr>';      $r->print($tabledata);
   
     my $row;      my $row;
     my $maxrow=&getmaxrow($safeeval);      my $maxrow=&getmaxrow($safeeval);
     $tabledata.=&rown($safeeval,'-');  
     $r->print($tabledata);      my @sortby=();
     for ($row=0;$row<=$maxrow;$row++) {      my @sortidx=();
         $r->print(&rown($safeeval,$row));      for ($row=1;$row<=$maxrow;$row++) {
          $sortby[$row-1]=$safeeval->reval('$f{"A'.$row.'"}');
          $sortidx[$row-1]=$row-1;
     }      }
     $r->print('</table>');      @sortidx=sort { $sortby[$a] cmp $sortby[$b]; } @sortidx;
   
           my $what='Student';
           if (&gettype($safeeval) eq 'assesscalc') {
       $what='Item';
    } elsif (&gettype($safeeval) eq 'studentcalc') {
               $what='Assessment';
           }
   
       my $n=0;
       for ($row=0;$row<$maxrow;$row++) {
        my $thisrow=&rown($safeeval,$sortidx[$row]+1);
        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>');
           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') {
              $r->print('<td>'.$_.'</td>');
           }
           $r->print('</tr>');
          }
          $n++;
          $r->print($thisrow);
         }
       }
       $r->print($ENV{'form.showcsv'}?'</pre>':'</table>');
 }  }
   
 #  #
 # ----------------------------------------------- Read list of available sheets  # ----------------------------------------------- Read list of available sheets
 #   # 
   
 sub othersheets {  sub othersheets {
     my ($safeeval,$stype)=@_;      my ($safeeval,$stype)=@_;
       #
     my $cnum=&getcnum($safeeval);      my $cnum=&getcnum($safeeval);
     my $cdom=&getcdom($safeeval);      my $cdom=&getcdom($safeeval);
     my $chome=&getchome($safeeval);      my $chome=&getchome($safeeval);
       #
     my @alternatives=();      my @alternatives=();
     my $result=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'.      my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum);
                                       $stype.'_spreadsheets',$chome);      my ($tmp) = keys(%results);
     if ($result!~/^error\:/) {      unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
  map {          @alternatives = sort (keys(%results));
             $alternatives[$#alternatives+1]=      }
             &Apache::lonnet::unescape((split(/\=/,$_))[0]);  
         } split(/\&/,$result);  
     }   
     return @alternatives;       return @alternatives; 
 }  }
   
   
   #
   # -------------------------------------- Parse a spreadsheet
   # 
   sub parse_sheet {
       # $sheetxml is a scalar reference or a scalar
       my ($sheetxml) = @_;
       if (! ref($sheetxml)) {
           my $tmp = $sheetxml;
           $sheetxml = \$tmp;
       }
       my %f;
       my $parser=HTML::TokeParser->new($sheetxml);
       my $token;
       while ($token=$parser->get_token) {
           if ($token->[0] eq 'S') {
               if ($token->[1] eq 'field') {
                   $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
                       $parser->get_text('/field');
               }
               if ($token->[1] eq 'template') {
                   $f{'template_'.$token->[2]->{'col'}}=
                       $parser->get_text('/template');
               }
           }
       }
       return \%f;
   }
   
 #  #
 # -------------------------------------- Read spreadsheet formulas for a course  # -------------------------------------- Read spreadsheet formulas for a course
 #  #
Line 784  sub readsheet { Line 1274  sub readsheet {
   my $cdom=&getcdom($safeeval);    my $cdom=&getcdom($safeeval);
   my $chome=&getchome($safeeval);    my $chome=&getchome($safeeval);
   
 # --------- There is no filename. Look for defaults in course and global, cache    if (! defined($fn)) {
         # There is no filename. Look for defaults in course and global, cache
   unless($fn) {  
       unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {        unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {
          $fn=&Apache::lonnet::reply('get:'.$cdom.':'.$cnum.            my %tmphash = &Apache::lonnet::get('environment',
                                     ':environment:spreadsheet_default_'.$stype,                                               ['spreadsheet_default_'.$stype],
                                     $chome);                                               $cdom,$cnum);
          unless (($fn) && ($fn!~/^error\:/)) {            my ($tmp) = keys(%tmphash);
      $fn='default_'.$stype;            if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
          }                $fn = 'default_'.$stype;
          $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn;             } else {
                 $fn = $tmphash{'spreadsheet_default_'.$stype};
             } 
             $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 
       }        }
   }    }
   
Line 813  sub readsheet { Line 1305  sub readsheet {
      my %f=();       my %f=();
   
      if ($fn=~/^default\_/) {       if ($fn=~/^default\_/) {
  my $sheetxml='';           my $sheetxml='';
        {  
          my $fh;           my $fh;
          if ($fh=Apache::File->new($includedir.           my $dfn=$fn;
                          '/default.'.&gettype($safeeval))) {           $dfn=~s/\_/\./g;
                $sheetxml=join('',<$fh>);           if ($fh=Apache::File->new($includedir.'/'.$dfn)) {
           }               $sheetxml=join('',<$fh>);
        }           } else {
         my $parser=HTML::TokeParser->new(\$sheetxml);               $sheetxml='<field row="0" col="A">"Error"</field>';
         my $token;           }
         while ($token=$parser->get_token) {           %f=%{&parse_sheet(\$sheetxml)};
           if ($token->[0] eq 'S') {       } elsif($fn=~/\/*\.spreadsheet$/) {
       if ($token->[1] eq 'field') {           my $sheetxml=&Apache::lonnet::getfile
   $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=               (&Apache::lonnet::filelocation('',$fn));
       $parser->get_text('/field');           if ($sheetxml == -1) {
       }               $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
              if ($token->[1] eq 'template') {                   .$fn.'"</field>';
                  $f{'template_'.$token->[2]->{'col'}}=           }
                      $parser->get_text('/template');           %f=%{&parse_sheet(\$sheetxml)};
        } else {
            my $sheet='';
            my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
            my ($tmp) = keys(%tmphash);
            unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
                foreach (keys(%tmphash)) {
                    $f{$_}=$tmphash{$_};
              }               }
           }           }
         }       }
       } else {  
           my $sheet='';  
           my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'.$fn,  
                                          $chome);  
           unless ($reply=~/^error\:/) {  
              $sheet=$reply;  
   }  
           map {  
              my ($name,$value)=split(/\=/,$_);  
              $f{&Apache::lonnet::unescape($name)}=  
         &Apache::lonnet::unescape($value);  
           } split(/\&/,$sheet);  
        }  
 # --------------------------------------------------------------- Cache and set  # --------------------------------------------------------------- Cache and set
        $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);           $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);  
        &setformulas($safeeval,%f);         &setformulas($safeeval,%f);
Line 892  sub writesheet { Line 1377  sub writesheet {
     $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);          $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);    
 # ----------------------------------------------------------------- Write sheet  # ----------------------------------------------------------------- Write sheet
     my $sheetdata='';      my $sheetdata='';
     map {      foreach (keys(%f)) {
        unless ($f{$_} eq 'import') {
        $sheetdata.=&Apache::lonnet::escape($_).'='.         $sheetdata.=&Apache::lonnet::escape($_).'='.
    &Apache::lonnet::escape($f{$_}).'&';     &Apache::lonnet::escape($f{$_}).'&';
     } keys %f;       }
       }
     $sheetdata=~s/\&$//;      $sheetdata=~s/\&$//;
     my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'.      my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'.
               $sheetdata,$chome);                $sheetdata,$chome);
Line 962  sub tmpread { Line 1449  sub tmpread {
         }          }
     }      }
     if ($nform eq 'changesheet') {      if ($nform eq 'changesheet') {
           $fo{'A'.$nfield}=(split(/\_\_\&\&\&\_\_/,$fo{'A'.$nfield}))[0];
         unless ($ENV{'form.sel_'.$nfield} eq 'Default') {          unless ($ENV{'form.sel_'.$nfield} eq 'Default') {
     &changesheet($safeeval,$nfield,$ENV{'form.sel_'.$nfield});      $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};
         }          }
     } else {      } else {
        if ($nfield) { $fo{$nfield}=$nform; }         if ($nfield) { $fo{$nfield}=$nform; }
Line 995  sub parmval { Line 1483  sub parmval {
 # ----------------------------------------------------- Cascading lookup scheme  # ----------------------------------------------------- Cascading lookup scheme
        my $rwhat=$what;         my $rwhat=$what;
        $what=~s/^parameter\_//;         $what=~s/^parameter\_//;
        $what=~s/\_/\./;         $what=~s/\_([^\_]+)$/\.$1/;
   
        my $symbparm=$symb.'.'.$what;         my $symbparm=$symb.'.'.$what;
        my $mapparm=$mapname.'___(all).'.$what;         my $mapparm=$mapname.'___(all).'.$what;
Line 1075  sub updateclasssheet { Line 1563  sub updateclasssheet {
     my %currentlist=();      my %currentlist=();
     my $now=time;      my $now=time;
     unless ($classlst=~/^error\:/) {      unless ($classlst=~/^error\:/) {
         map {          foreach (split(/\&/,$classlst)) {
             my ($name,$value)=split(/\=/,$_);              my ($name,$value)=split(/\=/,$_);
             my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));              my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));
             my $active=1;              my $active=1;
Line 1086  sub updateclasssheet { Line 1574  sub updateclasssheet {
                 my ($sname,$sdom)=split(/\:/,$name);                  my ($sname,$sdom)=split(/\:/,$name);
                 my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);                  my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);
                 if ($ssec==-1) {                  if ($ssec==-1) {
      unless ($ENV{'form.showcsv'}) {
                     $rowlabel='<font color=red>Data not available: '.$name.                      $rowlabel='<font color=red>Data not available: '.$name.
       '</font>';        '</font>';
      } else {
          $rowlabel='ERROR","'.$name.
                                    '","Data not available","","","';
                      }
                 } else {                  } else {
                     my %reply=&Apache::lonnet::idrget($sdom,$sname);                      my %reply=&Apache::lonnet::idrget($sdom,$sname);
                     my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.                      my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.
       ':environment:firstname&middlename&lastname&generation',        ':environment:firstname&middlename&lastname&generation',
                       &Apache::lonnet::homeserver($sname,$sdom));                        &Apache::lonnet::homeserver($sname,$sdom));
      unless ($ENV{'form.showcsv'}) {
                     $rowlabel='<a href="/adm/studentcalc?uname='.$sname.                      $rowlabel='<a href="/adm/studentcalc?uname='.$sname.
                               '&udom='.$sdom.'">'.                                '&udom='.$sdom.'">'.
                               $ssec.'&nbsp;'.$reply{$sname}.'<br>';                                $ssec.'&nbsp;'.$reply{$sname}.'<br>';
                     map {                      foreach ( split(/\&/,$reply)) {
                         $rowlabel.=&Apache::lonnet::unescape($_).' ';                          $rowlabel.=&Apache::lonnet::unescape($_).' ';
                     } split(/\&/,$reply);                      }
                     $rowlabel.='</a>';                      $rowlabel.='</a>';
      } else {
       $rowlabel=$ssec.'","'.$reply{$sname}.'"';
                       my $ncount=0;
                       foreach (split(/\&/,$reply)) {
                           $rowlabel.=',"'.&Apache::lonnet::unescape($_).'"';
                           $ncount++;
                       }
                       unless ($ncount==4) { $rowlabel.=',""'; }
                       $rowlabel=~s/\"$//;
      }
                 }                  }
  $currentlist{&Apache::lonnet::unescape($name)}=$rowlabel;   $currentlist{&Apache::lonnet::unescape($name)}=$rowlabel;
             }              }
         } split(/\&/,$classlst);          } # end of foreach (split(/\&/,$classlst))
 #  #
 # -------------------- Find discrepancies between the course row table and this  # -------------------- Find discrepancies between the course row table and this
 #  #
Line 1114  sub updateclasssheet { Line 1618  sub updateclasssheet {
         my %existing=();          my %existing=();
   
 # ----------------------------------------------------------- Now obsolete rows  # ----------------------------------------------------------- Now obsolete rows
  map {   foreach (keys(%f)) {
     if ($_=~/^A(\d+)/) {      if ($_=~/^A(\d+)/) {
                 $maxrow=($1>$maxrow)?$1:$maxrow;                  $maxrow=($1>$maxrow)?$1:$maxrow;
                 $existing{$f{$_}}=1;                  $existing{$f{$_}}=1;
Line 1123  sub updateclasssheet { Line 1627  sub updateclasssheet {
                    $changed=1;                     $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); }          if ($changed) { &setformulas($safeeval,%f); }
   
Line 1159  sub updatestudentassesssheet { Line 1663  sub updatestudentassesssheet {
 # --------------------------------------------------------- Get all assessments  # --------------------------------------------------------- Get all assessments
   
  my %allkeys=('timestamp' =>    my %allkeys=('timestamp' => 
                      'Timestamp of Last Transaction<br>timestamp');                       'Timestamp of Last Transaction<br>timestamp',
         my %allassess=();                       '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 ((&getuname($safeeval) ne $ENV{'user.name'}) ||
Line 1169  sub updatestudentassesssheet { Line 1678  sub updatestudentassesssheet {
  '&udom='.&getudom($safeeval);   '&udom='.&getudom($safeeval);
         }          }
   
         map {          my %allassess=('_feedback' =>
                 '<a href="/adm/assesscalc?usymb=_feedback'.$adduserstr.
                          '">Feedback</a>',
                          '_evaluation' =>
                 '<a href="/adm/assesscalc?usymb=_evaluation'.$adduserstr.
                          '">Evaluation</a>',
                          '_tutoring' =>
                 '<a href="/adm/assesscalc?usymb=_tutoring'.$adduserstr.
                          '">Tutoring</a>',
                          '_discussion' =>
                 '<a href="/adm/assesscalc?usymb=_discussion'.$adduserstr.
                          '">Discussion</a>'
           );
   
           foreach (keys(%bighash)) {
     if ($_=~/^src\_(\d+)\.(\d+)$/) {      if ($_=~/^src\_(\d+)\.(\d+)$/) {
        my $mapid=$1;         my $mapid=$1;
                my $resid=$2;                 my $resid=$2;
Line 1184  sub updatestudentassesssheet { Line 1707  sub updatestudentassesssheet {
             '<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'.              '<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'.
                      $bighash{'title_'.$id}.'</a>';                       $bighash{'title_'.$id}.'</a>';
                  if ($stype eq 'assesscalc') {                   if ($stype eq 'assesscalc') {
                    map {       foreach (split(/\,/,
       &Apache::lonnet::metadata($srcf,'keys'))) {
                        if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) {                         if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) {
   my $key=$_;    my $key=$_;
                           my $display=                            my $display=
Line 1196  sub updatestudentassesssheet { Line 1720  sub updatestudentassesssheet {
                           $display.='<br>'.$key;                            $display.='<br>'.$key;
                           $allkeys{$key}=$display;                            $allkeys{$key}=$display;
        }         }
                    } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));                     } # end of foreach
          }           }
       }        }
    }     }
         } keys %bighash;          } # end of foreach (keys(%bighash))
         untie(%bighash);          untie(%bighash);
           
 #  #
Line 1232  sub updatestudentassesssheet { Line 1756  sub updatestudentassesssheet {
         my %existing=();          my %existing=();
   
 # ----------------------------------------------------------- Now obsolete rows  # ----------------------------------------------------------- Now obsolete rows
  map {   foreach (keys(%f)) {
     if ($_=~/^A(\d+)/) {      if ($_=~/^A(\d+)/) {
                 $maxrow=($1>$maxrow)?$1:$maxrow;                  $maxrow=($1>$maxrow)?$1:$maxrow;
                 $existing{$f{$_}}=1;                  my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});
  unless ((defined($current{$f{$_}})) || (!$1)) {                  $existing{$usy}=1;
    unless ((defined($current{$usy})) || (!$1)) {
    $f{$_}='!!! Obsolete';     $f{$_}='!!! Obsolete';
                    $changed=1;                     $changed=1;
           } elsif ($ufn) {
       $current{$usy}
                          =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/;
                 }                  }
             }              }
         } keys %f;          }
   
 # -------------------------------------------------------- New and unknown keys  # -------------------------------------------------------- New and unknown keys
             
         map {          foreach (keys(%current)) {
             unless ($existing{$_}) {              unless ($existing{$_}) {
  $changed=1;   $changed=1;
                 $maxrow++;                  $maxrow++;
                 $f{'A'.$maxrow}=$_;                  $f{'A'.$maxrow}=$_;
             }              }
         } keys %current;                  }
           
         if ($changed) { &setformulas($safeeval,%f); }          if ($changed) { &setformulas($safeeval,%f); }
   
Line 1276  sub loadstudent { Line 1804  sub loadstudent {
                                                &getcid($safeeval),                                                 &getcid($safeeval),
                                                &getuhome($safeeval));                                                 &getuhome($safeeval));
       unless ($reply=~/^error\:/) {        unless ($reply=~/^error\:/) {
          map {   foreach ( split(/\&/,$reply)) {
             my ($name,$value)=split(/\=/,$_);              my ($name,$value)=split(/\=/,$_);
             $cachedstores{&Apache::lonnet::unescape($name)}=              $cachedstores{&Apache::lonnet::unescape($name)}=
                   &Apache::lonnet::unescape($value);                    &Apache::lonnet::unescape($value);
          } split(/\&/,$reply);   }
       }        }
     }      }
     my @assessdata=();      my @assessdata=();
     map {      foreach (keys(%f)) {
  if ($_=~/^A(\d+)/) {   if ($_=~/^A(\d+)/) {
    my $row=$1;     my $row=$1;
            unless (($f{$_}=~/^\!/) || ($row==0)) {             unless (($f{$_}=~/^\!/) || ($row==0)) {
Line 1293  sub loadstudent { Line 1821  sub loadstudent {
                                        &getudom($safeeval),                                         &getudom($safeeval),
                                        'assesscalc',$usy,$ufn);                                         'assesscalc',$usy,$ufn);
               my $index=0;                my $index=0;
               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') {
                   if ($assessdata[$index]) {                    if ($assessdata[$index]) {
      my $col=$_;       my $col=$_;
      if ($assessdata[$index]=~/\D/) {       if ($assessdata[$index]=~/\D/) {
Line 1306  sub loadstudent { Line 1835  sub loadstudent {
                      }                       }
   }    }
                   $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;      }
     $cachedassess='';      $cachedassess='';
     undef %cachedstores;      undef %cachedstores;
     &setformulas($safeeval,%f);      &setformulas($safeeval,%f);
Line 1324  sub loadcourse { Line 1852  sub loadcourse {
     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 1343  sub loadcourse { Line 1871  sub loadcourse {
 </script>  </script>
 ENDPOP  ENDPOP
     $r->rflush();      $r->rflush();
     map {      foreach (keys(%f)) {
  if ($_=~/^A(\d+)/) {   if ($_=~/^A(\d+)/) {
    my $row=$1;     my $row=$1;
            unless (($f{$_}=~/^\!/)  || ($row==0)) {             unless (($f{$_}=~/^\!/)  || ($row==0)) {
Line 1357  ENDPOP Line 1885  ENDPOP
               $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',
                 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
                   if ($studentdata[$index]) {                    if ($studentdata[$index]) {
      my $col=$_;       my $col=$_;
      if ($studentdata[$index]=~/\D/) {       if ($studentdata[$index]=~/\D/) {
Line 1370  ENDPOP Line 1899  ENDPOP
                      }                       }
   }    }
                   $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 1410  sub loadassessment { Line 1938  sub loadassessment {
        my $version=$cachedstores{'version:'.$symb};         my $version=$cachedstores{'version:'.$symb};
        my $scope;         my $scope;
        for ($scope=1;$scope<=$version;$scope++) {         for ($scope=1;$scope<=$version;$scope++) {
            map {             foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) {
                $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};                 $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};
            } split(/\:/,$cachedstores{$scope.':keys:'.$symb});              } 
        }         }
   
    } else {     } else {
Line 1424  sub loadassessment { Line 1952  sub loadassessment {
        "restore:$udom:$uname:".         "restore:$udom:$uname:".
        &Apache::lonnet::escape($namespace).":".         &Apache::lonnet::escape($namespace).":".
        &Apache::lonnet::escape($symb),$uhome);         &Apache::lonnet::escape($symb),$uhome);
     map {      foreach (split(/\&/,$answer)) {
  my ($name,$value)=split(/\=/,$_);   my ($name,$value)=split(/\=/,$_);
         $returnhash{&Apache::lonnet::unescape($name)}=          $returnhash{&Apache::lonnet::unescape($name)}=
                     &Apache::lonnet::unescape($value);                      &Apache::lonnet::unescape($value);
     } split(/\&/,$answer);      }
     my $version;      my $version;
     for ($version=1;$version<=$returnhash{'version'};$version++) {      for ($version=1;$version<=$returnhash{'version'};$version++) {
        map {         foreach (split(/\:/,$returnhash{$version.':keys'})) {
           $returnhash{$_}=$returnhash{$version.':'.$_};            $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
   
       my @oldkeys=keys %returnhash;
   
       foreach (@oldkeys) {
           my $name=$_;
           my $value=$returnhash{$_};
           delete $returnhash{$_};
           $name=~s/\_/\./g;
           $returnhash{$name}=$value;
       }
   
 # ---------------------------- initialize coursedata and userdata for this user  # ---------------------------- initialize coursedata and userdata for this user
     undef %courseopt;      undef %courseopt;
     undef %useropt;      undef %useropt;
Line 1455  sub loadassessment { Line 1995  sub loadassessment {
             $courserdatas{$cid.'.last_cache'}=time;              $courserdatas{$cid.'.last_cache'}=time;
          }           }
       }        }
       map {        foreach (split(/\&/,$courserdatas{$cid})) {
          my ($name,$value)=split(/\=/,$_);           my ($name,$value)=split(/\=/,$_);
          $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=           $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
                     &Apache::lonnet::unescape($value);                        &Apache::lonnet::unescape($value);  
       } split(/\&/,$courserdatas{$cid});        }
 # --------------------------------------------------- Get userdata (if present)  # --------------------------------------------------- Get userdata (if present)
       unless        unless
         ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {          ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
Line 1470  sub loadassessment { Line 2010  sub loadassessment {
      $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;       $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
          }           }
       }        }
       map {        foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) {
          my ($name,$value)=split(/\=/,$_);           my ($name,$value)=split(/\=/,$_);
          $useropt{$userprefix.&Apache::lonnet::unescape($name)}=           $useropt{$userprefix.&Apache::lonnet::unescape($name)}=
           &Apache::lonnet::unescape($value);            &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)
   
   #
   # Load keys for this assessment only
   #
       my %thisassess=();
       my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb);
       
       foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) {
           $thisassess{$_}=1;
       } 
   #
   # Load parameters
   #
    my %c=();     my %c=();
   
    if (tie(%parmhash,'GDBM_File',     if (tie(%parmhash,'GDBM_File',
            &getcfn($safeeval).'_parms.db',&GDBM_READER,0640)) {             &getcfn($safeeval).'_parms.db',&GDBM_READER,0640)) {
     my %f=&getformulas($safeeval);      my %f=&getformulas($safeeval);
     map {      foreach (keys(%f))  {
  if ($_=~/^A/) {   if ($_=~/^A/) {
             unless ($f{$_}=~/^\!/) {              unless ($f{$_}=~/^\!/) {
         if ($f{$_}=~/^parameter/) {          if ($f{$_}=~/^parameter/) {
    if ($thisassess{$f{$_}}) {
                   my $val=&parmval($f{$_},$safeeval);                    my $val=&parmval($f{$_},$safeeval);
                   $c{$_}=$val;                    $c{$_}=$val;
                   $c{$f{$_}}=$val;                    $c{$f{$_}}=$val;
           }
        } else {         } else {
   my $key=$f{$_};    my $key=$f{$_};
                   my $ckey=$key;                    my $ckey=$key;
                   $key=~s/^stores\_/resource\./;                    $key=~s/^stores\_/resource\./;
                   $key=~s/\_/\./;                    $key=~s/\_/\./g;
            $c{$_}=$returnhash{$key};             $c{$_}=$returnhash{$key};
                   $c{$ckey}=$returnhash{$key};                    $c{$ckey}=$returnhash{$key};
        }         }
    }     }
         }          }
     } keys %f;      }
     untie(%parmhash);      untie(%parmhash);
    }     }
    &setconstants($safeeval,%c);     &setconstants($safeeval,%c);
Line 1523  sub hiddenfield { Line 2077  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 1602  sub forcedrecalc { Line 2156  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)) {
       $fn='default_'.$1;
    }
   
 #  #
 # Check if cached  # Check if cached
 #  #
Line 1610  sub exportsheet { Line 2169  sub exportsheet {
  my $found='';   my $found='';
   
  if ($oldsheets{$key}) {   if ($oldsheets{$key}) {
      map {       foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
          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) {   unless ($found) {
      &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));       &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));
      if ($oldsheets{$key}) {       if ($oldsheets{$key}) {
         map {   foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
             my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);              my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
             if ($name eq $fn) {              if ($name eq $fn) {
         $found=$value;          $found=$value;
             }              }
         } split(/\_\_\_\&\_\_\_/,$oldsheets{$key});          } 
      }       }
  }   }
 #  #
Line 1679  sub exportsheet { Line 2238  sub exportsheet {
     }      }
     my %currentlystored=();      my %currentlystored=();
     unless ($current=~/^error\:/) {      unless ($current=~/^error\:/) {
        map {         foreach (split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current))) {
            my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);             my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
            $currentlystored{$name}=$value;             $currentlystored{$name}=$value;
        } split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current));         }
     }      }
     $currentlystored{$fn}=join('___;___',@exportarr);      $currentlystored{$fn}=join('___;___',@exportarr);
   
     my $newstore='';      my $newstore='';
     map {      foreach (keys(%currentlystored)) {
         if ($newstore) { $newstore.='___&___'; }          if ($newstore) { $newstore.='___&___'; }
         $newstore.=$_.'___=___'.$currentlystored{$_};          $newstore.=$_.'___=___'.$currentlystored{$_};
     } keys %currentlystored;      }
     my $now=time;      my $now=time;
     if ($stype eq 'studentcalc') {      if ($stype eq 'studentcalc') {
        &Apache::lonnet::reply('put:'.         &Apache::lonnet::reply('put:'.
Line 1729  sub expirationdates { Line 2288  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 1750  sub cachedcsheets { Line 2309  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 1772  sub cachedssheets { Line 2331  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 1814  $tmpdir=$r->dir_config('lonDaemons').'/t Line 2373  $tmpdir=$r->dir_config('lonDaemons').'/t
   
 # --------------------------- Get query string for limited number of parameters  # --------------------------- Get query string for limited number of parameters
   
     map {      foreach (split(/&/,$ENV{'QUERY_STRING'})) {
        my ($name, $value) = split(/=/,$_);         my ($name, $value) = split(/=/,$_);
        $value =~ tr/+/ /;         $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;         $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
Line 1824  $tmpdir=$r->dir_config('lonDaemons').'/t Line 2383  $tmpdir=$r->dir_config('lonDaemons').'/t
               $ENV{'form.'.$name}=$value;                $ENV{'form.'.$name}=$value;
    }     }
        }         }
     } (split(/&/,$ENV{'QUERY_STRING'}));      }
   
       if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) {
    $ENV{'form.ufn'}='default_'.$1;
       }
   
 # -------------------------------------- Interactive loading of specific sheet?  # -------------------------------------- Interactive loading of specific sheet?
     if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {      if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {
Line 1858  $tmpdir=$r->dir_config('lonDaemons').'/t Line 2421  $tmpdir=$r->dir_config('lonDaemons').'/t
   
     function celledit(cn,cf) {      function celledit(cn,cf) {
         var cnf=prompt(cn,cf);          var cnf=prompt(cn,cf);
  if (cnf!=null) {          if (cnf!=null) {
     document.sheet.unewfield.value=cn;              document.sheet.unewfield.value=cn;
             document.sheet.unewformula.value=cnf;              document.sheet.unewformula.value=cnf;
             document.sheet.submit();              document.sheet.submit();
         }          }
Line 1934  ENDSCRIPT Line 2497  ENDSCRIPT
         } else {          } else {
            $r->print('<br><b>Section/Group:</b> '.&getcsec($asheet));             $r->print('<br><b>Section/Group:</b> '.&getcsec($asheet));
         }          }
           if ($ENV{'form.usymb'}) {
              $r->print('<br><b>Assessment:</b> <tt>'.$ENV{'form.usymb'}.'</tt>');
           }
     }      }
   
 # ---------------------------------------------------------------- Course title  # ---------------------------------------------------------------- Course title
   
     $r->print('<h1>'.      $r->print('<h1>'.
             $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.'</h1>');              $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.
                '</h1><h3>'.localtime().'</h3>');
   
 # ---------------------------------------------------- See if user can see this  # ---------------------------------------------------- See if user can see this
   
Line 1953  ENDSCRIPT Line 2520  ENDSCRIPT
         }          }
     }      }
   
 # ---------------------------------------------------- See if something to save  
   
     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.='_'.&gettype($asheet);  
             &setfilename($asheet,$fname);  
             $ENV{'form.ufn'}=$fname;  
     $r->print('<p>Saving spreadsheet: '.  
                          &writesheet($asheet,$ENV{'form.makedefufn'}).'<p>');  
  }  
     }  
   
 # ------------------------------------------------ Write the modified worksheet  
   
    $r->print('<b>Current sheet:</b> '.&getfilename($asheet).'<p>');  
   
    &tmpwrite($asheet);  
   
 # ---------------------------------------------------------- Additional options  # ---------------------------------------------------------- Additional options
   
     $r->print(      $r->print(
Line 2013  ENDSCRIPT Line 2559  ENDSCRIPT
  $r->print('<p><input type=submit name=load value="Load ...">'.   $r->print('<p><input type=submit name=load value="Load ...">'.
                   '<select name="loadthissheet">'.                    '<select name="loadthissheet">'.
                   '<option name="default">Default</option>');                    '<option name="default">Default</option>');
         map {          foreach (&othersheets($asheet,&gettype($asheet))) {
     $r->print('<option name="'.$_.'"');      $r->print('<option name="'.$_.'"');
             if ($ENV{'form.ufn'} eq $_) {              if ($ENV{'form.ufn'} eq $_) {
                $r->print(' selected');                 $r->print(' selected');
             }              }
             $r->print('>'.$_.'</option>');              $r->print('>'.$_.'</option>');
         } &othersheets($asheet,&gettype($asheet));          } 
         $r->print('</select><p>');          $r->print('</select><p>');
         if (&gettype($asheet) eq 'studentcalc') {          if (&gettype($asheet) eq 'studentcalc') {
     &setothersheets($asheet,&othersheets($asheet,'assesscalc'));      &setothersheets($asheet,&othersheets($asheet,'assesscalc'));
Line 2062  ENDSCRIPT Line 2608  ENDSCRIPT
     my $calcoutput=&calcsheet($asheet);      my $calcoutput=&calcsheet($asheet);
     $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');      $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');
   
   # ---------------------------------------------------- See if something to save
   
       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.='_'.&gettype($asheet);
               &setfilename($asheet,$fname);
               $ENV{'form.ufn'}=$fname;
       $r->print('<p>Saving spreadsheet: '.
                            &writesheet($asheet,$ENV{'form.makedefufn'}).'<p>');
    }
       }
   
   # ------------------------------------------------ Write the modified worksheet
   
      $r->print('<b>Current sheet:</b> '.&getfilename($asheet).'<p>');
   
      &tmpwrite($asheet);
   
       if (&gettype($asheet) 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('>');
   
       if (&gettype($asheet) eq 'classcalc') {
          $r->print(
      ' Output CSV format: <input type=checkbox name=showcsv onClick="submit()"');
          if ($ENV{'form.showcsv'}) { $r->print(' checked'); }
          $r->print('>');
       }
   # ------------------------------------------------------------- Print out sheet
   
     &outsheet($r,$asheet);      &outsheet($r,$asheet);
     $r->print('</form></body></html>');      $r->print('</form></body></html>');
   
Line 2078  ENDSCRIPT Line 2675  ENDSCRIPT
   
 1;  1;
 __END__  __END__
   
   
   
   

Removed from v.1.55  
changed lines
  Added in v.1.87


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