Diff for /loncom/interface/Attic/lonspreadsheet.pm between versions 1.73 and 1.85

version 1.73, 2001/11/05 18:22:24 version 1.85, 2002/04/11 14:16:32
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 7 Line 32
 # 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,07/21,09/01,09/10,9/11,9/12,9/13,9/14,9/17,  # 07/09,07/14,07/21,09/01,09/10,9/11,9/12,9/13,9/14,9/17,
 # 10/16,10/17,10/20,11/05 Gerd Kortemeyer  # 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 142  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 189  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];
   }
   
   #-------------------------------------------------------
   
   =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 202  sub BIN { Line 527  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 234  sub MEAN { Line 577  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 294  sub SUMMAX { Line 683  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 316  sub expandnamed { Line 715  sub expandnamed {
  my @vars=split(/\W+/,$formula);   my @vars=split(/\W+/,$formula);
         my %values=();          my %values=();
         undef %values;          undef %values;
         map {   foreach ( @vars ) {
             my $varname=$_;              my $varname=$_;
             if ($varname=~/\D/) {              if ($varname=~/\D/) {
                $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;                 $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;
                $varname=~s/$var/\(\\w\+\)/g;                 $varname=~s/$var/\(\\w\+\)/g;
        map {         foreach (keys(%c)) {
   if ($_=~/$varname/) {    if ($_=~/$varname/) {
       $values{$1}=1;        $values{$1}=1;
                   }                    }
                } keys %c;                 }
     }      }
         } @vars;          }
         if ($func eq 'EXPANDSUM') {          if ($func eq 'EXPANDSUM') {
             my $result='';              my $result='';
     map {      foreach (keys(%values)) {
                 my $thissum=$formula;                  my $thissum=$formula;
                 $thissum=~s/$var/$_/g;                  $thissum=~s/$var/$_/g;
                 $result.=$thissum.'+';                  $result.=$thissum.'+';
             } keys %values;              } 
             $result=~s/\+$//;              $result=~s/\+$//;
             return $result;              return $result;
         } else {          } else {
Line 353  sub sett { Line 752  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 369  sub sett { Line 768  sub sett {
                     $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;                      $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 387  sub sett { Line 786  sub sett {
                $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;                 $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;
Line 401  sub calc { Line 800  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 409  sub calc { Line 808  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 422  sub calc { Line 821  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 441  sub outrowassess { Line 840  sub outrowassess {
        $cols[0]=$rl{$usy}.'<br>'.         $cols[0]=$rl{$usy}.'<br>'.
                 '<select name="sel_'.$n.'" onChange="changesheet('.$n.                  '<select name="sel_'.$n.'" onChange="changesheet('.$n.
                 ')"><option name="default">Default</option>';                  ')"><option name="default">Default</option>';
        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 471  sub outrow { Line 870  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 698  sub rown { Line 1097  sub rown {
         $maxred=26;          $maxred=26;
     }      }
     if ($n eq '-') { $proc='&templaterow'; $n=-1; $dataflag=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')) &&         if ((($vl ne '') || ($vl eq '0')) &&
Line 721  sub rown { Line 1120  sub rown {
   $rowdata.=',"'.$vl.'"';    $rowdata.=',"'.$vl.'"';
       }        }
        $showf++;         $showf++;
     } $safeeval->reval($proc.'('.$n.')');      }  # End of foreach($safeval...)
     if ($ENV{'form.showall'} || ($dataflag)) {      if ($ENV{'form.showall'} || ($dataflag)) {
        return $rowdata.($ENV{'form.showcsv'}?'':'</tr>');         return $rowdata.($ENV{'form.showcsv'}?'':'</tr>');
     } else {      } else {
Line 756  sub outsheet { Line 1155  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 764  sub outsheet { Line 1166  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',  
        '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);      $tabledata.='</tr>'.&rown($safeeval,'-').&rown($safeeval,0);
    } else { $tabledata='<pre>'; }     } else { $tabledata='<pre>'; }
   
Line 799  sub outsheet { Line 1198  sub outsheet {
  $r->print("</table>\n<br>\n");   $r->print("</table>\n<br>\n");
         $r->rflush();          $r->rflush();
         $r->print('<table border=2><tr><td>&nbsp;<td>'.$what.'</td>');          $r->print('<table border=2><tr><td>&nbsp;<td>'.$what.'</td>');
         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') {
            $r->print('<td>'.$_.'</td>');             $r->print('<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');  
         $r->print('</tr>');          $r->print('</tr>');
        }         }
        $n++;         $n++;
Line 817  sub outsheet { Line 1216  sub outsheet {
 #  #
 # ----------------------------------------------- Read list of available sheets  # ----------------------------------------------- Read list of available sheets
 #   # 
   
 sub othersheets {  sub othersheets {
     my ($safeeval,$stype)=@_;      my ($safeeval,$stype)=@_;
       #
     my $cnum=&getcnum($safeeval);      my $cnum=&getcnum($safeeval);
     my $cdom=&getcdom($safeeval);      my $cdom=&getcdom($safeeval);
     my $chome=&getchome($safeeval);      my $chome=&getchome($safeeval);
       #
     my @alternatives=();      my @alternatives=();
     my $result=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'.      my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum);
                                       $stype.'_spreadsheets',$chome);      my ($tmp) = keys(%results);
     if ($result!~/^error\:/) {      unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
  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 848  sub readsheet { Line 1272  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 877  sub readsheet { Line 1303  sub readsheet {
      my %f=();       my %f=();
   
      if ($fn=~/^default\_/) {       if ($fn=~/^default\_/) {
  my $sheetxml='';           my $sheetxml='';
        {  
          my $fh;           my $fh;
          my $dfn=$fn;           my $dfn=$fn;
          $dfn=~s/\_/\./g;           $dfn=~s/\_/\./g;
          if ($fh=Apache::File->new($includedir.'/'.$dfn)) {           if ($fh=Apache::File->new($includedir.'/'.$dfn)) {
                $sheetxml=join('',<$fh>);               $sheetxml=join('',<$fh>);
  } else {           } else {
              $sheetxml='<field row="0" col="A">"Error"</field>';               $sheetxml='<field row="0" col="A">"Error"</field>';
  }           }
        }           %f=%{&parse_sheet(\$sheetxml)};
         my $parser=HTML::TokeParser->new(\$sheetxml);       } elsif($fn=~/\/*\.spreadsheet$/) {
         my $token;           my $sheetxml=&Apache::lonnet::getfile
         while ($token=$parser->get_token) {               (&Apache::lonnet::filelocation('',$fn));
           if ($token->[0] eq 'S') {           if ($sheetxml == -1) {
       if ($token->[1] eq 'field') {               $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
   $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=                   .$fn.'"</field>';
       $parser->get_text('/field');           }
       }           %f=%{&parse_sheet(\$sheetxml)};
              if ($token->[1] eq 'template') {       } else {
                  $f{'template_'.$token->[2]->{'col'}}=           my $sheet='';
                      $parser->get_text('/template');           my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
            my ($tmp) = keys(%tmphash);
            unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
                foreach (keys(%tmphash)) {
                    $f{$_}=$tmphash{$_};
              }               }
           }           }
         }       }
       } else {  
           my $sheet='';  
           my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'.$fn,  
                                          $chome);  
           unless ($reply=~/^error\:/) {  
              $sheet=$reply;  
   }  
           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 959  sub writesheet { Line 1375  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') {       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 1145  sub updateclasssheet { Line 1561  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 1172  sub updateclasssheet { Line 1588  sub updateclasssheet {
                     $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 {     } else {
     $rowlabel=$ssec.'","'.$reply{$sname}.'"';      $rowlabel=$ssec.'","'.$reply{$sname}.'"';
                     my $ncount=0;                      my $ncount=0;
                     map {                      foreach (split(/\&/,$reply)) {
                         $rowlabel.=',"'.&Apache::lonnet::unescape($_).'"';                          $rowlabel.=',"'.&Apache::lonnet::unescape($_).'"';
                         $ncount++;                          $ncount++;
                     } split(/\&/,$reply);                      }
                     unless ($ncount==4) { $rowlabel.=',""'; }                      unless ($ncount==4) { $rowlabel.=',""'; }
                     $rowlabel=~s/\"$//;                      $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 1200  sub updateclasssheet { Line 1616  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 1209  sub updateclasssheet { Line 1625  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 1245  sub updatestudentassesssheet { Line 1661  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',
                        '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 1262  sub updatestudentassesssheet { Line 1684  sub updatestudentassesssheet {
                        '">Evaluation</a>',                         '">Evaluation</a>',
                        '_tutoring' =>                         '_tutoring' =>
               '<a href="/adm/assesscalc?usymb=_tutoring'.$adduserstr.                '<a href="/adm/assesscalc?usymb=_tutoring'.$adduserstr.
                        '">Tutoring</a>'                         '">Tutoring</a>',
                          '_discussion' =>
                 '<a href="/adm/assesscalc?usymb=_discussion'.$adduserstr.
                          '">Discussion</a>'
         );          );
   
         map {          foreach (keys(%bighash)) {
     if ($_=~/^src\_(\d+)\.(\d+)$/) {      if ($_=~/^src\_(\d+)\.(\d+)$/) {
        my $mapid=$1;         my $mapid=$1;
                my $resid=$2;                 my $resid=$2;
Line 1280  sub updatestudentassesssheet { Line 1705  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 1292  sub updatestudentassesssheet { Line 1718  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 1328  sub updatestudentassesssheet { Line 1754  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;
                 my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});                  my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});
Line 1341  sub updatestudentassesssheet { Line 1767  sub updatestudentassesssheet {
                        =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/;                         =~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 1376  sub loadstudent { Line 1802  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 1393  sub loadstudent { Line 1819  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 1406  sub loadstudent { Line 1833  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 1424  sub loadcourse { Line 1850  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 1443  sub loadcourse { Line 1869  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 1457  ENDPOP Line 1883  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 1470  ENDPOP Line 1897  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 1510  sub loadassessment { Line 1936  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 1524  sub loadassessment { Line 1950  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 1555  sub loadassessment { Line 1993  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 1570  sub loadassessment { Line 2008  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)
Line 1585  sub loadassessment { Line 2023  sub loadassessment {
     my %thisassess=();      my %thisassess=();
     my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb);      my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb);
           
     map {      foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) {
         $thisassess{$_}=1;          $thisassess{$_}=1;
     } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));      } 
 #  #
 # Load parameters  # Load parameters
 #  #
Line 1596  sub loadassessment { Line 2034  sub loadassessment {
    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/) {
Line 1615  sub loadassessment { Line 2053  sub loadassessment {
        }         }
    }     }
         }          }
     } keys %f;      }
     untie(%parmhash);      untie(%parmhash);
    }     }
    &setconstants($safeeval,%c);     &setconstants($safeeval,%c);
Line 1637  sub hiddenfield { Line 2075  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 1716  sub forcedrecalc { Line 2154  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 1724  sub exportsheet { Line 2167  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 1793  sub exportsheet { Line 2236  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 1843  sub expirationdates { Line 2286  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 1864  sub cachedcsheets { Line 2307  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 1886  sub cachedssheets { Line 2329  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 1928  $tmpdir=$r->dir_config('lonDaemons').'/t Line 2371  $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 1938  $tmpdir=$r->dir_config('lonDaemons').'/t Line 2381  $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'})) {      if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) {
  $ENV{'form.ufn'}='default_'.$1;   $ENV{'form.ufn'}='default_'.$1;
Line 2052  ENDSCRIPT Line 2495  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
Line 2111  ENDSCRIPT Line 2557  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 2186  ENDSCRIPT Line 2632  ENDSCRIPT
     } else {      } else {
         $r->print('<br>Show empty rows: ');          $r->print('<br>Show empty rows: ');
     }       } 
     $r->print('<input type=checkbox name=showall onClick="submit()"');  
     if ($ENV{'form.showall'}) { $r->print(' checked'); }      $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('>');      $r->print('>');
     if (&gettype($asheet) eq 'classcalc') {      if (&gettype($asheet) eq 'classcalc') {
        $r->print(         $r->print(
Line 2213  ENDSCRIPT Line 2672  ENDSCRIPT
   
 1;  1;
 __END__  __END__
   
   
   
   

Removed from v.1.73  
changed lines
  Added in v.1.85


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