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

Diff for /loncom/interface/Attic/lonspreadsheet.pm between versions 1.100.2.2 and 1.108

version 1.100.2.2, 2002/09/10 21:11:23 version 1.108, 2002/09/09 17:18:33
Line 142  sub initsheet { Line 142  sub initsheet {
 # rl: row label  # rl: row label
 # os: other spreadsheets (for student spreadsheet only)  # os: other spreadsheets (for student spreadsheet only)
   
 undef %v;   undef %sheet_values; 
 undef %t;  undef %t;
 undef %f;  undef %f;
 undef %c;  undef %c;
 undef %rl;  undef %rowlabel;
 undef @os;  undef @os;
   
 $maxrow=0;  $maxrow = 0;
 $sheettype='';  $sheettype = '';
   
 # filename/reference of the sheet  # filename/reference of the sheet
   $filename = '';
 $filename='';  
   
 # user data  # user data
 $uname='';  $uname = '';
 $uhome='';  $uhome = '';
 $udom='';  $udom  = '';
   
 # course data  # course data
   
 $csec='';  $csec = '';
 $chome='';  $chome= '';
 $cnum='';  $cnum = '';
 $cdom='';  $cdom = '';
 $cid='';  $cid  = '';
 $cfn='';  $cfn  = '';
   
 # symb  # symb
   
 $usymb='';  $usymb = '';
   
 # error messages  # error messages
   $errormsg = '';
 $errormsg='';  
   
 sub mask {  sub mask {
     my ($lower,$upper)=@_;      my ($lower,$upper)=@_;
Line 385  sub CDLHASH { Line 383  sub CDLHASH {
     if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {      if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
  my $keymask = &mask($key);   my $keymask = &mask($key);
  # Assume the keys are addresses   # Assume the keys are addresses
  my @Temp = grep /$keymask/,keys(%v);   my @Temp = grep /$keymask/,keys(%sheet_values);
  @Keys = $v{@Temp};   @Keys = $sheet_values{@Temp};
     } else {      } else {
  $Keys[0]= $key;   $Keys[0]= $key;
     }      }
Line 397  sub CDLHASH { Line 395  sub CDLHASH {
     @Keys = @Temp;      @Keys = @Temp;
     if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {      if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
  my $valmask = &mask($value);   my $valmask = &mask($value);
  my @Temp = grep /$valmask/,keys(%v);   my @Temp = grep /$valmask/,keys(%sheet_values);
  @Values =$v{@Temp};   @Values =$sheet_values{@Temp};
     } else {      } else {
  $Values[0]= $value;   $Values[0]= $value;
     }      }
Line 432  sub GETHASH { Line 430  sub GETHASH {
  $index = 0;   $index = 0;
     }      }
     if ($key =~ /^[A-z]\d+$/) {      if ($key =~ /^[A-z]\d+$/) {
  $key = $v{$key};   $key = $sheet_values{$key};
     }      }
     return $hashes{$name}->{$key}->[$index];      return $hashes{$name}->{$key}->[$index];
 }  }
Line 489  sub HASH { Line 487  sub HASH {
     if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {      if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
  my $keymask = &mask($key);   my $keymask = &mask($key);
  # Assume the keys are addresses   # Assume the keys are addresses
  my @Temp = grep /$keymask/,keys(%v);   my @Temp = grep /$keymask/,keys(%sheet_values);
  @Keys = $v{@Temp};   @Keys = $sheet_values{@Temp};
     } else {      } else {
  $Keys[0]= $key;   $Keys[0]= $key;
     }      }
Line 502  sub HASH { Line 500  sub HASH {
     # Check to see if we have multiple $value(s)       # Check to see if we have multiple $value(s) 
     if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {      if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
  my $valmask = &mask($value);   my $valmask = &mask($value);
  my @Temp = grep /$valmask/,keys(%v);   my @Temp = grep /$valmask/,keys(%sheet_values);
  @Values =$v{@Temp};   @Values =$sheet_values{@Temp};
     } else {      } else {
  $Values[0]= $value;   $Values[0]= $value;
     }      }
Line 532  returns the number of items in the range Line 530  returns the number of items in the range
 #-------------------------------------------------------  #-------------------------------------------------------
 sub NUM {  sub NUM {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $num= $#{@{grep(/$mask/,keys(%v))}}+1;      my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1;
     return $num;         return $num;   
 }  }
   
Line 540  sub BIN { Line 538  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;
     foreach (grep /$mask/,keys(%v)) {      foreach (grep /$mask/,keys(%sheet_values)) {
         if (($v{$_}>=$low) && ($v{$_}<=$high)) {          if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {
             $num++;              $num++;
         }          }
     }      }
Line 561  returns the sum of items in the range. Line 559  returns the sum of items in the range.
 sub SUM {  sub SUM {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $sum=0;      my $sum=0;
     foreach (grep /$mask/,keys(%v)) {      foreach (grep /$mask/,keys(%sheet_values)) {
         $sum+=$v{$_};          $sum+=$sheet_values{$_};
     }      }
     return $sum;         return $sum;   
 }  }
Line 579  compute the average of the items in the Line 577  compute the average of the items in the
 sub MEAN {  sub MEAN {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $sum=0; my $num=0;      my $sum=0; my $num=0;
     foreach (grep /$mask/,keys(%v)) {      foreach (grep /$mask/,keys(%sheet_values)) {
         $sum+=$v{$_};          $sum+=$sheet_values{$_};
         $num++;          $num++;
     }      }
     if ($num) {      if ($num) {
Line 602  compute the standard deviation of the it Line 600  compute the standard deviation of the it
 sub STDDEV {  sub STDDEV {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $sum=0; my $num=0;      my $sum=0; my $num=0;
     foreach (grep /$mask/,keys(%v)) {      foreach (grep /$mask/,keys(%sheet_values)) {
         $sum+=$v{$_};          $sum+=$sheet_values{$_};
         $num++;          $num++;
     }      }
     unless ($num>1) { return undef; }      unless ($num>1) { return undef; }
     my $mean=$sum/$num;      my $mean=$sum/$num;
     $sum=0;      $sum=0;
     foreach (grep /$mask/,keys(%v)) {      foreach (grep /$mask/,keys(%sheet_values)) {
         $sum+=($v{$_}-$mean)**2;          $sum+=($sheet_values{$_}-$mean)**2;
     }      }
     return sqrt($sum/($num-1));          return sqrt($sum/($num-1));    
 }  }
Line 627  compute the product of the items in the Line 625  compute the product of the items in the
 sub PROD {  sub PROD {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $prod=1;      my $prod=1;
     foreach (grep /$mask/,keys(%v)) {      foreach (grep /$mask/,keys(%sheet_values)) {
         $prod*=$v{$_};          $prod*=$sheet_values{$_};
     }      }
     return $prod;         return $prod;   
 }  }
Line 645  compute the maximum of the items in the Line 643  compute the maximum of the items in the
 sub MAX {  sub MAX {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $max='-';      my $max='-';
     foreach (grep /$mask/,keys(%v)) {      foreach (grep /$mask/,keys(%sheet_values)) {
         unless ($max) { $max=$v{$_}; }          unless ($max) { $max=$sheet_values{$_}; }
         if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }          if (($sheet_values{$_}>$max) || ($max eq '-')) { $max=$sheet_values{$_}; }
     }       } 
     return $max;         return $max;   
 }  }
Line 664  compute the minimum of the items in the Line 662  compute the minimum of the items in the
 sub MIN {  sub MIN {
     my $mask=mask(@_);      my $mask=mask(@_);
     my $min='-';      my $min='-';
     foreach (grep /$mask/,keys(%v)) {      foreach (grep /$mask/,keys(%sheet_values)) {
         unless ($max) { $max=$v{$_}; }          unless ($max) { $max=$sheet_values{$_}; }
         if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }          if (($sheet_values{$_}<$min) || ($min eq '-')) { 
               $min=$sheet_values{$_}; 
           }
     }      }
     return $min;         return $min;   
 }  }
Line 685  sub SUMMAX { Line 685  sub SUMMAX {
     my ($num,$lower,$upper)=@_;      my ($num,$lower,$upper)=@_;
     my $mask=mask($lower,$upper);      my $mask=mask($lower,$upper);
     my @inside=();      my @inside=();
     foreach (grep /$mask/,keys(%v)) {      foreach (grep /$mask/,keys(%sheet_values)) {
  push (@inside,$v{$_});   push (@inside,$sheet_values{$_});
     }      }
     @inside=sort(@inside);      @inside=sort(@inside);
     my $sum=0; my $i;      my $sum=0; my $i;
Line 710  sub SUMMIN { Line 710  sub SUMMIN {
     my ($num,$lower,$upper)=@_;      my ($num,$lower,$upper)=@_;
     my $mask=mask($lower,$upper);      my $mask=mask($lower,$upper);
     my @inside=();      my @inside=();
     foreach (grep /$mask/,keys(%v)) {      foreach (grep /$mask/,keys(%sheet_values)) {
  $inside[$#inside+1]=$v{$_};   $inside[$#inside+1]=$sheet_values{$_};
     }      }
     @inside=sort(@inside);      @inside=sort(@inside);
     my $sum=0; my $i;      my $sum=0; my $i;
Line 721  sub SUMMIN { Line 721  sub SUMMIN {
     return $sum;         return $sum;   
 }  }
   
   #-------------------------------------------------------
   
   =item MINPARM(parametername)
   
   Returns the minimum value of the parameters matching the parametername.
   parametername should be a string such as 'duedate'.
   
   =cut
   
   #-------------------------------------------------------
   sub MINPARM {
       my ($expression) = @_;
       my $min = undef;
       study($expression);
       foreach $parameter (keys(%c)) {
           next if ($parameter !~ /$expression/);
           if ((! defined($min)) || ($min > $c{$parameter})) {
               $min = $c{$parameter} 
           }
       }
       return $min;
   }
   
   #-------------------------------------------------------
   
   =item MAXPARM(parametername)
   
   Returns the maximum value of the parameters matching the input parameter name.
   parametername should be a string such as 'duedate'.
   
   =cut
   
   #-------------------------------------------------------
   sub MAXPARM {
       my ($expression) = @_;
       my $max = undef;
       study($expression);
       foreach $parameter (keys(%c)) {
           next if ($parameter !~ /$expression/);
           if ((! defined($min)) || ($max < $c{$parameter})) {
               $max = $c{$parameter} 
           }
       }
       return $max;
   }
   
   #--------------------------------------------------------
 sub expandnamed {  sub expandnamed {
     my $expression=shift;      my $expression=shift;
     if ($expression=~/^\&/) {      if ($expression=~/^\&/) {
Line 791  sub sett { Line 838  sub sett {
     } else {      } else {
         $pattern='[A-Z]';          $pattern='[A-Z]';
     }      }
       # Deal with the template row
 # Deal with the template row  
     foreach (keys(%f)) {      foreach (keys(%f)) {
  if ($_=~/template\_(\w)/) {   next if ($_!~/template\_(\w)/);
   my $col=$1;          my $col=$1;
           unless ($col=~/^$pattern/) {          next if ($col=~/^$pattern/);
     foreach (keys(%f)) {          foreach (keys(%f)) {
       if ($_=~/A(\d+)/) {              next if ($_!~/A(\d+)/);
  my $trow=$1;              my $trow=$1;
                 if ($trow) {              next if (! $trow);
                     # Get the name of this cell              # Get the name of this cell
     my $lb=$col.$trow;              my $lb=$col.$trow;
                     # Grab the template declaration              # Grab the template declaration
                     $t{$lb}=$f{'template_'.$col};              $t{$lb}=$f{'template_'.$col};
                     # Replace '#' with the row number              # Replace '#' with the row number
                     $t{$lb}=~s/\#/$trow/g;              $t{$lb}=~s/\#/$trow/g;
                     # Replace '....' with ','              # Replace '....' with ','
                     $t{$lb}=~s/\.\.+/\,/g;              $t{$lb}=~s/\.\.+/\,/g;
                     # Replace 'A0' with the value from 'A0'              # Replace 'A0' with the value from 'A0'
                     $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;              $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
                     # Replace parameters              # Replace parameters
                     $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;              $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
                 }          }
       }  
     }  
   }  
       }  
     }      }
       # Deal with the normal cells
 # Deal with the normal cells  
     foreach (keys(%f)) {      foreach (keys(%f)) {
  if (($f{$_}) && ($_!~/template\_/)) {   if (($f{$_}) && ($_!~/template\_/)) {
             my $matches=($_=~/^$pattern(\d+)/);              my $matches=($_=~/^$pattern(\d+)/);
Line 831  sub sett { Line 872  sub sett {
             } else {              } else {
        $t{$_}=$f{$_};         $t{$_}=$f{$_};
                $t{$_}=~s/\.\.+/\,/g;                 $t{$_}=~s/\.\.+/\,/g;
                $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;                 $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
                $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;                 $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
             }              }
         }          }
     }      }
 # For inserted lines, [B-Z] is also valid      # For inserted lines, [B-Z] is also valid
   
     unless ($sheettype eq 'assesscalc') {      unless ($sheettype eq 'assesscalc') {
        foreach (keys(%f)) {         foreach (keys(%f)) {
    if ($_=~/[B-Z](\d+)/) {     if ($_=~/[B-Z](\d+)/) {
        if ($f{'A'.$1}=~/^[\~\-]/) {         if ($f{'A'.$1}=~/^[\~\-]/) {
            $t{$_}=$f{$_};             $t{$_}=$f{$_};
                   $t{$_}=~s/\.\.+/\,/g;                    $t{$_}=~s/\.\.+/\,/g;
                   $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;                    $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
                   $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;                    $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
                }                 }
            }             }
        }         }
     }      }
   
     # For some reason 'A0' gets special treatment...  This seems superfluous      # For some reason 'A0' gets special treatment...  This seems superfluous
     # but I imagine it is here for a reason.      # but I imagine it is here for a reason.
     $t{'A0'}=$f{'A0'};      $t{'A0'}=$f{'A0'};
     $t{'A0'}=~s/\.\.+/\,/g;      $t{'A0'}=~s/\.\.+/\,/g;
     $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;      $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
     $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;      $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
 }  }
   
 sub calc {  sub calc {
     undef %v;      undef %sheet_values;
     &sett();      &sett();
     my $notfinished=1;      my $notfinished=1;
     my $lastcalc='';      my $lastcalc='';
Line 868  sub calc { Line 907  sub calc {
     while ($notfinished) {      while ($notfinished) {
  $notfinished=0;   $notfinished=0;
         foreach (keys(%t)) {          foreach (keys(%t)) {
             my $old=$v{$_};              my $old=$sheet_values{$_};
             $v{$_}=eval $t{$_};              $sheet_values{$_}=eval $t{$_};
     if ($@) {      if ($@) {
  undef %v;   undef %sheet_values;
                 return $_.': '.$@;                  return $_.': '.$@;
             }              }
     if ($v{$_} ne $old) { $notfinished=1; $lastcalc=$_; }      if ($sheet_values{$_} ne $old) { $notfinished=1; $lastcalc=$_; }
         }          }
         $depth++;          $depth++;
         if ($depth>100) {          if ($depth>100) {
     undef %v;      undef %sheet_values;
             return $lastcalc.': Maximum calculation depth exceeded';              return $lastcalc.': Maximum calculation depth exceeded';
         }          }
     }      }
Line 894  sub templaterow { Line 933  sub templaterow {
      'n','o','p','q','r','s','t','u','v','w','x','y','z') {       'n','o','p','q','r','s','t','u','v','w','x','y','z') {
         my $fm=$f{'template_'.$_};          my $fm=$f{'template_'.$_};
         $fm=~s/[\'\"]/\&\#34;/g;          $fm=~s/[\'\"]/\&\#34;/g;
         $cols[$#cols+1]="'template_$_','$fm'".'___eq___'.$fm;          push(@cols,"'template_$_','$fm'".'___eq___'.$fm);
     }      }
     return @cols;      return @cols;
 }  }
   
   #
   # This is actually used for the student spreadsheet, not the assessment sheet
   # Do not be fooled by the name!
   #
 sub outrowassess {  sub outrowassess {
       # $n is the current row number
     my $n=shift;      my $n=shift;
     my @cols=();      my @cols=();
     if ($n) {      if ($n) {
        my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n});          my ($usy,$ufn)=split(/__&&&\__/,$f{'A'.$n});
       if ($rl{$usy}) {          if ($rowlabel{$usy}) {
        $cols[0]=$rl{$usy}.'<br>'.              $cols[0]=$rowlabel{$usy}.'<br>'.
                 '<select name="sel_'.$n.'" onChange="changesheet('.$n.                  '<select name="sel_'.$n.'" onChange="changesheet('.$n.')">'.
                 ')"><option name="default">Default</option>';                      '<option name="default">Default</option>';
       } else { $cols[0]=''; }          } else { 
        foreach (@os) {              $cols[0]=''; 
            $cols[0].='<option name="'.$_.'"';          }
           foreach (@os) {
               $cols[0].='<option name="'.$_.'"';
             if ($ufn eq $_) {              if ($ufn eq $_) {
                $cols[0].=' selected';                  $cols[0].=' selected';
             }              }
             $cols[0].='>'.$_.'</option>';              $cols[0].='>'.$_.'</option>';
        }          }
        $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>';
     }      }
     foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',      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',       'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
Line 926  sub outrowassess { Line 972  sub outrowassess {
      'n','o','p','q','r','s','t','u','v','w','x','y','z') {       'n','o','p','q','r','s','t','u','v','w','x','y','z') {
         my $fm=$f{$_.$n};          my $fm=$f{$_.$n};
         $fm=~s/[\'\"]/\&\#34;/g;          $fm=~s/[\'\"]/\&\#34;/g;
         push(@cols,"'$_$n','$fm'".'___eq___'.$v{$_.$n});          push(@cols,"'$_$n','$fm'".'___eq___'.$sheet_values{$_.$n});
     }      }
     return @cols;      return @cols;
 }  }
Line 935  sub outrow { Line 981  sub outrow {
     my $n=shift;      my $n=shift;
     my @cols=();      my @cols=();
     if ($n) {      if ($n) {
        $cols[0]=$rl{$f{'A'.$n}};         $cols[0]=$rowlabel{$f{'A'.$n}};
     } else {      } else {
        $cols[0]='<b><font size=+1>Export</font></b>';         $cols[0]='<b><font size=+1>Export</font></b>';
     }      }
Line 945  sub outrow { Line 991  sub outrow {
      'n','o','p','q','r','s','t','u','v','w','x','y','z') {       'n','o','p','q','r','s','t','u','v','w','x','y','z') {
         my $fm=$f{$_.$n};          my $fm=$f{$_.$n};
         $fm=~s/[\'\"]/\&\#34;/g;          $fm=~s/[\'\"]/\&\#34;/g;
         $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};          push(@cols,"'$_$n','$fm'".'___eq___'.$sheet_values{$_.$n});
     }      }
     return @cols;      return @cols;
 }  }
Line 954  sub exportrowa { Line 1000  sub exportrowa {
     my @exportarray=();      my @exportarray=();
     foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',      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') {       'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
  $exportarray[$#exportarray+1]=$v{$_.'0'};   push(@exportarray,$sheet_values{$_.'0'});
     }       } 
     return @exportarray;      return @exportarray;
 }  }
Line 989  sub setothersheets { Line 1035  sub setothersheets {
 # ------------------------------------------------ Add or change formula values  # ------------------------------------------------ Add or change formula values
   
 sub setrowlabels {  sub setrowlabels {
     my ($safeeval,%rl)=@_;      my ($safeeval,%rowlabel)=@_;
     %{$safeeval->varglob('rl')}=%rl;      %{$safeeval->varglob('rowlabel')}=%rowlabel;
 }  }
   
 # ------------------------------------------------------- Calculate spreadsheet  # ------------------------------------------------------- Calculate spreadsheet
Line 1004  sub calcsheet { Line 1050  sub calcsheet {
   
 sub getvalues {  sub getvalues {
     my $safeeval=shift;      my $safeeval=shift;
     return $safeeval->reval('%v');      return $safeeval->reval('%sheet_values');
 }  }
   
 # ---------------------------------------------------------------- Get formulas  # ---------------------------------------------------------------- Get formulas
Line 1148  sub rown { Line 1194  sub rown {
     my $rowdata='';      my $rowdata='';
     my $dataflag=0;      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';
     }      }
     unless ($ENV{'form.showcsv'}) {      unless ($ENV{'form.showcsv'}) {
        $rowdata.="\n<tr><td><b><font size=+1>$n</font></b></td>";          $rowdata.="\n<tr><td><b><font size=+1>$n</font></b></td>";
     } else {      } else {
        $rowdata.="\n".'"'.$n.'"';          $rowdata.="\n".'"'.$n.'"';
     }      }
     my $showf=0;      my $showf=0;
     my $proc;      my $proc;
Line 1173  sub rown { Line 1219  sub rown {
         $maxred=26;          $maxred=26;
     }      }
     if (&getfa($safeeval,$n)=~/^[\~\-]/) { $maxred=1; }      if (&getfa($safeeval,$n)=~/^[\~\-]/) { $maxred=1; }
     if ($n eq '-') { $proc='&templaterow'; $n=-1; $dataflag=1; }      if ($n eq '-') { 
           $proc='&templaterow'; 
           $n=-1; 
           $dataflag=1; 
       }
     foreach ($safeeval->reval($proc.'('.$n.')')) {      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')) &&
            (($showf==1) || ($sheettype ne 'studentcalc'))) { $dataflag=1; }              (($showf==1) || ($sheettype ne 'studentcalc'))) { $dataflag=1; }
        if ($showf==0) { $vl=$_; }          if ($showf==0) { $vl=$_; }
       unless ($ENV{'form.showcsv'}) {          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))) {
    if ($vl eq '') {                  if ($vl eq '') {
        $vl='<font size=+2 color='.$bgcolor.'>&#35;</font>';                      $vl='<font size=+2 color='.$bgcolor.'>&#35;</font>';
            }                  }
            $rowdata.=                  $rowdata.='<td bgcolor='.$bgcolor.'>'.
        '<td bgcolor='.$bgcolor.'><a href="javascript:celledit('.$fm.');">'.$vl.                      '<a href="javascript:celledit('.$fm.');">'.$vl.'</a></td>';
        '</a></td>';              } else {
        } else {                  $rowdata.='<td bgcolor='.$bgcolor.'>&nbsp;'.$vl.'&nbsp;</td>';
            $rowdata.='<td bgcolor='.$bgcolor.'>&nbsp;'.$vl.'&nbsp;</td>';              }
        }          } else {
       } else {              $rowdata.=',"'.$vl.'"';
   $rowdata.=',"'.$vl.'"';          }
       }          $showf++;
        $showf++;  
     }  # End of foreach($safeval...)      }  # 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 {
        return '';          return '';
     }      }
 }  }
   
 # ------------------------------------------------------------- Print out sheet  # ------------------------------------------------------------- Print out sheet
   
 sub outsheet {  sub outsheet {
     my ($r,$safeeval)=@_;      my ($r,$safeeval,$sheetdata)=@_;
     my $maxred;      my $maxred = 26;    # The maximum number of cells to show as 
     my $realm;                          # red (uneditable) 
     if (&gettype($safeeval) eq 'assesscalc') {                          # To make student sheets uneditable could we 
                           # set $maxred = 52?
                           #
       my $realm='Course'; # 'assessment', 'user', or 'course' sheet
       if ($sheetdata->{'sheettype'} eq 'assesscalc') {
         $maxred=1;          $maxred=1;
         $realm='Assessment';          $realm='Assessment';
     } elsif (&gettype($safeeval) eq 'studentcalc') {      } elsif ($sheetdata->{'sheettype'} eq 'studentcalc') {
         $maxred=26;          $maxred=26;
         $realm='User';          $realm='User';
     } else {  
         $maxred=26;  
         $realm='Course';  
     }      }
     my $maxyellow=52-$maxred;      #
       # Column label
     my $tabledata;      my $tabledata;
     unless ($ENV{'form.showcsv'}) {      if ($ENV{'form.showcsv'}) {
        $tabledata=          $tabledata='<pre>';
         '<table border=2><tr><th colspan=2 rowspan=2><font size=+2>'.      } else { 
                   $realm.'</font></th>'.          $tabledata='<table border=2><tr><th colspan=2 rowspan=2>'.
               '<font size=+2>'.$realm.'</font></th>'.
                   '<td bgcolor=#FFDDDD colspan='.$maxred.                    '<td bgcolor=#FFDDDD colspan='.$maxred.
                   '><b><font size=+1>Import</font></b></td>'.                    '><b><font size=+1>Import</font></b></td>'.
                   '<td colspan='.$maxyellow.                    '<td colspan='.(52-$maxred).
   '><b><font size=+1>Calculations</font></b></td></tr><tr>';    '><b><font size=+1>Calculations</font></b></td></tr><tr>';
     my $showf=0;          my $showf=0;
     foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',          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',                   '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',                   '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') {                   '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">'; 
         } else {              } else {
            $tabledata.='<td>';                  $tabledata.='<td>';
               }
               $tabledata.="<b><font size=+1>$_</font></b></td>";
         }          }
         $tabledata.="<b><font size=+1>$_</font></b></td>";          $tabledata.='</tr>'.&rown($safeeval,'-').&rown($safeeval,0);
     }      }
     $tabledata.='</tr>'.&rown($safeeval,'-').&rown($safeeval,0);  
    } else { $tabledata='<pre>'; }  
   
     $r->print($tabledata);      $r->print($tabledata);
       #
       # Prepare to output rows
     my $row;      my $row;
     my $maxrow=&getmaxrow($safeeval);      my $maxrow=&getmaxrow($safeeval);
       #
     my @sortby=();      my @sortby=();
     my @sortidx=();      my @sortidx=();
     for ($row=1;$row<=$maxrow;$row++) {      for ($row=1;$row<=$maxrow;$row++) {
        $sortby[$row-1]=$safeeval->reval('$f{"A'.$row.'"}');          push (@sortby, $safeeval->reval('$f{"A'.$row.'"}'));
        $sortidx[$row-1]=$row-1;          push (@sortidx, $row-1);
     }      }
     @sortidx=sort { $sortby[$a] cmp $sortby[$b]; } @sortidx;      @sortidx=sort { $sortby[$a] cmp $sortby[$b]; } @sortidx;
       #
         my $what='Student';      # Determine the type of child spreadsheets
         if (&gettype($safeeval) eq 'assesscalc') {      my $what='Student';
     $what='Item';      if ($sheetdata->{'sheettype'} eq 'assesscalc') {
  } elsif (&gettype($safeeval) eq 'studentcalc') {          $what='Item';
             $what='Assessment';      } elsif ($sheetdata->{'sheettype'} eq 'studentcalc') {
         }          $what='Assessment';
       }
       #
       # Loop through the rows and output them one at a time
     my $n=0;      my $n=0;
     for ($row=0;$row<$maxrow;$row++) {      for ($row=0;$row<$maxrow;$row++) {
      my $thisrow=&rown($safeeval,$sortidx[$row]+1);          my $thisrow=&rown($safeeval,$sortidx[$row]+1);
      if ($thisrow) {          if ($thisrow) {
        if (($n/25==int($n/25)) && (!$ENV{'form.showcsv'})) {              if (($n/25==int($n/25)) && (!$ENV{'form.showcsv'})) {
  $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>');
         foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',                  $r->print('<td>'.
  'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',                            join('</td><td>',
  'a','b','c','d','e','f','g','h','i','j','k','l','m',                                 (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
  'n','o','p','q','r','s','t','u','v','w','x','y','z') {                                        'abcdefghijklmnopqrstuvwxyz'))).
            $r->print('<td>'.$_.'</td>');                            "</td></tr>\n");
               }
               $n++;
               $r->print($thisrow);
         }          }
         $r->print('</tr>');  
        }  
        $n++;  
        $r->print($thisrow);  
       }  
     }      }
     $r->print($ENV{'form.showcsv'}?'</pre>':'</table>');      $r->print($ENV{'form.showcsv'}?'</pre>':'</table>');
 }  }
Line 1296  sub outsheet { Line 1348  sub outsheet {
 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 %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum);      my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum);
Line 1343  sub parse_sheet { Line 1395  sub parse_sheet {
 #  #
   
 sub readsheet {  sub readsheet {
   my ($safeeval,$fn)=@_;      my ($safeeval,$sheetdata,$fn)=@_;
   my $stype=&gettype($safeeval);      #
   my $cnum=&getcnum($safeeval);      my $stype = $sheetdata->{'sheettype'};
   my $cdom=&getcdom($safeeval);      my $cnum  = $sheetdata->{'cnum'};
   my $chome=&getchome($safeeval);      my $cdom  = $sheetdata->{'cdom'};
       my $chome = $sheetdata->{'chome'};
   if (! defined($fn)) {      #
       # There is no filename. Look for defaults in course and global, cache      if (! defined($fn)) {
       unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {          # There is no filename. Look for defaults in course and global, cache
           my %tmphash = &Apache::lonnet::get('environment',          unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {
                                              ['spreadsheet_default_'.$stype],              my %tmphash = &Apache::lonnet::get('environment',
                                              $cdom,$cnum);                                                 ['spreadsheet_default_'.$stype],
           my ($tmp) = keys(%tmphash);                                                 $cdom,$cnum);
           if ($tmp =~ /^(con_lost|error|no_such_host)/i) {              my ($tmp) = keys(%tmphash);
               $fn = 'default_'.$stype;              if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
           } else {                  $fn = 'default_'.$stype;
               $fn = $tmphash{'spreadsheet_default_'.$stype};              } else {
           }                   $fn = $tmphash{'spreadsheet_default_'.$stype};
           unless (($fn) && ($fn!~/^error\:/)) {              } 
       $fn='default_'.$stype;              unless (($fn) && ($fn!~/^error\:/)) {
           }                  $fn='default_'.$stype;
           $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn;               }
       }              $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 
   }          }
       }
 # ---------------------------------------------------------- fn now has a value      # $fn now has a value
       &setfilename($safeeval,$fn);
   &setfilename($safeeval,$fn);      # see if sheet is cached
       my $fstring='';
 # ------------------------------------------------------ see if sheet is cached      if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) {
   my $fstring='';          &setformulas($safeeval,split(/\_\_\_\;\_\_\_/,$fstring));
   if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) {      } else {
       &setformulas($safeeval,split(/\_\_\_\;\_\_\_/,$fstring));          # Not cached, need to read
   } else {          my %f=();
           if ($fn=~/^default\_/) {
 # ---------------------------------------------------- Not cached, need to read              my $sheetxml='';
               my $fh;
      my %f=();              my $dfn=$fn;
               $dfn=~s/\_/\./g;
      if ($fn=~/^default\_/) {              if ($fh=Apache::File->new($includedir.'/'.$dfn)) {
          my $sheetxml='';                  $sheetxml=join('',<$fh>);
          my $fh;              } else {
          my $dfn=$fn;                  $sheetxml='<field row="0" col="A">"Error"</field>';
          $dfn=~s/\_/\./g;              }
          if ($fh=Apache::File->new($includedir.'/'.$dfn)) {              %f=%{&parse_sheet(\$sheetxml)};
              $sheetxml=join('',<$fh>);          } elsif($fn=~/\/*\.spreadsheet$/) {
          } else {              my $sheetxml=&Apache::lonnet::getfile
              $sheetxml='<field row="0" col="A">"Error"</field>';                  (&Apache::lonnet::filelocation('',$fn));
          }              if ($sheetxml == -1) {
          %f=%{&parse_sheet(\$sheetxml)};                  $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
      } elsif($fn=~/\/*\.spreadsheet$/) {                      .$fn.'"</field>';
          my $sheetxml=&Apache::lonnet::getfile              }
              (&Apache::lonnet::filelocation('',$fn));              %f=%{&parse_sheet(\$sheetxml)};
          if ($sheetxml == -1) {          } else {
              $sheetxml='<field row="0" col="A">"Error loading spreadsheet '              my $sheet='';
                  .$fn.'"</field>';              my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
          }              my ($tmp) = keys(%tmphash);
          %f=%{&parse_sheet(\$sheetxml)};              unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
      } else {                  foreach (keys(%tmphash)) {
          my $sheet='';                      $f{$_}=$tmphash{$_};
          my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);                  }
          my ($tmp) = keys(%tmphash);              }
          unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {          }
              foreach (keys(%tmphash)) {          # Cache and set
                  $f{$_}=$tmphash{$_};          $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);  
              }          &setformulas($safeeval,%f);
          }  
      }  
 # --------------------------------------------------------------- Cache and set  
        $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);    
        &setformulas($safeeval,%f);  
     }      }
 }  }
   
Line 1421  sub readsheet { Line 1468  sub readsheet {
   
 sub makenewsheet {  sub makenewsheet {
     my ($uname,$udom,$stype,$usymb)=@_;      my ($uname,$udom,$stype,$usymb)=@_;
       my %sheetdata=();
       $sheetdata{'uname'} = $uname;
       $sheetdata{'udom'}  = $udom;
       $sheetdata{'sheettype'} = $stype;
       $sheetdata{'usymb'} = $usymb;
       $sheetdata{'cid'}   = $ENV{'request.course.id'};
       $sheetdata{'csec'}  = &Apache::lonnet::usection
                                  ($udom,$uname,$ENV{'request.course.id'});
       $sheetdata{'cfn'}   = $ENV{'request.course.fn'};
       $sheetdata{'cnum'}  = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
       $sheetdata{'cdom'}  = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
       $sheetdata{'chome'} = $ENV{'course.'.$ENV{'request.course.id'}.'.home'};
       $sheetdata{'uhome'} = &Apache::lonnet::homeserver($uname,$udom);
       
     my $safeeval=initsheet($stype);      my $safeeval=initsheet($stype);
     $safeeval->reval(      my $initstring = '';
        '$uname="'.$uname.      foreach (keys(%sheetdata)) {
       '";$udom="'.$udom.          $initstring.= qq{\$$_="$sheetdata{$_}";};
       '";$uhome="'.&Apache::lonnet::homeserver($uname,$udom).      }
       '";$sheettype="'.$stype.      $safeeval->reval($initstring);
       '";$usymb="'.$usymb.      return $safeeval,\%sheetdata;
       '";$csec="'.&Apache::lonnet::usection($udom,$uname,  
                                             $ENV{'request.course.id'}).  
       '";$cid="'.$ENV{'request.course.id'}.  
       '";$cfn="'.$ENV{'request.course.fn'}.  
       '";$cnum="'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.  
       '";$cdom="'.$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.  
       '";$chome="'.$ENV{'course.'.$ENV{'request.course.id'}.'.home'}.'";');  
     return $safeeval;  
 }  }
   
 # ------------------------------------------------------------ Save spreadsheet  # ------------------------------------------------------------ Save spreadsheet
   
 sub writesheet {  sub writesheet {
   my ($safeeval,$makedef)=@_;      my ($safeeval,$makedef)=@_;
   my $cid=&getcid($safeeval);      my $cid=&getcid($safeeval);
   if (&Apache::lonnet::allowed('opa',$cid)) {      if (&Apache::lonnet::allowed('opa',$cid)) {
     my %f=&getformulas($safeeval);          my %f=&getformulas($safeeval);
     my $stype=&gettype($safeeval);          my $stype=&gettype($safeeval);
     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 $fn=&getfilename($safeeval);          my $fn=&getfilename($safeeval);
           # Cache new sheet
 # ------------------------------------------------------------- Cache new sheet          $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
     $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);              # Write sheet
 # ----------------------------------------------------------------- Write sheet          my $sheetdata='';
     my $sheetdata='';          foreach (keys(%f)) {
     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{$_}).'&';              }
      }          }
     }          $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).
               &Apache::lonnet::escape($fn).'='.$ENV{'user.name'}.'@'.                                            '='.$ENV{'user.name'}.'@'.
                                                $ENV{'user.domain'},                                            $ENV{'user.domain'},
               $chome);                                            $chome);
           if ($reply eq 'ok') {              if ($reply eq 'ok') {
               if ($makedef) {                   if ($makedef) { 
                 return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum.                      return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum.
                                 ':environment:spreadsheet_default_'.$stype.'='.                                                    ':environment:'.
                                 &Apache::lonnet::escape($fn),                                                    'spreadsheet_default_'.
                                 $chome);                                                    $stype.'='.
       } else {                                                    &Apache::lonnet::escape($fn),
   return $reply;                                                    $chome);
          }                  } 
    } else {                  return $reply;
        return $reply;              } 
            }              return $reply;
       } else {          } 
   return $reply;          return $reply;
       }      }
   }      return 'unauthorized';
   return 'unauthorized';  
 }  }
   
 # ----------------------------------------------- Make a temp copy of the sheet  # ----------------------------------------------- Make a temp copy of the sheet
Line 1496  sub writesheet { Line 1548  sub writesheet {
 sub tmpwrite {  sub tmpwrite {
     my $safeeval=shift;      my $safeeval=shift;
     my $fn=$ENV{'user.name'}.'_'.      my $fn=$ENV{'user.name'}.'_'.
            $ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'.          $ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'.
            &getfilename($safeeval);             &getfilename($safeeval);
     $fn=~s/\W/\_/g;      $fn=~s/\W/\_/g;
     $fn=$tmpdir.$fn.'.tmp';      $fn=$tmpdir.$fn.'.tmp';
Line 1551  sub tmpread { Line 1603  sub tmpread {
     &setformulas($safeeval,%fo);      &setformulas($safeeval,%fo);
 }  }
   
 # ================================================================== Parameters  ##################################################
 # -------------------------------------------- Figure out a cascading parameter  ##################################################
 #  
 # For this function to work  
 #  
 # * parmhash needs to be tied  
 # * courseopt and useropt need to be initialized for this user and course  
 #  
   
 sub parmval {  
     my ($what,$safeeval)=@_;  
     my $cid=&getcid($safeeval);  
     my $csec=&getcsec($safeeval);  
     my $uname=&getuname($safeeval);  
     my $udom=&getudom($safeeval);  
     my $symb=&getusymb($safeeval);  
   
     unless ($symb) { return ''; }  
     my $result='';  
   
     my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);  
 # ----------------------------------------------------- Cascading lookup scheme  
        my $rwhat=$what;  
        $what=~s/^parameter\_//;  
        $what=~s/\_([^\_]+)$/\.$1/;  
   
        my $symbparm=$symb.'.'.$what;  
        my $mapparm=$mapname.'___(all).'.$what;  
        my $usercourseprefix=$uname.'_'.$udom.'_'.$cid;  
   
        my $seclevel=  
             $usercourseprefix.'.['.  
  $csec.'].'.$what;  
        my $seclevelr=  
             $usercourseprefix.'.['.  
  $csec.'].'.$symbparm;  
        my $seclevelm=  
             $usercourseprefix.'.['.  
  $csec.'].'.$mapparm;  
   
        my $courselevel=  
             $usercourseprefix.'.'.$what;  
        my $courselevelr=  
             $usercourseprefix.'.'.$symbparm;  
        my $courselevelm=  
             $usercourseprefix.'.'.$mapparm;  
   
 # ---------------------------------------------------------- fourth, check user  
         
       if ($uname) {   
   
        if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; }  
   
        if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; }  
   
        if ($useropt{$courselevel}) { return $useropt{$courselevel}; }  
   
       }  
   
 # --------------------------------------------------------- third, check course  =pod
        
        if ($csec) {  
    
         if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; }  
   
         if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; }    =item &parmval()
   
         if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }  Determine the value of a parameter.
     
       }  
   
        if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; }  Inputs: $what, the parameter needed, $safeeval, the safe space
   
        if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }  Returns: The value of a parameter, or '' if none.
   
        if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }  This function cascades through the possible levels searching for a value for
   a parameter.  The levels are checked in the following order:
   user, course (at section level and course level), map, and lonnet::metadata.
   This function uses %parmhash, which must be tied prior to calling it.
   This function also requires %courseopt and %useropt to be initialized for
   this user and course.
   
 # ----------------------------------------------------- second, check map parms  =cut
   
        my $thisparm=$parmhash{$symbparm};  
        if ($thisparm) { return $thisparm; }  
   
 # -------------------------------------------------------- first, check default  
   
        return &Apache::lonnet::metadata($fn,$rwhat.'.default');  ##################################################
           ##################################################
   sub parmval {
       my ($what,$safeeval,$sheetdata)=@_;
       my $symb  = $sheetdata->{'usymb'};
       unless ($symb) { return ''; }
       #
       my $cid   = $sheetdata->{'cid'};
       my $csec  = $sheetdata->{'csec'};
       my $uname = $sheetdata->{'uname'};
       my $udom  = $sheetdata->{'udom'};
       my $result='';
       #
       my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
       # Cascading lookup scheme
       my $rwhat=$what;
       $what =~ s/^parameter\_//;
       $what =~ s/\_([^\_]+)$/\.$1/;
       #
       my $symbparm = $symb.'.'.$what;
       my $mapparm  = $mapname.'___(all).'.$what;
       my $usercourseprefix = $uname.'_'.$udom.'_'.$cid;
       #
       my $seclevel  = $usercourseprefix.'.['.$csec.'].'.$what;
       my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm;
       my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm;
       #
       my $courselevel  = $usercourseprefix.'.'.$what;
       my $courselevelr = $usercourseprefix.'.'.$symbparm;
       my $courselevelm = $usercourseprefix.'.'.$mapparm;
       # fourth, check user
       if ($uname) { 
           return $useropt{$courselevelr} if ($useropt{$courselevelr});
           return $useropt{$courselevelm} if ($useropt{$courselevelm});
           return $useropt{$courselevel}  if ($useropt{$courselevel});
       }
       # third, check course
       if ($csec) {
           return $courseopt{$seclevelr} if ($courseopt{$seclevelr});
           return $courseopt{$seclevelm} if ($courseopt{$seclevelm});
           return $courseopt{$seclevel}  if ($courseopt{$seclevel});
       }
       #
       return $courseopt{$courselevelr} if ($courseopt{$courselevelr});
       return $courseopt{$courselevelm} if ($courseopt{$courselevelm});
       return $courseopt{$courselevel}  if ($courseopt{$courselevel});
       # second, check map parms
       my $thisparm = $parmhash{$symbparm};
       return $thisparm if ($thisparm);
       # first, check default
       return &Apache::lonnet::metadata($fn,$rwhat.'.default');
 }  }
   
 # ---------------------------------------------- Update rows for course listing  # ---------------------------------------------- Update rows for course listing
   
 sub updateclasssheet {  sub updateclasssheet {
     my $safeeval=shift;      my ($safeeval,$sheetdata) = @_;
     my $cnum=&getcnum($safeeval);      my $cnum  =$sheetdata->{'cnum'};
     my $cdom=&getcdom($safeeval);      my $cdom  =$sheetdata->{'cdom'};
     my $cid=&getcid($safeeval);      my $cid   =$sheetdata->{'cid'};
     my $chome=&getchome($safeeval);      my $chome =$sheetdata->{'chome'};
       #
 # ---------------------------------------------- Read class list and row labels      # Read class list and row labels
       my %classlist;
     my $classlst=&Apache::lonnet::reply      my @tmp = &Apache::lonnet::dump('classlist',$cdom,$cnum);
                                  ('dump:'.$cdom.':'.$cnum.':classlist',$chome);      if ($tmp[0] !~ /^error/) {
           %classlist = @tmp;
       } else {
           return 'Could not access course data';
       }
       undef @tmp;
       #
     my %currentlist=();      my %currentlist=();
     my $now=time;      my $now=time;
     unless ($classlst=~/^error\:/) {      foreach my $student (keys(%classlist)) {
         foreach (split(/\&/,$classlst)) {          my ($end,$start)=split(/\:/,$classlist{$student});
             my ($name,$value)=split(/\=/,$_);          my $active=1;
             my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));          $active = 0 if (($end) && ($now>$end));
             my $active=1;          $active = 1 if ($ENV{'form.Status'} eq 'Any');
             if (($end) && ($now>$end)) { $active=0; }          $active = !$active if ($ENV{'form.Status'} eq 'Expired');
             $active = 1 if ($ENV{'form.Status'} eq 'Any');          if ($active) {
             $active = !$active if ($ENV{'form.Status'} eq 'Expired');              my $rowlabel='';
             if ($active) {              my ($studentName,$studentDomain)=split(/\:/,$student);
                 my $rowlabel='';              my $studentSection=&Apache::lonnet::usection($studentDomain,
                 $name=&Apache::lonnet::unescape($name);                                                           $studentName,$cid);
                 my ($sname,$sdom)=split(/\:/,$name);              if ($studentSection==-1) {
                 my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);                  unless ($ENV{'form.showcsv'}) {
 #                if ($ssec==-1) {                      $rowlabel='<font color=red>Data not available: '.
 #   unless ($ENV{'form.showcsv'}) {                          $studentName.'</font>';
 #                    $rowlabel='<font color=red>Data not available: '.$name.                  } else {
 #      '</font>';                      $rowlabel='ERROR","'.$studentName.
 #   } else {                          '","Data not available","","","';
 #       $rowlabel='ERROR","'.$name.                  }
 #                                 '","Data not available","","","';              } else {
 #                   }                  my %reply=&Apache::lonnet::idrget($studentDomain,$studentName);
 #                } else {                  my %studentInformation=&Apache::lonnet::get
                     my %reply=&Apache::lonnet::idrget($sdom,$sname);                      ('environment',
                     my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.                       ['lastname','generation','firstname','middlename','id'],
       ':environment:firstname&middlename&lastname&generation',                       $studentDomain,$studentName);
                       &Apache::lonnet::homeserver($sname,$sdom));                  if (! $ENV{'form.showcsv'}) {
    unless ($ENV{'form.showcsv'}) {                      $rowlabel='<a href="/adm/studentcalc?uname='.$studentName.
                     $rowlabel='<a href="/adm/studentcalc?uname='.$sname.                          '&udom='.$studentDomain.'">'.
                               '&udom='.$sdom.'">'.                              $studentSection.'&nbsp;';
                               $ssec.'&nbsp;'.$reply{$sname}.'<br>';                      foreach ('id','firstname','middlename',
                     foreach ( split(/\&/,$reply)) {                               'lastname','generation'){
                         $rowlabel.=&Apache::lonnet::unescape($_).' ';                          $rowlabel.=$studentInformation{$_}."&nbsp;";
                     }                      }
                     $rowlabel.='</a>';                      $rowlabel.='</a>';
    } else {                  } else {
     $rowlabel=$ssec.'","'.$reply{$sname}.'"';                      $rowlabel= '"'.join('","',
                     my $ncount=0;                                          ($studentSection,
                     foreach (split(/\&/,$reply)) {                                           $studentInformation{'id'},
                         $rowlabel.=',"'.&Apache::lonnet::unescape($_).'"';                                           $studentInformation{'firstname'},
                         $ncount++;                                           $studentInformation{'middlename'},
                     }                                           $studentInformation{'lastname'},
                     unless ($ncount==4) { $rowlabel.=',""'; }                                           $studentInformation{'generation'})
                     $rowlabel=~s/\"$//;                                          ).'"';
    }  
 #                }  
  $currentlist{&Apache::lonnet::unescape($name)}=$rowlabel;  
             }  
         } # end of foreach (split(/\&/,$classlst))  
 #  
 # -------------------- Find discrepancies between the course row table and this  
 #  
         my %f=&getformulas($safeeval);  
         my $changed=0;  
   
         my $maxrow=0;  
         my %existing=();  
   
 # ----------------------------------------------------------- Now obsolete rows  
  foreach (keys(%f)) {  
     if ($_=~/^A(\d+)/) {  
                 $maxrow=($1>$maxrow)?$1:$maxrow;  
                 $existing{$f{$_}}=1;  
  unless ((defined($currentlist{$f{$_}})) || (!$1) ||  
                         ($f{$_}=~/^(\~\~\~|\-\-\-)/)) {  
    $f{$_}='!!! Obsolete';  
                    $changed=1;  
                 }                  }
             }              }
         }              $currentlist{$student}=$rowlabel;
           } # end of if ($active)
 # -------------------------------------------------------- New and unknown keys      } # end of foreach my $student (keys(%classlist))
            #
         foreach (sort keys(%currentlist)) {      # Find discrepancies between the course row table and this
             unless ($existing{$_}) {      #
  $changed=1;      my %f=&getformulas($safeeval);
                 $maxrow++;      my $changed=0;
                 $f{'A'.$maxrow}=$_;      #
       my $maxrow=0;
       my %existing=();
       #
       # Now obsolete rows
       foreach (keys(%f)) {
           if ($_=~/^A(\d+)/) {
               $maxrow=($1>$maxrow)?$1:$maxrow;
               $existing{$f{$_}}=1;
               unless ((defined($currentlist{$f{$_}})) || (!$1) ||
                       ($f{$_}=~/^(\~\~\~|\-\-\-)/)) {
                   $f{$_}='!!! Obsolete';
                   $changed=1;
             }              }
         }          }
        
         if ($changed) { &setformulas($safeeval,%f); }  
   
         &setmaxrow($safeeval,$maxrow);  
         &setrowlabels($safeeval,%currentlist);  
   
     } else {  
         return 'Could not access course data';  
     }      }
       #
       # New and unknown keys
       foreach (sort keys(%currentlist)) {
           unless ($existing{$_}) {
               $changed=1;
               $maxrow++;
               $f{'A'.$maxrow}=$_;
           }
       }
       if ($changed) { &setformulas($safeeval,%f); }
       #
       &setmaxrow($safeeval,$maxrow);
       &setrowlabels($safeeval,%currentlist);
 }  }
   
 # ----------------------------------- Update rows for student and assess sheets  # ----------------------------------- Update rows for student and assess sheets
   
 sub updatestudentassesssheet {  sub updatestudentassesssheet {
     my $safeeval=shift;      my ($safeeval,$sheetdata) = @_;
     my %bighash;      my %bighash;
     my $stype=&gettype($safeeval);      my $stype=$sheetdata->{'sheettype'};
     my $uname=&getuname($safeeval);      my $uname=$sheetdata->{'uname'};
     my $udom =&getudom($safeeval);      my $udom =$sheetdata->{'udom'};
     my %current=();      my %current=();
     unless ($updatedata{      if  ($updatedata
         $ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}) {           {$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}) {
 # -------------------------------------------------------------------- Tie hash          %current=split(/\_\_\_\;\_\_\_/,
       if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',                         $updatedata{$ENV{'request.course.fn'}.
                        &GDBM_READER(),0640)) {                                         '_'.$stype.'_'.$uname.'_'.$udom});
 # --------------------------------------------------------- Get all assessments      } else {
           # Tie hash
  my %allkeys=('timestamp' =>           tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
               &GDBM_READER(),0640);
           if (! tied(%bighash)) {
               return 'Could not access course data';
           }
           # Get all assessments
           my %allkeys=('timestamp' => 
                      'Timestamp of Last Transaction<br>timestamp',                       'Timestamp of Last Transaction<br>timestamp',
                      'subnumber' =>                       'subnumber' =>
                      'Number of Submissions<br>subnumber',                       'Number of Submissions<br>subnumber',
Line 1768  sub updatestudentassesssheet { Line 1811  sub updatestudentassesssheet {
                      'Number of Tutor Responses<br>tutornumber',                       'Number of Tutor Responses<br>tutornumber',
                      'totalpoints' =>                       'totalpoints' =>
                      'Total Points Granted<br>totalpoints');                       'Total Points Granted<br>totalpoints');
   
         my $adduserstr='';          my $adduserstr='';
         if ((&getuname($safeeval) ne $ENV{'user.name'}) ||          if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})){
             (&getudom($safeeval) ne $ENV{'user.domain'})) {              $adduserstr='&uname='.$uname.'&udom='.$udom;
             $adduserstr='&uname='.&getuname($safeeval).          }
  '&udom='.&getudom($safeeval);          my %allassess =
         }              ('_feedback' =>'<a href="/adm/assesscalc?usymb=_feedback'.
                $adduserstr.'">Feedback</a>',
         my %allassess=('_feedback' =>               '_evaluation' =>'<a href="/adm/assesscalc?usymb=_evaluation'.
               '<a href="/adm/assesscalc?usymb=_feedback'.$adduserstr.               $adduserstr.'">Evaluation</a>',
                        '">Feedback</a>',               '_tutoring' =>'<a href="/adm/assesscalc?usymb=_tutoring'.
                        '_evaluation' =>               $adduserstr.'">Tutoring</a>',
               '<a href="/adm/assesscalc?usymb=_evaluation'.$adduserstr.               '_discussion' =>'<a href="/adm/assesscalc?usymb=_discussion'.
                        '">Evaluation</a>',               $adduserstr.'">Discussion</a>'
                        '_tutoring' =>               );
               '<a href="/adm/assesscalc?usymb=_tutoring'.$adduserstr.          while (($_,undef) = each(%bighash)) {
                        '">Tutoring</a>',              next if ($_!~/^src\_(\d+)\.(\d+)$/);
                        '_discussion' =>              my $mapid=$1;
               '<a href="/adm/assesscalc?usymb=_discussion'.$adduserstr.              my $resid=$2;
                        '">Discussion</a>'              my $id=$mapid.'.'.$resid;
         );              my $srcf=$bighash{$_};
               if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
         foreach (keys(%bighash)) {                  my $symb=
     if ($_=~/^src\_(\d+)\.(\d+)$/) {                      &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
        my $mapid=$1;                          '___'.$resid.'___'.&Apache::lonnet::declutter($srcf);
                my $resid=$2;                  $allassess{$symb}=
                my $id=$mapid.'.'.$resid;                      '<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'.
                my $srcf=$bighash{$_};                          $bighash{'title_'.$id}.'</a>';
                if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {                  next if ($stype ne 'assesscalc');
                  my $symb=                  foreach my $key (split(/\,/,
                      &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).                                         &Apache::lonnet::metadata($srcf,'keys')
     '___'.$resid.'___'.                                         )) {
     &Apache::lonnet::declutter($srcf);                      next if ($key !~ /^(stores|parameter)_/);
  $allassess{$symb}=                      my $display=
             '<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'.                          &Apache::lonnet::metadata($srcf,$key.'.display');
                      $bighash{'title_'.$id}.'</a>';                      unless ($display) {
                  if ($stype eq 'assesscalc') {                          $display.=
      foreach (split(/\,/,                              &Apache::lonnet::metadata($srcf,$key.'.name');
     &Apache::lonnet::metadata($srcf,'keys'))) {                      }
                        if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) {                      $display.='<br>'.$key;
   my $key=$_;                      $allkeys{$key}=$display;
                           my $display=                  } # end of foreach
       &Apache::lonnet::metadata($srcf,$key.'.display');              }
                           unless ($display) {  
                               $display.=  
          &Apache::lonnet::metadata($srcf,$key.'.name');  
                           }  
                           $display.='<br>'.$key;  
                           $allkeys{$key}=$display;  
        }  
                    } # end of foreach  
          }  
       }  
    }  
         } # end of foreach (keys(%bighash))          } # end of foreach (keys(%bighash))
         untie(%bighash);          untie(%bighash);
               #
 #          # %allkeys has a list of storage and parameter displays by unikey
 # %allkeys has a list of storage and parameter displays by unikey          # %allassess has a list of all resource displays by symb
 # %allassess has a list of all resource displays by symb          #
 #  
   
         if ($stype eq 'assesscalc') {          if ($stype eq 'assesscalc') {
     %current=%allkeys;              %current=%allkeys;
         } elsif ($stype eq 'studentcalc') {          } elsif ($stype eq 'studentcalc') {
             %current=%allassess;              %current=%allassess;
         }          }
         $updatedata{$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}=          $updatedata{$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}=
     join('___;___',%current);              join('___;___',%current);
     } else {          # Get current from cache
         return 'Could not access course data';  
     }  
 # ------------------------------------------------------ Get current from cache  
     } else {  
         %current=split(/\_\_\_\;\_\_\_/,  
      $updatedata{$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom});  
     }      }
 # -------------------- Find discrepancies between the course row table and this      # Find discrepancies between the course row table and this
 #      #
         my %f=&getformulas($safeeval);      my %f=&getformulas($safeeval);
         my $changed=0;      my $changed=0;
   
         my $maxrow=0;  
         my %existing=();  
   
 # ----------------------------------------------------------- Now obsolete rows  
  foreach (keys(%f)) {  
     if ($_=~/^A(\d+)/) {  
                 $maxrow=($1>$maxrow)?$1:$maxrow;  
                 my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});  
                 $existing{$usy}=1;  
  unless ((defined($current{$usy})) || (!$1) ||  
                         ($f{$_}=~/^(\~\~\~|\-\-\-)/)){  
     $f{$_}='!!! Obsolete';  
                    $changed=1;  
         } elsif ($ufn) {  
     $current{$usy}  
                        =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/;  
                 }  
             }  
         }  
   
 # -------------------------------------------------------- New and unknown keys  
        
         foreach (keys(%current)) {  
             unless ($existing{$_}) {  
  $changed=1;  
                 $maxrow++;  
                 $f{'A'.$maxrow}=$_;  
             }  
         }  
           
         if ($changed) { &setformulas($safeeval,%f); }      my $maxrow=0;
       my %existing=();
         &setmaxrow($safeeval,$maxrow);      # Now obsolete rows
         &setrowlabels($safeeval,%current);      foreach (keys(%f)) {
            next if ($_!~/^A(\d+)/);
         undef %current;          $maxrow=($1>$maxrow)?$1:$maxrow;
         undef %existing;          my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});
           $existing{$usy}=1;
           unless ((defined($current{$usy})) || (!$1) ||
                   ($f{$_}=~/^(\~\~\~|\-\-\-)/)){
               $f{$_}='!!! Obsolete';
               $changed=1;
           } elsif ($ufn) {
               $current{$usy}
               =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/;
           }
       }
       # New and unknown keys
       foreach (keys(%current)) {
           unless ($existing{$_}) {
               $changed=1;
               $maxrow++;
               $f{'A'.$maxrow}=$_;
           }
       }
       if ($changed) { &setformulas($safeeval,%f); }
       &setmaxrow($safeeval,$maxrow);
       &setrowlabels($safeeval,%current);
       #
       undef %current;
       undef %existing;
 }  }
   
 # ------------------------------------------------ Load data for one assessment  # ------------------------------------------------ Load data for one assessment
   
 sub loadstudent {  sub loadstudent {
     my $safeeval=shift;      my ($safeeval,$sheetdata)=@_;
     my %c=();      my %c=();
     my %f=&getformulas($safeeval);      my %f=&getformulas($safeeval);
     $cachedassess=&getuname($safeeval).':'.&getudom($safeeval);      $cachedassess=$sheetdata->{'uname'}.':'.$sheetdata->{'udom'};
     %cachedstores=();      # Get ALL the student preformance data
     {      my @tmp = &Apache::lonnet::dump($sheetdata->{'cid'},
       my $reply=&Apache::lonnet::reply('dump:'.&getudom($safeeval).':'.                                      $sheetdata->{'udom'},
                                                &getuname($safeeval).':'.                                      $sheetdata->{'uname'},
                                                &getcid($safeeval),                                      undef);
                                                &getuhome($safeeval));      if ($tmp[0] !~ /^error:/) {
       unless ($reply=~/^error\:/) {          %cachedstores = @tmp;
  foreach ( split(/\&/,$reply)) {  
             my ($name,$value)=split(/\=/,$_);  
             $cachedstores{&Apache::lonnet::unescape($name)}=  
                   &Apache::lonnet::unescape($value);  
  }  
       }  
     }      }
       undef @tmp;
       # 
     my @assessdata=();      my @assessdata=();
     foreach (keys(%f)) {      foreach (keys(%f)) {
  if ($_=~/^A(\d+)/) {   next if ($_!~/^A(\d+)/);
    my $row=$1;          my $row=$1;
            unless (($f{$_}=~/^[\!\~\-]/) || ($row==0)) {          next if (($f{$_}=~/^[\!\~\-]/) || ($row==0));
       my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});          my ($usy,$ufn)=split(/__&&&\__/,$f{$_});
       @assessdata=&exportsheet(&getuname($safeeval),          @assessdata=&exportsheet($sheetdata->{'uname'},
                                        &getudom($safeeval),                                   $sheetdata->{'udom'},
                                        'assesscalc',$usy,$ufn);                                   'assesscalc',$usy,$ufn);
               my $index=0;          my $index=0;
               foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',          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') {                   '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/) {
                          $c{$col.$row}="'".$assessdata[$index]."'";                      $c{$col.$row}="'".$assessdata[$index]."'";
       } else {                  } else {
          $c{$col.$row}=$assessdata[$index];                      $c{$col.$row}=$assessdata[$index];
      }                  }
                      unless ($col eq 'A') {                   unless ($col eq 'A') { 
  $f{$col.$row}='import';                      $f{$col.$row}='import';
                      }                  }
   }              }
                   $index++;              $index++;
               }  
    }  
         }          }
     }      }
     $cachedassess='';      $cachedassess='';
Line 1947  sub loadstudent { Line 1958  sub loadstudent {
 # --------------------------------------------------- Load data for one student  # --------------------------------------------------- Load data for one student
   
 sub loadcourse {  sub loadcourse {
     my ($safeeval,$r)=@_;      my ($safeeval,$sheetdata,$r)=@_;
     my %c=();      my %c=();
     my %f=&getformulas($safeeval);      my %f=&getformulas($safeeval);
     my $total=0;      my $total=0;
Line 1971  sub loadcourse { Line 1982  sub loadcourse {
 ENDPOP  ENDPOP
     $r->rflush();      $r->rflush();
     foreach (keys(%f)) {      foreach (keys(%f)) {
  if ($_=~/^A(\d+)/) {   next if ($_!~/^A(\d+)/);
    my $row=$1;          my $row=$1;
            unless (($f{$_}=~/^[\!\~\-]/)  || ($row==0)) {          next if (($f{$_}=~/^[\!\~\-]/)  || ($row==0));
       my @studentdata=&exportsheet(split(/\:/,$f{$_}),          my @studentdata=&exportsheet(split(/\:/,$f{$_}),
                                            'studentcalc');                                       'studentcalc');
               undef %userrdatas;          undef %userrdatas;
               $now++;          $now++;
               $r->print('<script>popwin.document.popremain.remaining.value="'.          $r->print('<script>popwin.document.popremain.remaining.value="'.
                   $now.'/'.$total.': '.int((time-$since)/$now*($total-$now)).                    $now.'/'.$total.': '.int((time-$since)/$now*($total-$now)).
                         ' secs remaining";</script>');                    ' secs remaining";</script>');
               $r->rflush();           $r->rflush(); 
           #
               my $index=0;          my $index=0;
              foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',          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') {                   '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/) {
                          $c{$col.$row}="'".$studentdata[$index]."'";                      $c{$col.$row}="'".$studentdata[$index]."'";
       } else {                  } else {
          $c{$col.$row}=$studentdata[$index];                      $c{$col.$row}=$studentdata[$index];
      }                  }
                      unless ($col eq 'A') {                   unless ($col eq 'A') { 
  $f{$col.$row}='import';                      $f{$col.$row}='import';
                      }                  }
   }                  $index++;
                   $index++;              }
               }  
    }  
         }          }
     }      }
     &setformulas($safeeval,%f);      &setformulas($safeeval,%f);
Line 2011  ENDPOP Line 2020  ENDPOP
 # ------------------------------------------------ Load data for one assessment  # ------------------------------------------------ Load data for one assessment
   
 sub loadassessment {  sub loadassessment {
     my $safeeval=shift;      my ($safeeval,$sheetdata)=@_;
   
     my $uhome=&getuhome($safeeval);      my $uhome = $sheetdata->{'uhome'};
     my $uname=&getuname($safeeval);      my $uname = $sheetdata->{'uname'};
     my $udom=&getudom($safeeval);      my $udom  = $sheetdata->{'udom'};
     my $symb=&getusymb($safeeval);      my $symb  = $sheetdata->{'usymb'};
     my $cid=&getcid($safeeval);      my $cid   = $sheetdata->{'cid'};
     my $cnum=&getcnum($safeeval);      my $cnum  = $sheetdata->{'cnum'};
     my $cdom=&getcdom($safeeval);      my $cdom  = $sheetdata->{'cdom'};
     my $chome=&getchome($safeeval);      my $chome = $sheetdata->{'chome'};
   
     my $namespace;      my $namespace;
     unless ($namespace=$cid) { return ''; }      unless ($namespace=$cid) { return ''; }
       # Get stored values
 # ----------------------------------------------------------- Get stored values      my %returnhash=();
       if ($cachedassess eq $uname.':'.$udom) {
    my %returnhash=();          #
           # get data out of the dumped stores
    if ($cachedassess eq $uname.':'.$udom) {          # 
 #          my $version=$cachedstores{'version:'.$symb};
 # get data out of the dumped stores          my $scope;
 #           for ($scope=1;$scope<=$version;$scope++) {
               foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) {
        my $version=$cachedstores{'version:'.$symb};                  $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};
        my $scope;              } 
        for ($scope=1;$scope<=$version;$scope++) {          }
            foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) {      } else {
                $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};          #
            }           # restore individual
        }          #
           my $answer=&Apache::lonnet::reply(
    } else {                                            "restore:$udom:$uname:".
 #                                            &Apache::lonnet::escape($namespace).":".
 # restore individual                                            &Apache::lonnet::escape($symb),$uhome);
 #          foreach (split(/\&/,$answer)) {
               my ($name,$value)=split(/\=/,$_);
     my $answer=&Apache::lonnet::reply(              $returnhash{&Apache::lonnet::unescape($name)}=
        "restore:$udom:$uname:".                  &Apache::lonnet::unescape($value);
        &Apache::lonnet::escape($namespace).":".          }
        &Apache::lonnet::escape($symb),$uhome);          my $version;
     foreach (split(/\&/,$answer)) {          for ($version=1;$version<=$returnhash{'version'};$version++) {
  my ($name,$value)=split(/\=/,$_);              foreach (split(/\:/,$returnhash{$version.':keys'})) {
         $returnhash{&Apache::lonnet::unescape($name)}=                  $returnhash{$_}=$returnhash{$version.':'.$_};
                     &Apache::lonnet::unescape($value);              } 
     }          }
     my $version;  
     for ($version=1;$version<=$returnhash{'version'};$version++) {  
        foreach (split(/\:/,$returnhash{$version.':keys'})) {  
           $returnhash{$_}=$returnhash{$version.':'.$_};  
        }   
     }      }
    }      # 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
   
 # --------- convert all "_" to "." to be able to use libraries, multiparts, etc  
   
     my @oldkeys=keys %returnhash;      my @oldkeys=keys %returnhash;
   
     foreach (@oldkeys) {      foreach (@oldkeys) {
Line 2076  sub loadassessment { Line 2077  sub loadassessment {
         $name=~s/\_/\./g;          $name=~s/\_/\./g;
         $returnhash{$name}=$value;          $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;
   
     my $userprefix=$uname.'_'.$udom.'_';      my $userprefix=$uname.'_'.$udom.'_';
       
     unless ($uhome eq 'no_host') {       unless ($uhome eq 'no_host') { 
 # -------------------------------------------------------------- Get coursedata          # Get coursedata
       unless          unless ((time-$courserdatas{$cid.'.last_cache'})<240) {
         ((time-$courserdatas{$cid.'.last_cache'})<240) {              my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
          my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.                                               ':resourcedata',$chome);
               ':resourcedata',$chome);              if ($reply!~/^error\:/) {
          if ($reply!~/^error\:/) {                  $courserdatas{$cid}=$reply;
             $courserdatas{$cid}=$reply;                  $courserdatas{$cid.'.last_cache'}=time;
             $courserdatas{$cid.'.last_cache'}=time;              }
          }          }
       }          foreach (split(/\&/,$courserdatas{$cid})) {
       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);            }
       }          # Get userdata (if present)
 # --------------------------------------------------- Get userdata (if present)          unless
       unless              ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
         ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {                  my $reply=
          my $reply=                      &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
        &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);                  if ($reply!~/^error\:/) {
          if ($reply!~/^error\:/) {                      $userrdatas{$uname.'___'.$udom}=$reply;
      $userrdatas{$uname.'___'.$udom}=$reply;                      $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
      $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;                  }
          }              }
       }          foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) {
       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);          }
       }  
     }      }
 # ----------------- 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
 # Load keys for this assessment only      #
 #  
     my %thisassess=();      my %thisassess=();
     my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb);      my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb);
       
     foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) {      foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) {
         $thisassess{$_}=1;          $thisassess{$_}=1;
     }       } 
 #      #
 # Load parameters      # 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);          foreach (keys(%f))  {
     foreach (keys(%f))  {              next if ($_!~/^A/);
  if ($_=~/^A/) {              next if  ($f{$_}=~/^[\!\~\-]/);
             unless ($f{$_}=~/^[\!\~\-]/) {              if ($f{$_}=~/^parameter/) {
         if ($f{$_}=~/^parameter/) {                  if ($thisassess{$f{$_}}) {
  if ($thisassess{$f{$_}}) {                      my $val=&parmval($f{$_},$safeeval,$sheetdata);
                   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/\_/\./g;
                   $key=~s/\_/\./g;                  $c{$_}=$returnhash{$key};
            $c{$_}=$returnhash{$key};                  $c{$ckey}=$returnhash{$key};
                   $c{$ckey}=$returnhash{$key};              }
        }  
    }  
         }          }
           untie(%parmhash);
     }      }
     untie(%parmhash);      &setconstants($safeeval,%c);
    }  
    &setconstants($safeeval,%c);  
 }  }
   
 # --------------------------------------------------------- Various form fields  # --------------------------------------------------------- Various form fields
Line 2165  sub loadassessment { Line 2159  sub loadassessment {
 sub textfield {  sub textfield {
     my ($title,$name,$value)=@_;      my ($title,$name,$value)=@_;
     return "\n<p><b>$title:</b><br>".      return "\n<p><b>$title:</b><br>".
            '<input type=text name="'.$name.'" size=80 value="'.$value.'">';          '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
 }  }
   
 sub hiddenfield {  sub hiddenfield {
Line 2190  sub selectbox { Line 2184  sub selectbox {
 #  #
   
 sub updatesheet {  sub updatesheet {
     my $safeeval=shift;      my ($safeeval,$sheetdata)=@_;
     my $stype=&gettype($safeeval);      my $stype=$sheetdata->{'sheettype'};
     if ($stype eq 'classcalc') {      if ($stype eq 'classcalc') {
  return &updateclasssheet($safeeval);   return &updateclasssheet($safeeval,$sheetdata);
     } else {      } else {
         return &updatestudentassesssheet($safeeval);          return &updatestudentassesssheet($safeeval,$sheetdata);
     }      }
 }  }
   
Line 2205  sub updatesheet { Line 2199  sub updatesheet {
 #  #
   
 sub loadrows {  sub loadrows {
     my ($safeeval,$r)=@_;      my ($safeeval,$sheetdata,$r)=@_;
     my $stype=&gettype($safeeval);      my $stype=$sheetdata->{'sheettype'};
     if ($stype eq 'classcalc') {      if ($stype eq 'classcalc') {
  &loadcourse($safeeval,$r);   &loadcourse($safeeval,$sheetdata,$r);
     } elsif ($stype eq 'studentcalc') {      } elsif ($stype eq 'studentcalc') {
         &loadstudent($safeeval);          &loadstudent($safeeval,$sheetdata);
     } else {      } else {
         &loadassessment($safeeval);          &loadassessment($safeeval,$sheetdata);
     }      }
 }  }
   
Line 2222  sub checkthis { Line 2216  sub checkthis {
     my ($keyname,$time)=@_;      my ($keyname,$time)=@_;
     return ($time<$expiredates{$keyname});      return ($time<$expiredates{$keyname});
 }  }
   
 sub forcedrecalc {  sub forcedrecalc {
     my ($uname,$udom,$stype,$usymb)=@_;      my ($uname,$udom,$stype,$usymb)=@_;
     my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;      my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
Line 2253  sub forcedrecalc { Line 2248  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)) {
  if (($usymb=~/^\_(\w+)/) && (!$fn)) {          $fn='default_'.$1;
     $fn='default_'.$1;      }
  }      #
       # Check if cached
 #      #
 # Check if cached      my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
 #      my $found='';
       if ($oldsheets{$key}) {
  my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;          foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
  my $found='';  
   
  if ($oldsheets{$key}) {  
      foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {  
          my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);  
          if ($name eq $fn) {  
      $found=$value;  
          }  
      }  
  }  
   
  unless ($found) {  
      &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));  
      if ($oldsheets{$key}) {  
  foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {  
             my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);              my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
             if ($name eq $fn) {              if ($name eq $fn) {
         $found=$value;                  $found=$value;
             }              }
         }           }
      }  
  }  
 #  
 # Check if still valid  
 #  
  if ($found) {  
      if (&forcedrecalc($uname,$udom,$stype,$usymb)) {  
  $found='';  
      }  
  }  
    
  if ($found) {  
 #  
 # Return what was cached  
 #  
      @exportarr=split(/\_\_\_\;\_\_\_/,$found);  
   
  } else {  
 #  
 # Not cached  
 #          
   
     my $thissheet=&makenewsheet($uname,$udom,$stype,$usymb);  
     &readsheet($thissheet,$fn);  
     &updatesheet($thissheet);  
     &loadrows($thissheet);  
     &calcsheet($thissheet);   
     @exportarr=&exportdata($thissheet);  
 #  
 # Store now  
 #  
     my $cid=$ENV{'request.course.id'};   
     my $current='';  
     if ($stype eq 'studentcalc') {  
        $current=&Apache::lonnet::reply('get:'.  
                                      $ENV{'course.'.$cid.'.domain'}.':'.  
                                      $ENV{'course.'.$cid.'.num'}.  
      ':nohist_calculatedsheets:'.  
                                      &Apache::lonnet::escape($key),  
                                      $ENV{'course.'.$cid.'.home'});  
     } else {  
        $current=&Apache::lonnet::reply('get:'.  
                                      &getudom($thissheet).':'.  
                                      &getuname($thissheet).  
      ':nohist_calculatedsheets_'.  
                                      $ENV{'request.course.id'}.':'.  
                                      &Apache::lonnet::escape($key),  
                                      &getuhome($thissheet));  
   
     }      }
     my %currentlystored=();      unless ($found) {
     unless ($current=~/^error\:/) {          &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));
        foreach (split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current))) {          if ($oldsheets{$key}) {
            my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);              foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
            $currentlystored{$name}=$value;                  my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
        }                  if ($name eq $fn) {
                       $found=$value;
                   }
               } 
           }
     }      }
     $currentlystored{$fn}=join('___;___',@exportarr);      #
       # Check if still valid
     my $newstore='';      #
     foreach (keys(%currentlystored)) {      if ($found) {
         if ($newstore) { $newstore.='___&___'; }          if (&forcedrecalc($uname,$udom,$stype,$usymb)) {
         $newstore.=$_.'___=___'.$currentlystored{$_};              $found='';
           }
       }
       if ($found) {
           #
           # Return what was cached
           #
           @exportarr=split(/\_\_\_\;\_\_\_/,$found);
       } else {
           #
           # Not cached
           #        
           my ($thissheet,$sheetdata)=&makenewsheet($uname,$udom,$stype,$usymb);
           &readsheet($thissheet,$sheetdata,$fn);
           &updatesheet($thissheet,$sheetdata);
           &loadrows($thissheet,$sheetdata);
           &calcsheet($thissheet,$sheetdata); 
           @exportarr=&exportdata($thissheet,$sheetdata);
           #
           # Store now
           #
           my $cid=$ENV{'request.course.id'}; 
           my $current='';
           if ($stype eq 'studentcalc') {
               $current=&Apache::lonnet::reply('get:'.
                                               $ENV{'course.'.$cid.'.domain'}.':'.
                                               $ENV{'course.'.$cid.'.num'}.
                                               ':nohist_calculatedsheets:'.
                                               &Apache::lonnet::escape($key),
                                               $ENV{'course.'.$cid.'.home'});
           } else {
               $current=&Apache::lonnet::reply('get:'.$sheetdata->{'udom'}.':'.
                                               $sheetdata->{'uname'}.
                                               ':nohist_calculatedsheets_'.
                                               $ENV{'request.course.id'}.':'.
                                               &Apache::lonnet::escape($key),
                                               $sheetdata->{'uhome'});
           }
           my %currentlystored=();
           unless ($current=~/^error\:/) {
               foreach (split(/___&\___/,&Apache::lonnet::unescape($current))) {
                   my ($name,$value)=split(/___=___/,$_);
                   $currentlystored{$name}=$value;
               }
           }
           $currentlystored{$fn}=join('___;___',@exportarr);
           #
           my $newstore='';
           foreach (keys(%currentlystored)) {
               if ($newstore) { $newstore.='___&___'; }
               $newstore.=$_.'___=___'.$currentlystored{$_};
           }
           my $now=time;
           if ($stype eq 'studentcalc') {
               &Apache::lonnet::reply('put:'.
                                      $ENV{'course.'.$cid.'.domain'}.':'.
                                      $ENV{'course.'.$cid.'.num'}.
                                      ':nohist_calculatedsheets:'.
                                      &Apache::lonnet::escape($key).'='.
                                      &Apache::lonnet::escape($newstore).'&'.
                                      &Apache::lonnet::escape($key).'.time='.$now,
                                      $ENV{'course.'.$cid.'.home'});
           } else {
               &Apache::lonnet::reply('put:'.
                                      $sheetdata->{'udom'}.':'.
                                      $sheetdata->{'uname'}.
                                      ':nohist_calculatedsheets_'.
                                      $ENV{'request.course.id'}.':'.
                                      &Apache::lonnet::escape($key).'='.
                                      &Apache::lonnet::escape($newstore).'&'.
                                      &Apache::lonnet::escape($key).'.time='.$now,
                                      $sheetdata->{'uhome'});
           }
     }      }
     my $now=time;      return @exportarr;
     if ($stype eq 'studentcalc') {  
        &Apache::lonnet::reply('put:'.  
                          $ENV{'course.'.$cid.'.domain'}.':'.  
                          $ENV{'course.'.$cid.'.num'}.  
  ':nohist_calculatedsheets:'.  
                          &Apache::lonnet::escape($key).'='.  
  &Apache::lonnet::escape($newstore).'&'.  
                          &Apache::lonnet::escape($key).'.time='.$now,  
                          $ENV{'course.'.$cid.'.home'});  
    } else {  
        &Apache::lonnet::reply('put:'.  
                          &getudom($thissheet).':'.  
                          &getuname($thissheet).  
  ':nohist_calculatedsheets_'.  
                          $ENV{'request.course.id'}.':'.  
                          &Apache::lonnet::escape($key).'='.  
  &Apache::lonnet::escape($newstore).'&'.  
                          &Apache::lonnet::escape($key).'.time='.$now,  
                          &getuhome($thissheet));  
    }  
  }  
  return @exportarr;  
 }  }
   
 # ============================================================ Expiration Dates  # ============================================================ Expiration Dates
 #  #
 # Load previously cached student spreadsheets for this course  # Load previously cached student spreadsheets for this course
 #  #
   
 sub expirationdates {  sub expirationdates {
     undef %expiredates;      undef %expiredates;
     my $cid=$ENV{'request.course.id'};      my $cid=$ENV{'request.course.id'};
Line 2454  sub cachedssheets { Line 2439  sub cachedssheets {
   
 sub handler {  sub handler {
     my $r=shift;      my $r=shift;
   
     if ($r->header_only) {      if ($r->header_only) {
       $r->content_type('text/html');          $r->content_type('text/html');
       $r->send_http_header;          $r->send_http_header;
       return OK;          return OK;
       }
       # Global directory configs
       $includedir = $r->dir_config('lonIncludes');
       $tmpdir = $r->dir_config('lonDaemons').'/tmp/';
       # Needs to be in a course
       if (! $ENV{'request.course.fn'}) { 
           # Not in a course, or not allowed to modify parms
           $ENV{'user.error.msg'}=
               $r->uri.":opa:0:0:Cannot modify spreadsheet";
           return HTTP_NOT_ACCEPTABLE; 
     }      }
       # Get query string for limited number of parameters
 # ---------------------------------------------------- Global directory configs  
   
 $includedir=$r->dir_config('lonIncludes');  
 $tmpdir=$r->dir_config('lonDaemons').'/tmp/';  
   
 # ----------------------------------------------------- Needs to be in a course  
   
   if ($ENV{'request.course.fn'}) {   
   
 # --------------------------- Get query string for limited number of parameters  
   
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                             ['uname','udom','usymb','ufn']);                                              ['uname','udom','usymb','ufn']);
   
     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;
     }      }
       # Interactive loading of specific sheet?
 # -------------------------------------- Interactive loading of specific sheet?  
     if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {      if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {
  $ENV{'form.ufn'}=$ENV{'form.loadthissheet'};          $ENV{'form.ufn'}=$ENV{'form.loadthissheet'};
     }      }
 # ------------------------------------------- Nothing there? Must be login user      #
       # Determine the user name and domain for the sheet.
     my $aname;      my $aname;
     my $adom;      my $adom;
   
     unless ($ENV{'form.uname'}) {      unless ($ENV{'form.uname'}) {
  $aname=$ENV{'user.name'};          $aname=$ENV{'user.name'};
         $adom=$ENV{'user.domain'};          $adom=$ENV{'user.domain'};
     } else {      } else {
         $aname=$ENV{'form.uname'};          $aname=$ENV{'form.uname'};
         $adom=$ENV{'form.udom'};          $adom=$ENV{'form.udom'};
     }      }
       #
 # ------------------------------------------------------------------- Open page      # Open page
   
     $r->content_type('text/html');      $r->content_type('text/html');
     $r->header_out('Cache-control','no-cache');      $r->header_out('Cache-control','no-cache');
     $r->header_out('Pragma','no-cache');      $r->header_out('Pragma','no-cache');
     $r->send_http_header;      $r->send_http_header;
       # Screen output
 # --------------------------------------------------------------- Screen output  
   
     $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');      $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
     $r->print(<<ENDSCRIPT);      $r->print(<<ENDSCRIPT);
 <script language="JavaScript">  <script language="JavaScript">
Line 2532  $tmpdir=$r->dir_config('lonDaemons').'/t Line 2509  $tmpdir=$r->dir_config('lonDaemons').'/t
   
 </script>  </script>
 ENDSCRIPT  ENDSCRIPT
     $r->print('</head><body bgcolor="#FFFFFF">'.      $r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet').
        '<img align=right src=/adm/lonIcons/lonlogos.gif>'.                '<form action="'.$r->uri.'" name=sheet method=post>');
        '<h1>LON-CAPA Spreadsheet</h1>'.      $r->print(&hiddenfield('uname',$ENV{'form.uname'}).
        '<form action="'.$r->uri.'" name=sheet method=post>'.                &hiddenfield('udom',$ENV{'form.udom'}).
        &hiddenfield('uname',$ENV{'form.uname'}).                &hiddenfield('usymb',$ENV{'form.usymb'}).
        &hiddenfield('udom',$ENV{'form.udom'}).                &hiddenfield('unewfield','').
        &hiddenfield('usymb',$ENV{'form.usymb'}).                &hiddenfield('unewformula',''));
        &hiddenfield('unewfield','').  
        &hiddenfield('unewformula',''));  
   
 # ---------------------- Make sure that this gets out, even if user hits "stop"  
   
     $r->rflush();      $r->rflush();
       #
 # ---------------------------------------------------------------- Full recalc?      # Full recalc?
   
   
     if ($ENV{'form.forcerecalc'}) {      if ($ENV{'form.forcerecalc'}) {
  $r->print('<h4>Completely Recalculating Sheet ...</h4>');          $r->print('<h4>Completely Recalculating Sheet ...</h4>');
         undef %spreadsheets;          undef %spreadsheets;
         undef %courserdatas;          undef %courserdatas;
         undef %userrdatas;          undef %userrdatas;
         undef %defaultsheets;          undef %defaultsheets;
         undef %updatedata;          undef %updatedata;
    }      }
        # Read new sheet or modified worksheet
 # ---------------------------------------- Read new sheet or modified worksheet  
   
     $r->uri=~/\/(\w+)$/;      $r->uri=~/\/(\w+)$/;
       my ($asheet,$asheetdata)=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'});
     my $asheet=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'});      #
       # If a new formula had been entered, go from work copy
 # ------------------------ If a new formula had been entered, go from work copy  
   
     if ($ENV{'form.unewfield'}) {      if ($ENV{'form.unewfield'}) {
         $r->print('<h2>Modified Workcopy</h2>');          $r->print('<h2>Modified Workcopy</h2>');
         $ENV{'form.unewformula'}=~s/\'/\"/g;          $ENV{'form.unewformula'}=~s/\'/\"/g;
         $r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='.          $r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='.
                   $ENV{'form.unewformula'}.'<p>');                    $ENV{'form.unewformula'}.'<p>');
         &setfilename($asheet,$ENV{'form.ufn'});          &setfilename($asheet,$ENV{'form.ufn'});
  &tmpread($asheet,          &tmpread($asheet,$ENV{'form.unewfield'},$ENV{'form.unewformula'});
                  $ENV{'form.unewfield'},$ENV{'form.unewformula'});      } elsif ($ENV{'form.saveas'}) {
   
      } elsif ($ENV{'form.saveas'}) {  
         &setfilename($asheet,$ENV{'form.ufn'});          &setfilename($asheet,$ENV{'form.ufn'});
  &tmpread($asheet);          &tmpread($asheet);
     } else {      } else {
         &readsheet($asheet,$ENV{'form.ufn'});          &readsheet($asheet,$asheetdata,$ENV{'form.ufn'});
     }      }
       # Print out user information
 # -------------------------------------------------- Print out user information      unless ($asheetdata->{'sheettype'} eq 'classcalc') {
           $r->print('<p><b>User:</b> '.$asheetdata->{'uname'}.
     unless (&gettype($asheet) eq 'classcalc') {                    '<br><b>Domain:</b> '.$asheetdata->{'udom'});
         $r->print('<p><b>User:</b> '.&getuname($asheet).          if (&getcsec($asheet) eq '-1') {
                   '<br><b>Domain:</b> '.&getudom($asheet));              $r->print('<h3><font color=red>'.
 #        if (&getcsec($asheet) eq '-1') {                        'Not a student in this course</font></h3>');
 #           $r->print('<h3><font color=red>'.          } else {
 #                     'Not a student in this course</font></h3>');              $r->print('<br><b>Section/Group:</b> '.$asheetdata->{'csec'});
 #        } else {          }
            $r->print('<br><b>Section/Group:</b> '.&getcsec($asheet));  
 #        }  
         if ($ENV{'form.usymb'}) {          if ($ENV{'form.usymb'}) {
            $r->print('<br><b>Assessment:</b> <tt>'.$ENV{'form.usymb'}.'</tt>');              $r->print('<br><b>Assessment:</b> <tt>'.
                         $ENV{'form.usymb'}.'</tt>');
         }          }
     }      }
       #
 # ---------------------------------------------------------------- Course title      # Check user permissions
       if (($asheetdata->{'sheettype'} eq 'classcalc'       ) || 
     $r->print('<h1>'.          ($asheetdata->{'uname'}     ne $ENV{'user.name'} ) ||
             $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.          ($asheetdata->{'udom'}      ne $ENV{'user.domain'})) {
              '</h1><h3>'.localtime().'</h3>');          unless (&Apache::lonnet::allowed('vgr',$asheetdata->{'cid'})) {
               $r->print('<h1>Access Permission Denied</h1>'.
 # ---------------------------------------------------- See if user can see this                        '</form></body></html>');
   
     if ((&gettype($asheet) eq 'classcalc') ||   
         (&getuname($asheet) ne $ENV{'user.name'}) ||  
         (&getudom($asheet) ne $ENV{'user.domain'})) {  
         unless (&Apache::lonnet::allowed('vgr',&getcid($asheet))) {  
     $r->print(  
            '<h1>Access Permission Denied</h1></form></body></html>');  
             return OK;              return OK;
         }          }
     }      }
       # Additional options
 # ---------------------------------------------------------- Additional options      $r->print('<br />'.
                 '<input type="submit" name="forcerecalc" '.
     $r->print(                'value="Completely Recalculate Sheet"><p>');
  '<input type=submit name=forcerecalc value="Completely Recalculate Sheet"><p>'      if ($asheetdata->{'sheettype'} eq 'assesscalc') {
  );          $r->print('<p><font size=+2>'.
     if (&gettype($asheet) eq 'assesscalc') {                    '<a href="/adm/studentcalc?'.
        $r->print ('<p><font size=+2><a href="/adm/studentcalc?uname='.                    'uname='.$asheetdata->{'uname'}.
                                                &getuname($asheet).                    '&udom='.$asheetdata->{'udom'}.'">'.
                                                '&udom='.&getudom($asheet).                    'Level up: Student Sheet</a></font><p>');
                   '">Level up: Student Sheet</a></font><p>');      }
     }      if (($asheetdata->{'sheettype'} eq 'studentcalc') && 
               (&Apache::lonnet::allowed('vgr',$asheetdata->{'cid'}))) {
     if ((&gettype($asheet) eq 'studentcalc') &&           $r->print ('<p><font size=+2><a href="/adm/classcalc">'.
         (&Apache::lonnet::allowed('vgr',&getcid($asheet)))) {  
        $r->print (  
                    '<p><font size=+2><a href="/adm/classcalc">'.  
                    'Level up: Course Sheet</a></font><p>');                     'Level up: Course Sheet</a></font><p>');
     }      }
           # Save dialog
   
 # ----------------------------------------------------------------- Save dialog  
   
   
     if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {      if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
         my $fname=$ENV{'form.ufn'};          my $fname=$ENV{'form.ufn'};
         $fname=~s/\_[^\_]+$//;          $fname=~s/\_[^\_]+$//;
         if ($fname eq 'default') { $fname='course_default'; }          if ($fname eq 'default') { $fname='course_default'; }
         $r->print('<input type=submit name=saveas value="Save as ...">'.          $r->print('<input type=submit name=saveas value="Save as ...">'.
               '<input type=text size=20 name=newfn value="'.$fname.                    '<input type=text size=20 name=newfn value="'.$fname.'">'.
               '"> (make default: <input type=checkbox name="makedefufn">)<p>');                    'make default: <input type=checkbox name="makedefufn"><p>');
     }      }
   
     $r->print(&hiddenfield('ufn',&getfilename($asheet)));      $r->print(&hiddenfield('ufn',&getfilename($asheet)));
       # Load dialog
 # ----------------------------------------------------------------- Load dialog  
     if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {      if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
  $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>');
         foreach (&othersheets($asheet,&gettype($asheet))) {          foreach (&othersheets($asheet,$asheetdata->{'sheettype'})) {
     $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>');
         }           } 
         $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'));
         }          }
     }      }
       # Cached sheets
 # --------------------------------------------------------------- Cached sheets  
   
     &expirationdates();      &expirationdates();
   
     undef %oldsheets;      undef %oldsheets;
     undef %loadedcaches;      undef %loadedcaches;
       if ($asheetdata->{'sheettype'} eq 'classcalc') {
     if (&gettype($asheet) eq 'classcalc') {          $r->print("Loading previously calculated student sheets ...\n");
         $r->print("Loading previously calculated student sheets ...<br>\n");  
         $r->rflush();          $r->rflush();
         &cachedcsheets();          &cachedcsheets();
     } elsif (&gettype($asheet) eq 'studentcalc') {      } elsif ($asheetdata->{'sheettype'} eq 'studentcalc') {
         $r->print("Loading previously calculated assessment sheets ...<br>\n");          $r->print("Loading previously calculated assessment sheets ...\n");
         $r->rflush();          $r->rflush();
         &cachedssheets(&getuname($asheet),&getudom($asheet),          &cachedssheets($asheetdata->{'uname'},$asheetdata->{'udom'},
                        &getuhome($asheet));                         $asheetdata->{'uhome'});
     }      }
       # Update sheet, load rows
 # ----------------------------------------------------- Update sheet, load rows  
   
     $r->print("Loaded sheet(s), updating rows ...<br>\n");      $r->print("Loaded sheet(s), updating rows ...<br>\n");
     $r->rflush();      $r->rflush();
       #
     &updatesheet($asheet);      &updatesheet($asheet,$asheetdata);
       $r->print("Updated rows, loading row data ...\n");
     $r->print("Updated rows, loading row data ...<br>\n");  
     $r->rflush();      $r->rflush();
       #
     &loadrows($asheet,$r);      &loadrows($asheet,$asheetdata,$r);
   
     $r->print("Loaded row data, calculating sheet ...<br>\n");      $r->print("Loaded row data, calculating sheet ...<br>\n");
     $r->rflush();      $r->rflush();
       #
     my $calcoutput=&calcsheet($asheet);      my $calcoutput=&calcsheet($asheet);
     $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');      $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');
       # See if something to save
 # ---------------------------------------------------- See if something to save  
   
     if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {      if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
         my $fname='';          my $fname='';
  if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) {          if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) {
             $fname=~s/\W/\_/g;              $fname=~s/\W/\_/g;
             if ($fname eq 'default') { $fname='course_default'; }              if ($fname eq 'default') { $fname='course_default'; }
             $fname.='_'.&gettype($asheet);              $fname.='_'.$asheetdata->{'sheettype'};
             &setfilename($asheet,$fname);              &setfilename($asheet,$fname);
             $ENV{'form.ufn'}=$fname;              $ENV{'form.ufn'}=$fname;
     $r->print('<p>Saving spreadsheet: '.              $r->print('<p>Saving spreadsheet: '.
                          &writesheet($asheet,$ENV{'form.makedefufn'}).'<p>');                        &writesheet($asheet,$ENV{'form.makedefufn'}).'<p>');
  }          }
     }      }
       #
 # ------------------------------------------------ Write the modified worksheet      #Write the modified worksheet
       $r->print('<b>Current sheet:</b> '.&getfilename($asheet).'<p>');
    $r->print('<b>Current sheet:</b> '.&getfilename($asheet).'<p>');      &tmpwrite($asheet);
       if ($asheetdata->{'sheettype'} eq 'studentcalc') {
    &tmpwrite($asheet);          $r->print('<br>Show rows with empty A column: ');
   
     if (&gettype($asheet) eq 'studentcalc') {  
  $r->print('<br>Show rows with empty A column: ');  
     } else {      } else {
         $r->print('<br>Show empty rows: ');          $r->print('<br>Show empty rows: ');
     }       } 
       #
     $r->print(&hiddenfield('userselhidden','true').      $r->print(&hiddenfield('userselhidden','true').
              '<input type=checkbox name=showall onClick="submit()"');                '<input type="checkbox" name="showall" onClick="submit()"');
       #
     if ($ENV{'form.showall'}) {       if ($ENV{'form.showall'}) { 
        $r->print(' checked');           $r->print(' checked'); 
     } else {      } else {
  unless ($ENV{'form.userselhidden'}) {          unless ($ENV{'form.userselhidden'}) {
            unless               unless 
  ($ENV{'course.'.$ENV{'request.course.id'}.'.hideemptyrows'} eq 'yes') {                  ($ENV{'course.'.$ENV{'request.course.id'}.'.hideemptyrows'} eq 'yes') {
           $r->print(' checked');                      $r->print(' checked');
           $ENV{'form.showall'}=1;                      $ENV{'form.showall'}=1;
            }                  }
        }          }
     }      }
     $r->print('>');      $r->print('>');
       #
     if (&gettype($asheet) eq 'classcalc') {      # CSV format checkbox (classcalc sheets only)
        $r->print(      if ($asheetdata->{'sheettype'} eq 'classcalc') {
    ' Output CSV format: <input type=checkbox name=showcsv onClick="submit()"');          $r->print(' Output CSV format: <input type="checkbox" '.
        if ($ENV{'form.showcsv'}) { $r->print(' checked'); }                    'name="showcsv" onClick="submit()"');
        $r->print('>');          if ($ENV{'form.showcsv'}) { $r->print(' checked'); }
           $r->print('>');
     }      }
       #
 # ------------------------------------------------------------------ Insertrows      # Buttons to insert rows
     $r->print('&nbsp;Student Status: '.      $r->print('&nbsp;Student Status: '.
               &Apache::lonhtmlcommon::StatusOptions                &Apache::lonhtmlcommon::StatusOptions
               ($ENV{'form.Status'},'sheet'));                ($ENV{'form.Status'},'sheet'));
       $r->print(<<ENDINSERTBUTTONS);
    $r->print(<<ENDINSERTBUTTONS);  
 <br>  <br>
 <input type='button' onClick='insertrow("top");'   <input type='button' onClick='insertrow("top");' 
 value='Insert Row Top'>  value='Insert Row Top'>
 <input type='button' onClick='insertrow("bottom");'   <input type='button' onClick='insertrow("bottom");' 
 value='Insert Row Bottom'><br>  value='Insert Row Bottom'><br>
 ENDINSERTBUTTONS  ENDINSERTBUTTONS
       # Print out sheet
 # ------------------------------------------------------------- Print out sheet      &outsheet($r,$asheet,$asheetdata);
   
     &outsheet($r,$asheet);  
     $r->print('</form></body></html>');      $r->print('</form></body></html>');
       #  Done
 # ------------------------------------------------------------------------ Done  
   } else {  
 # ----------------------------- Not in a course, or not allowed to modify parms  
       $ENV{'user.error.msg'}=  
         $r->uri.":opa:0:0:Cannot modify spreadsheet";  
       return HTTP_NOT_ACCEPTABLE;   
   }  
     return OK;      return OK;
   
 }  }
   
 1;  1;
Removed from v.1.100.2.2  
changed lines
  Added in v.1.108

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