Diff for /loncom/interface/Attic/lonspreadsheet.pm between versions 1.54 and 1.82

version 1.54, 2001/04/09 17:59:04 version 1.82, 2002/04/09 18:41:11
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 5 Line 30
 # 12/08,12/09,12/11,12/12,12/15,12/16,12/18,12/19,12/30,  # 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,  # 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 Gerd Kortemeyer  # 03/19,03/20,03/21,03/27,04/05,04/09,
   # 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 77  sub initsheet { Line 131  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 %v; 
 undef %t;  undef %t;
 undef %f;  undef %f;
 undef %c;  undef %c;
 undef %rl;  undef %rl;
   undef @os;
   
 $maxrow=0;  $maxrow=0;
 $sheettype='';  $sheettype='';
Line 138  sub mask { Line 194  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 241  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];
   }
   
 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 198  sub BIN { Line 518  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;   
 }  }
   
Line 210  sub BIN { Line 530  sub BIN {
 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;   
 }  }
   
 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 233  sub MEAN { Line 553  sub MEAN {
 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));    
 }  }
   
 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;   
 }  }
   
 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;   
 }  }
   
 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;   
 }  }
   
Line 279  sub SUMMAX { Line 599  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{$_};   $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=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {       for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { 
Line 294  sub SUMMIN { Line 614  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 305  sub SUMMIN { Line 625  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 313  sub sett { Line 669  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 326  sub sett { Line 682  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 344  sub sett { Line 700  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 361  sub calc { Line 717  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 369  sub calc { Line 725  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 382  sub calc { Line 738  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 397  sub outrowassess { Line 753  sub outrowassess {
     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});
          $cols[0]=$rl{$usy}.'<br>'.
                   '<select name="sel_'.$n.'" onChange="changesheet('.$n.
                   ')"><option name="default">Default</option>';
          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};          $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;
 }  }
   
Line 420  sub outrow { Line 787  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 460  sub setconstants { Line 827  sub setconstants {
     %{$safeeval->varglob('c')}=%c;      %{$safeeval->varglob('c')}=%c;
 }  }
   
   # --------------------------------------------- Set names of other spreadsheets
   
   sub setothersheets {
       my ($safeeval,@os)=@_;
       @{$safeeval->varglob('os')}=@os;
   }
   
 # ------------------------------------------------ Add or change formula values  # ------------------------------------------------ Add or change formula values
   
 sub setrowlabels {  sub setrowlabels {
Line 600  sub exportdata { Line 974  sub exportdata {
     return $safeeval->reval('&exportrowa()');      return $safeeval->reval('&exportrowa()');
 }  }
   
   
 # ========================================================== End of Spreadsheet  # ========================================================== End of Spreadsheet
 # =============================================================================  # =============================================================================
   
Line 612  sub rown { Line 987  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 'assesscalc') {      my $sheettype=&gettype($safeeval);
       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 ($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 662  sub rown { Line 1033  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 684  sub outsheet { Line 1062  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 692  sub outsheet { Line 1072  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 700  sub outsheet { Line 1083  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
   # 
   sub othersheets {
       my ($safeeval,$stype)=@_;
       #
       my $cnum=&getcnum($safeeval);
       my $cdom=&getcdom($safeeval);
       my $chome=&getchome($safeeval);
       #
       my @alternatives=();
       my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum);
       my ($tmp) = keys(%results);
       unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
           @alternatives = sort (keys(%results));
       }
       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;
 }  }
   
 #  #
Line 726  sub readsheet { Line 1189  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) || $fn eq '') {
         # 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; 
         }
     } else {
         # We do have a filename, do a get on it.
         my %tmphash = &Apache::lonnet::get('environment',
                                            [$fn],
                                            $cdom,$cnum);
         my ($tmp) = keys(%tmphash);
         if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
             # On error, grab the default filename
             $fn = 'default_'.$stype;
         } else {
             $fn = $tmphash{$fn};
       }        }
         $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 
   }    }
   
 # ---------------------------------------------------------- fn now has a value  # ---------------------------------------------------------- fn now has a value
Line 755  sub readsheet { Line 1233  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='';
   $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=           my $fh;
       $parser->get_text('/field');           my $dfn=$fn;
       }           $dfn=~s/\_/\./g;
              if ($token->[1] eq 'template') {  
                  $f{'template_'.$token->[2]->{'col'}}=           if ($fn !~ /^$Apache::lonnet::perlvar{'lonDocRoot'}\/res/) {
                      $parser->get_text('/template');               $fn = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res'.$fn;
            }
            if ($fn !~ /^$Apache::lonnet::perlvar{'lonDocRoot'}/) {
                $fn = $Apache::lonnet::perlvar{'lonDocRoot'}.$fn;
            }
            if ($fh=Apache::File->new($fn)) {
                $sheetxml=join('',<$fh>);
            } else {
                $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
                    .$fn.'"</field>';
            }
            %f=&parse_sheet(\$sheetxml);
        } else {
            my $sheet='';
            my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
            my ($tmp) = keys(%tmphash);
            unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
                foreach (keys(%tmphash)) {
                    $f{$_}=$tmphash{$_};
              }               }
           }           }
         }       }
       } else {  
           my $sheet='';  
           my $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 834  sub writesheet { Line 1316  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);
     if ($reply eq 'ok') {      if ($reply eq 'ok') {
           $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.            $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.
               $stype.'_spreadsheets:'.                $stype.'_spreadsheets:'.
               &Apache::lonnet::escape($fn).'='.$ENV{'user.name'},                &Apache::lonnet::escape($fn).'='.$ENV{'user.name'}.'@'.
                                                  $ENV{'user.domain'},
               $chome);                $chome);
           if ($reply eq 'ok') {            if ($reply eq 'ok') {
               if ($makedef) {                 if ($makedef) { 
Line 902  sub tmpread { Line 1387  sub tmpread {
             $fo{$name}=$value;              $fo{$name}=$value;
         }          }
     }      }
     if ($nfield) { $fo{$nfield}=$nform; }      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};
           }
       } else {
          if ($nfield) { $fo{$nfield}=$nform; }
       }
     &setformulas($safeeval,%fo);      &setformulas($safeeval,%fo);
 }  }
   
Line 930  sub parmval { Line 1422  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 1010  sub updateclasssheet { Line 1502  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 1021  sub updateclasssheet { Line 1513  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 1049  sub updateclasssheet { Line 1557  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 1058  sub updateclasssheet { Line 1566  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 1094  sub updatestudentassesssheet { Line 1602  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 1104  sub updatestudentassesssheet { Line 1617  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 1119  sub updatestudentassesssheet { Line 1646  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 1131  sub updatestudentassesssheet { Line 1659  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 1167  sub updatestudentassesssheet { Line 1695  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 1211  sub loadstudent { Line 1743  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)) {
         my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});
       @assessdata=&exportsheet(&getuname($safeeval),        @assessdata=&exportsheet(&getuname($safeeval),
                                        &getudom($safeeval),                                         &getudom($safeeval),
                                        'assesscalc',$f{$_});                                         '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 1240  sub loadstudent { Line 1774  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 1258  sub loadcourse { Line 1791  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 1277  sub loadcourse { Line 1810  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 1291  ENDPOP Line 1824  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 1304  ENDPOP Line 1838  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 1344  sub loadassessment { Line 1877  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 1358  sub loadassessment { Line 1891  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 1389  sub loadassessment { Line 1934  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 1404  sub loadassessment { Line 1949  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 1457  sub hiddenfield { Line 2016  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 1536  sub forcedrecalc { Line 2095  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 1544  sub exportsheet { Line 2108  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 1613  sub exportsheet { Line 2177  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 1663  sub expirationdates { Line 2227  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 2248  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 2270  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 1748  $tmpdir=$r->dir_config('lonDaemons').'/t Line 2312  $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 1758  $tmpdir=$r->dir_config('lonDaemons').'/t Line 2322  $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?
       if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {
    $ENV{'form.ufn'}=$ENV{'form.loadthissheet'};
       }
 # ------------------------------------------- Nothing there? Must be login user  # ------------------------------------------- Nothing there? Must be login user
   
     my $aname;      my $aname;
Line 1795  $tmpdir=$r->dir_config('lonDaemons').'/t Line 2367  $tmpdir=$r->dir_config('lonDaemons').'/t
         }          }
     }      }
   
       function changesheet(cn) {
    document.sheet.unewfield.value=cn;
           document.sheet.unewformula.value='changesheet';
           document.sheet.submit();
       }
   
 </script>  </script>
 ENDSCRIPT  ENDSCRIPT
     $r->print('</head><body bgcolor="#FFFFFF">'.      $r->print('</head><body bgcolor="#FFFFFF">'.
Line 1858  ENDSCRIPT Line 2436  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 1877  ENDSCRIPT Line 2459  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 1932  ENDSCRIPT Line 2493  ENDSCRIPT
   
     $r->print(&hiddenfield('ufn',&getfilename($asheet)));      $r->print(&hiddenfield('ufn',&getfilename($asheet)));
   
   # ----------------------------------------------------------------- Load dialog
       if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
    $r->print('<p><input type=submit name=load value="Load ...">'.
                     '<select name="loadthissheet">'.
                     '<option name="default">Default</option>');
           foreach (&othersheets($asheet,&gettype($asheet))) {
       $r->print('<option name="'.$_.'"');
               if ($ENV{'form.ufn'} eq $_) {
                  $r->print(' selected');
               }
               $r->print('>'.$_.'</option>');
           } 
           $r->print('</select><p>');
           if (&gettype($asheet) eq 'studentcalc') {
       &setothersheets($asheet,&othersheets($asheet,'assesscalc'));
           }
       }
   
 # --------------------------------------------------------------- Cached sheets  # --------------------------------------------------------------- Cached sheets
   
     &expirationdates();      &expirationdates();
Line 1968  ENDSCRIPT Line 2547  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 1984  ENDSCRIPT Line 2613  ENDSCRIPT
   
 1;  1;
 __END__  __END__
   
   
   
   

Removed from v.1.54  
changed lines
  Added in v.1.82


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