File:  [LON-CAPA] / loncom / interface / Attic / lonspreadsheet.pm
Revision 1.111: download - view: text, annotated - select for diffs
Fri Sep 27 18:29:15 2002 UTC (21 years, 10 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Fixed indentation on loaderror code for some reason.
Sorting is now case insensitive.
Students are no longer allowed to enter perl code in their spreadsheet.
If they attempt to fake it by 'post'ing values, we catch that and ignore it.

    1: #
    2: # $Id: lonspreadsheet.pm,v 1.111 2002/09/27 18:29:15 matthew Exp $
    3: #
    4: # Copyright Michigan State University Board of Trustees
    5: #
    6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    7: #
    8: # LON-CAPA is free software; you can redistribute it and/or modify
    9: # it under the terms of the GNU General Public License as published by
   10: # the Free Software Foundation; either version 2 of the License, or
   11: # (at your option) any later version.
   12: #
   13: # LON-CAPA is distributed in the hope that it will be useful,
   14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16: # GNU General Public License for more details.
   17: #
   18: # You should have received a copy of the GNU General Public License
   19: # along with LON-CAPA; if not, write to the Free Software
   20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21: #
   22: # /home/httpd/html/adm/gpl.txt
   23: #
   24: # http://www.lon-capa.org/
   25: #
   26: # The LearningOnline Network with CAPA
   27: # Spreadsheet/Grades Display Handler
   28: #
   29: # POD required stuff:
   30: 
   31: =head1 NAME
   32: 
   33: lonspreadsheet
   34: 
   35: =head1 SYNOPSIS
   36: 
   37: Spreadsheet interface to internal LON-CAPA data
   38: 
   39: =head1 DESCRIPTION
   40: 
   41: Lonspreadsheet provides course coordinators the ability to manage their
   42: students grades online.  The students are able to view their own grades, but
   43: not the grades of their peers.  The spreadsheet is highly customizable,
   44: offering the ability to use Perl code to manipulate data, as well as many
   45: built-in functions.
   46: 
   47: =head2 Functions available to user of lonspreadsheet
   48: 
   49: =over 4
   50: 
   51: =cut
   52: 
   53: package Apache::lonspreadsheet;
   54:             
   55: use strict;
   56: use Safe;
   57: use Safe::Hole;
   58: use Opcode;
   59: use Apache::lonnet;
   60: use Apache::Constants qw(:common :http);
   61: use GDBM_File;
   62: use HTML::TokeParser;
   63: use Apache::lonhtmlcommon;
   64: #
   65: # Caches for previously calculated spreadsheets
   66: #
   67: 
   68: my %oldsheets;
   69: my %loadedcaches;
   70: my %expiredates;
   71: 
   72: #
   73: # Cache for stores of an individual user
   74: #
   75: 
   76: my $cachedassess;
   77: my %cachedstores;
   78: 
   79: #
   80: # These cache hashes need to be independent of user, resource and course
   81: # (user and course can/should be in the keys)
   82: #
   83: 
   84: my %spreadsheets;
   85: my %courserdatas;
   86: my %userrdatas;
   87: my %defaultsheets;
   88: my %updatedata;
   89: 
   90: #
   91: # These global hashes are dependent on user, course and resource, 
   92: # and need to be initialized every time when a sheet is calculated
   93: #
   94: my %courseopt;
   95: my %useropt;
   96: my %parmhash;
   97: 
   98: #
   99: # Some hashes for stats on timing and performance
  100: #
  101: 
  102: my %starttimes;
  103: my %usedtimes;
  104: my %numbertimes;
  105: 
  106: # Stuff that only the screen handler can know
  107: 
  108: my $includedir;
  109: my $tmpdir;
  110: 
  111: # =============================================================================
  112: # ===================================== Implements an instance of a spreadsheet
  113: 
  114: sub initsheet {
  115:     my $safeeval = new Safe(shift);
  116:     my $safehole = new Safe::Hole;
  117:     $safeeval->permit("entereval");
  118:     $safeeval->permit(":base_math");
  119:     $safeeval->permit("sort");
  120:     $safeeval->deny(":base_io");
  121:     $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
  122:     $safeeval->share('$@');
  123:     my $code=<<'ENDDEFS';
  124: # ---------------------------------------------------- Inside of the safe space
  125: 
  126: #
  127: # f: formulas
  128: # t: intermediate format (variable references expanded)
  129: # v: output values
  130: # c: preloaded constants (A-column)
  131: # rl: row label
  132: # os: other spreadsheets (for student spreadsheet only)
  133: 
  134: undef %sheet_values; 
  135: undef %t;
  136: undef %f;
  137: undef %c;
  138: undef %rowlabel;
  139: undef @os;
  140: 
  141: $maxrow = 0;
  142: $sheettype = '';
  143: 
  144: # filename/reference of the sheet
  145: $filename = '';
  146: 
  147: # user data
  148: $uname = '';
  149: $uhome = '';
  150: $udom  = '';
  151: 
  152: # course data
  153: 
  154: $csec = '';
  155: $chome= '';
  156: $cnum = '';
  157: $cdom = '';
  158: $cid  = '';
  159: $coursefilename  = '';
  160: 
  161: # symb
  162: 
  163: $usymb = '';
  164: 
  165: # error messages
  166: $errormsg = '';
  167: 
  168: sub mask {
  169:     my ($lower,$upper)=@_;
  170: 
  171:     $lower=~/([A-Za-z]|\*)(\d+|\*)/;
  172:     my $la=$1;
  173:     my $ld=$2;
  174: 
  175:     $upper=~/([A-Za-z]|\*)(\d+|\*)/;
  176:     my $ua=$1;
  177:     my $ud=$2;
  178:     my $alpha='';
  179:     my $num='';
  180: 
  181:     if (($la eq '*') || ($ua eq '*')) {
  182:        $alpha='[A-Za-z]';
  183:     } else {
  184:        if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) ||
  185:            ($la=~/[a-z]/) && ($ua=~/[a-z]/)) {
  186:           $alpha='['.$la.'-'.$ua.']';
  187:        } else {
  188:           $alpha='['.$la.'-Za-'.$ua.']';
  189:        }
  190:     }   
  191: 
  192:     if (($ld eq '*') || ($ud eq '*')) {
  193: 	$num='\d+';
  194:     } else {
  195:         if (length($ld)!=length($ud)) {
  196:            $num.='(';
  197: 	   foreach ($ld=~m/\d/g) {
  198:               $num.='['.$_.'-9]';
  199: 	   }
  200:            if (length($ud)-length($ld)>1) {
  201:               $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
  202: 	   }
  203:            $num.='|';
  204:            foreach ($ud=~m/\d/g) {
  205:                $num.='[0-'.$_.']';
  206:            }
  207:            $num.=')';
  208:        } else {
  209:            my @lda=($ld=~m/\d/g);
  210:            my @uda=($ud=~m/\d/g);
  211:            my $i; $j=0; $notdone=1;
  212:            for ($i=0;($i<=$#lda)&&($notdone);$i++) {
  213:                if ($lda[$i]==$uda[$i]) {
  214: 		   $num.=$lda[$i];
  215:                    $j=$i;
  216:                } else {
  217:                    $notdone=0;
  218:                }
  219:            }
  220:            if ($j<$#lda-1) {
  221: 	       $num.='('.$lda[$j+1];
  222:                for ($i=$j+2;$i<=$#lda;$i++) {
  223:                    $num.='['.$lda[$i].'-9]';
  224:                }
  225:                if ($uda[$j+1]-$lda[$j+1]>1) {
  226: 		   $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
  227:                    ($#lda-$j-1).'}';
  228:                }
  229: 	       $num.='|'.$uda[$j+1];
  230:                for ($i=$j+2;$i<=$#uda;$i++) {
  231:                    $num.='[0-'.$uda[$i].']';
  232:                }
  233:                $num.=')';
  234:            } else {
  235:                if ($lda[$#lda]!=$uda[$#uda]) {
  236:                   $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
  237: 	       }
  238:            }
  239:        }
  240:     }
  241:     return '^'.$alpha.$num."\$";
  242: }
  243: 
  244: #-------------------------------------------------------
  245: 
  246: =item UWCALC(hashname,modules,units,date) 
  247: 
  248: returns the proportion of the module 
  249: weights not previously completed by the student.
  250: 
  251: =over 4
  252: 
  253: =item hashname 
  254: 
  255: name of the hash the module dates have been inserted into
  256: 
  257: =item modules 
  258: 
  259: reference to a cell which contains a comma deliminated list of modules 
  260: covered by the assignment.
  261: 
  262: =item units 
  263: 
  264: reference to a cell which contains a comma deliminated list of module 
  265: weights with respect to the assignment
  266: 
  267: =item date 
  268: 
  269: reference to a cell which contains the date the assignment was completed.
  270: 
  271: =back 
  272: 
  273: =cut
  274: 
  275: #-------------------------------------------------------
  276: sub UWCALC {
  277:     my ($hashname,$modules,$units,$date) = @_;
  278:     my @Modules = split(/,/,$modules);
  279:     my @Units   = split(/,/,$units);
  280:     my $total_weight;
  281:     foreach (@Units) {
  282: 	$total_weight += $_;
  283:     }
  284:     my $usum=0;
  285:     for (my $i=0; $i<=$#Modules; $i++) {
  286: 	if (&HASH($hashname,$Modules[$i]) eq $date) {
  287: 	    $usum += $Units[$i];
  288: 	}
  289:     }
  290:     return $usum/$total_weight;
  291: }
  292: 
  293: #-------------------------------------------------------
  294: 
  295: =item CDLSUM(list) 
  296: 
  297: returns the sum of the elements in a cell which contains
  298: a Comma Deliminate List of numerical values.
  299: 'list' is a reference to a cell which contains a comma deliminated list.
  300: 
  301: =cut
  302: 
  303: #-------------------------------------------------------
  304: sub CDLSUM {
  305:     my ($list)=@_;
  306:     my $sum;
  307:     foreach (split/,/,$list) {
  308: 	$sum += $_;
  309:     }
  310:     return $sum;
  311: }
  312: 
  313: #-------------------------------------------------------
  314: 
  315: =item CDLITEM(list,index) 
  316: 
  317: returns the item at 'index' in a Comma Deliminated List.
  318: 
  319: =over 4
  320: 
  321: =item list
  322: 
  323: reference to a cell which contains a comma deliminated list.
  324: 
  325: =item index 
  326: 
  327: the Perl index of the item requested (first element in list has
  328: an index of 0) 
  329: 
  330: =back
  331: 
  332: =cut
  333: 
  334: #-------------------------------------------------------
  335: sub CDLITEM {
  336:     my ($list,$index)=@_;
  337:     my @Temp = split/,/,$list;
  338:     return $Temp[$index];
  339: }
  340: 
  341: #-------------------------------------------------------
  342: 
  343: =item CDLHASH(name,key,value) 
  344: 
  345: loads a comma deliminated list of keys into
  346: the hash 'name', all with a value of 'value'.
  347: 
  348: =over 4
  349: 
  350: =item name  
  351: 
  352: name of the hash.
  353: 
  354: =item key
  355: 
  356: (a pointer to) a comma deliminated list of keys.
  357: 
  358: =item value
  359: 
  360: a single value to be entered for each key.
  361: 
  362: =back
  363: 
  364: =cut
  365: 
  366: #-------------------------------------------------------
  367: sub CDLHASH {
  368:     my ($name,$key,$value)=@_;
  369:     my @Keys;
  370:     my @Values;
  371:     # Check to see if we have multiple $key values
  372:     if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
  373: 	my $keymask = &mask($key);
  374: 	# Assume the keys are addresses
  375: 	my @Temp = grep /$keymask/,keys(%sheet_values);
  376: 	@Keys = $sheet_values{@Temp};
  377:     } else {
  378: 	$Keys[0]= $key;
  379:     }
  380:     my @Temp;
  381:     foreach $key (@Keys) {
  382: 	@Temp = (@Temp, split/,/,$key);
  383:     }
  384:     @Keys = @Temp;
  385:     if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
  386: 	my $valmask = &mask($value);
  387: 	my @Temp = grep /$valmask/,keys(%sheet_values);
  388: 	@Values =$sheet_values{@Temp};
  389:     } else {
  390: 	$Values[0]= $value;
  391:     }
  392:     $value = $Values[0];
  393:     # Add values to hash
  394:     for (my $i = 0; $i<=$#Keys; $i++) {
  395: 	my $key   = $Keys[$i];
  396: 	if (! exists ($hashes{$name}->{$key})) {
  397: 	    $hashes{$name}->{$key}->[0]=$value;
  398: 	} else {
  399: 	    my @Temp = sort(@{$hashes{$name}->{$key}},$value);
  400: 	    $hashes{$name}->{$key} = \@Temp;
  401: 	}
  402:     }
  403:     return "hash '$name' updated";
  404: }
  405: 
  406: #-------------------------------------------------------
  407: 
  408: =item GETHASH(name,key,index) 
  409: 
  410: returns the element in hash 'name' 
  411: reference by the key 'key', at index 'index' in the values list.
  412: 
  413: =cut
  414: 
  415: #-------------------------------------------------------
  416: sub GETHASH {
  417:     my ($name,$key,$index)=@_;
  418:     if (! defined($index)) {
  419: 	$index = 0;
  420:     }
  421:     if ($key =~ /^[A-z]\d+$/) {
  422: 	$key = $sheet_values{$key};
  423:     }
  424:     return $hashes{$name}->{$key}->[$index];
  425: }
  426: 
  427: #-------------------------------------------------------
  428: 
  429: =item CLEARHASH(name) 
  430: 
  431: clears all the values from the hash 'name'
  432: 
  433: =item CLEARHASH(name,key) 
  434: 
  435: clears all the values from the hash 'name' associated with the given key.
  436: 
  437: =cut
  438: 
  439: #-------------------------------------------------------
  440: sub CLEARHASH {
  441:     my ($name,$key)=@_;
  442:     if (defined($key)) {
  443: 	if (exists($hashes{$name}->{$key})) {
  444: 	    $hashes{$name}->{$key}=undef;
  445: 	    return "hash '$name' key '$key' cleared";
  446: 	}
  447:     } else {
  448: 	if (exists($hashes{$name})) {
  449: 	    $hashes{$name}=undef;
  450: 	    return "hash '$name' cleared";
  451: 	}
  452:     }
  453:     return "Error in clearing hash";
  454: }
  455: 
  456: #-------------------------------------------------------
  457: 
  458: =item HASH(name,key,value) 
  459: 
  460: loads values into an internal hash.  If a key 
  461: already has a value associated with it, the values are sorted numerically.  
  462: 
  463: =item HASH(name,key) 
  464: 
  465: returns the 0th value in the hash 'name' associated with 'key'.
  466: 
  467: =cut
  468: 
  469: #-------------------------------------------------------
  470: sub HASH {
  471:     my ($name,$key,$value)=@_;
  472:     my @Keys;
  473:     undef @Keys;
  474:     my @Values;
  475:     # Check to see if we have multiple $key values
  476:     if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
  477: 	my $keymask = &mask($key);
  478: 	# Assume the keys are addresses
  479: 	my @Temp = grep /$keymask/,keys(%sheet_values);
  480: 	@Keys = $sheet_values{@Temp};
  481:     } else {
  482: 	$Keys[0]= $key;
  483:     }
  484:     # If $value is empty, return the first value associated 
  485:     # with the first key.
  486:     if (! $value) {
  487: 	return $hashes{$name}->{$Keys[0]}->[0];
  488:     }
  489:     # Check to see if we have multiple $value(s) 
  490:     if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
  491: 	my $valmask = &mask($value);
  492: 	my @Temp = grep /$valmask/,keys(%sheet_values);
  493: 	@Values =$sheet_values{@Temp};
  494:     } else {
  495: 	$Values[0]= $value;
  496:     }
  497:     # Add values to hash
  498:     for (my $i = 0; $i<=$#Keys; $i++) {
  499: 	my $key   = $Keys[$i];
  500: 	my $value = ($i<=$#Values ? $Values[$i] : $Values[0]);
  501: 	if (! exists ($hashes{$name}->{$key})) {
  502: 	    $hashes{$name}->{$key}->[0]=$value;
  503: 	} else {
  504: 	    my @Temp = sort(@{$hashes{$name}->{$key}},$value);
  505: 	    $hashes{$name}->{$key} = \@Temp;
  506: 	}
  507:     }
  508:     return $Values[-1];
  509: }
  510: 
  511: #-------------------------------------------------------
  512: 
  513: =item NUM(range)
  514: 
  515: returns the number of items in the range.
  516: 
  517: =cut
  518: 
  519: #-------------------------------------------------------
  520: sub NUM {
  521:     my $mask=mask(@_);
  522:     my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1;
  523:     return $num;   
  524: }
  525: 
  526: sub BIN {
  527:     my ($low,$high,$lower,$upper)=@_;
  528:     my $mask=mask($lower,$upper);
  529:     my $num=0;
  530:     foreach (grep /$mask/,keys(%sheet_values)) {
  531:         if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {
  532:             $num++;
  533:         }
  534:     }
  535:     return $num;   
  536: }
  537: 
  538: 
  539: #-------------------------------------------------------
  540: 
  541: =item SUM(range)
  542: 
  543: returns the sum of items in the range.
  544: 
  545: =cut
  546: 
  547: #-------------------------------------------------------
  548: sub SUM {
  549:     my $mask=mask(@_);
  550:     my $sum=0;
  551:     foreach (grep /$mask/,keys(%sheet_values)) {
  552:         $sum+=$sheet_values{$_};
  553:     }
  554:     return $sum;   
  555: }
  556: 
  557: #-------------------------------------------------------
  558: 
  559: =item MEAN(range)
  560: 
  561: compute the average of the items in the range.
  562: 
  563: =cut
  564: 
  565: #-------------------------------------------------------
  566: sub MEAN {
  567:     my $mask=mask(@_);
  568:     my $sum=0; my $num=0;
  569:     foreach (grep /$mask/,keys(%sheet_values)) {
  570:         $sum+=$sheet_values{$_};
  571:         $num++;
  572:     }
  573:     if ($num) {
  574:        return $sum/$num;
  575:     } else {
  576:        return undef;
  577:     }   
  578: }
  579: 
  580: #-------------------------------------------------------
  581: 
  582: =item STDDEV(range)
  583: 
  584: compute the standard deviation of the items in the range.
  585: 
  586: =cut
  587: 
  588: #-------------------------------------------------------
  589: sub STDDEV {
  590:     my $mask=mask(@_);
  591:     my $sum=0; my $num=0;
  592:     foreach (grep /$mask/,keys(%sheet_values)) {
  593:         $sum+=$sheet_values{$_};
  594:         $num++;
  595:     }
  596:     unless ($num>1) { return undef; }
  597:     my $mean=$sum/$num;
  598:     $sum=0;
  599:     foreach (grep /$mask/,keys(%sheet_values)) {
  600:         $sum+=($sheet_values{$_}-$mean)**2;
  601:     }
  602:     return sqrt($sum/($num-1));    
  603: }
  604: 
  605: #-------------------------------------------------------
  606: 
  607: =item PROD(range)
  608: 
  609: compute the product of the items in the range.
  610: 
  611: =cut
  612: 
  613: #-------------------------------------------------------
  614: sub PROD {
  615:     my $mask=mask(@_);
  616:     my $prod=1;
  617:     foreach (grep /$mask/,keys(%sheet_values)) {
  618:         $prod*=$sheet_values{$_};
  619:     }
  620:     return $prod;   
  621: }
  622: 
  623: #-------------------------------------------------------
  624: 
  625: =item MAX(range)
  626: 
  627: compute the maximum of the items in the range.
  628: 
  629: =cut
  630: 
  631: #-------------------------------------------------------
  632: sub MAX {
  633:     my $mask=mask(@_);
  634:     my $max='-';
  635:     foreach (grep /$mask/,keys(%sheet_values)) {
  636:         unless ($max) { $max=$sheet_values{$_}; }
  637:         if (($sheet_values{$_}>$max) || ($max eq '-')) { $max=$sheet_values{$_}; }
  638:     } 
  639:     return $max;   
  640: }
  641: 
  642: #-------------------------------------------------------
  643: 
  644: =item MIN(range)
  645: 
  646: compute the minimum of the items in the range.
  647: 
  648: =cut
  649: 
  650: #-------------------------------------------------------
  651: sub MIN {
  652:     my $mask=mask(@_);
  653:     my $min='-';
  654:     foreach (grep /$mask/,keys(%sheet_values)) {
  655:         unless ($max) { $max=$sheet_values{$_}; }
  656:         if (($sheet_values{$_}<$min) || ($min eq '-')) { 
  657:             $min=$sheet_values{$_}; 
  658:         }
  659:     }
  660:     return $min;   
  661: }
  662: 
  663: #-------------------------------------------------------
  664: 
  665: =item SUMMAX(num,lower,upper)
  666: 
  667: compute the sum of the largest 'num' items in the range from
  668: 'lower' to 'upper'
  669: 
  670: =cut
  671: 
  672: #-------------------------------------------------------
  673: sub SUMMAX {
  674:     my ($num,$lower,$upper)=@_;
  675:     my $mask=mask($lower,$upper);
  676:     my @inside=();
  677:     foreach (grep /$mask/,keys(%sheet_values)) {
  678: 	push (@inside,$sheet_values{$_});
  679:     }
  680:     @inside=sort(@inside);
  681:     my $sum=0; my $i;
  682:     for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { 
  683:         $sum+=$inside[$i];
  684:     }
  685:     return $sum;   
  686: }
  687: 
  688: #-------------------------------------------------------
  689: 
  690: =item SUMMIN(num,lower,upper)
  691: 
  692: compute the sum of the smallest 'num' items in the range from
  693: 'lower' to 'upper'
  694: 
  695: =cut
  696: 
  697: #-------------------------------------------------------
  698: sub SUMMIN {
  699:     my ($num,$lower,$upper)=@_;
  700:     my $mask=mask($lower,$upper);
  701:     my @inside=();
  702:     foreach (grep /$mask/,keys(%sheet_values)) {
  703: 	$inside[$#inside+1]=$sheet_values{$_};
  704:     }
  705:     @inside=sort(@inside);
  706:     my $sum=0; my $i;
  707:     for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { 
  708:         $sum+=$inside[$i];
  709:     }
  710:     return $sum;   
  711: }
  712: 
  713: #-------------------------------------------------------
  714: 
  715: =item MINPARM(parametername)
  716: 
  717: Returns the minimum value of the parameters matching the parametername.
  718: parametername should be a string such as 'duedate'.
  719: 
  720: =cut
  721: 
  722: #-------------------------------------------------------
  723: sub MINPARM {
  724:     my ($expression) = @_;
  725:     my $min = undef;
  726:     study($expression);
  727:     foreach $parameter (keys(%c)) {
  728:         next if ($parameter !~ /$expression/);
  729:         if ((! defined($min)) || ($min > $c{$parameter})) {
  730:             $min = $c{$parameter} 
  731:         }
  732:     }
  733:     return $min;
  734: }
  735: 
  736: #-------------------------------------------------------
  737: 
  738: =item MAXPARM(parametername)
  739: 
  740: Returns the maximum value of the parameters matching the input parameter name.
  741: parametername should be a string such as 'duedate'.
  742: 
  743: =cut
  744: 
  745: #-------------------------------------------------------
  746: sub MAXPARM {
  747:     my ($expression) = @_;
  748:     my $max = undef;
  749:     study($expression);
  750:     foreach $parameter (keys(%c)) {
  751:         next if ($parameter !~ /$expression/);
  752:         if ((! defined($min)) || ($max < $c{$parameter})) {
  753:             $max = $c{$parameter} 
  754:         }
  755:     }
  756:     return $max;
  757: }
  758: 
  759: #--------------------------------------------------------
  760: sub expandnamed {
  761:     my $expression=shift;
  762:     if ($expression=~/^\&/) {
  763: 	my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/);
  764: 	my @vars=split(/\W+/,$formula);
  765:         my %values=();
  766:         undef %values;
  767: 	foreach ( @vars ) {
  768:             my $varname=$_;
  769:             if ($varname=~/\D/) {
  770:                $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;
  771:                $varname=~s/$var/\(\\w\+\)/g;
  772: 	       foreach (keys(%c)) {
  773: 		  if ($_=~/$varname/) {
  774: 		      $values{$1}=1;
  775:                   }
  776:                }
  777: 	    }
  778:         }
  779:         if ($func eq 'EXPANDSUM') {
  780:             my $result='';
  781: 	    foreach (keys(%values)) {
  782:                 my $thissum=$formula;
  783:                 $thissum=~s/$var/$_/g;
  784:                 $result.=$thissum.'+';
  785:             } 
  786:             $result=~s/\+$//;
  787:             return $result;
  788:         } else {
  789: 	    return 0;
  790:         }
  791:     } else {
  792:         # it is not a function, so it is a parameter name
  793:         # We should do the following:
  794:         #    1. Take the list of parameter names
  795:         #    2. look through the list for ones that match the parameter we want
  796:         #    3. If there are no collisions, return the one that matches
  797:         #    4. If there is a collision, return 'bad parameter name error'
  798:         my $returnvalue = '';
  799:         my @matches = ();
  800:         $#matches = -1;
  801:         study $expression;
  802:         foreach $parameter (keys(%c)) {
  803:             push @matches,$parameter if ($parameter =~ /$expression/);
  804:         }
  805:         if ($#matches == 0) {
  806:             $returnvalue = '$c{\''.$matches[0].'\'}';
  807:         } elsif ($#matches > 0) {
  808:             # more than one match.  Look for a concise one
  809:             $returnvalue =  "'non-unique parameter name : $expression'";
  810:             foreach (@matches) {
  811:                 if (/^$expression$/) {
  812:                     $returnvalue = '$c{\''.$_.'\'}';
  813:                 }
  814:             }
  815:         } else {
  816:             $returnvalue =  "'bad parameter name : $expression'";
  817:         }
  818:         return $returnvalue;
  819:     }
  820: }
  821: 
  822: sub sett {
  823:     %t=();
  824:     my $pattern='';
  825:     if ($sheettype eq 'assesscalc') {
  826: 	$pattern='A';
  827:     } else {
  828:         $pattern='[A-Z]';
  829:     }
  830:     # Deal with the template row
  831:     foreach (keys(%f)) {
  832: 	next if ($_!~/template\_(\w)/);
  833:         my $col=$1;
  834:         next if ($col=~/^$pattern/);
  835:         foreach (keys(%f)) {
  836:             next if ($_!~/A(\d+)/);
  837:             my $trow=$1;
  838:             next if (! $trow);
  839:             # Get the name of this cell
  840:             my $lb=$col.$trow;
  841:             # Grab the template declaration
  842:             $t{$lb}=$f{'template_'.$col};
  843:             # Replace '#' with the row number
  844:             $t{$lb}=~s/\#/$trow/g;
  845:             # Replace '....' with ','
  846:             $t{$lb}=~s/\.\.+/\,/g;
  847:             # Replace 'A0' with the value from 'A0'
  848:             $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
  849:             # Replace parameters
  850:             $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
  851:         }
  852:     }
  853:     # Deal with the normal cells
  854:     foreach (keys(%f)) {
  855: 	if (($f{$_}) && ($_!~/template\_/)) {
  856:             my $matches=($_=~/^$pattern(\d+)/);
  857:             if  (($matches) && ($1)) {
  858: 	        unless ($f{$_}=~/^\!/) {
  859: 		    $t{$_}=$c{$_};
  860:                 }
  861:             } else {
  862: 	       $t{$_}=$f{$_};
  863:                $t{$_}=~s/\.\.+/\,/g;
  864:                $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
  865:                $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
  866:             }
  867:         }
  868:     }
  869:     # For inserted lines, [B-Z] is also valid
  870:     unless ($sheettype eq 'assesscalc') {
  871:        foreach (keys(%f)) {
  872: 	   if ($_=~/[B-Z](\d+)/) {
  873: 	       if ($f{'A'.$1}=~/^[\~\-]/) {
  874:   	          $t{$_}=$f{$_};
  875:                   $t{$_}=~s/\.\.+/\,/g;
  876:                   $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
  877:                   $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
  878:                }
  879:            }
  880:        }
  881:     }
  882:     # For some reason 'A0' gets special treatment...  This seems superfluous
  883:     # but I imagine it is here for a reason.
  884:     $t{'A0'}=$f{'A0'};
  885:     $t{'A0'}=~s/\.\.+/\,/g;
  886:     $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
  887:     $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
  888: }
  889: 
  890: sub calc {
  891:     undef %sheet_values;
  892:     &sett();
  893:     my $notfinished=1;
  894:     my $lastcalc='';
  895:     my $depth=0;
  896:     while ($notfinished) {
  897: 	$notfinished=0;
  898:         foreach (keys(%t)) {
  899:             my $old=$sheet_values{$_};
  900:             $sheet_values{$_}=eval $t{$_};
  901: 	    if ($@) {
  902: 		undef %sheet_values;
  903:                 return $_.': '.$@;
  904:             }
  905: 	    if ($sheet_values{$_} ne $old) { $notfinished=1; $lastcalc=$_; }
  906:         }
  907:         $depth++;
  908:         if ($depth>100) {
  909: 	    undef %sheet_values;
  910:             return $lastcalc.': Maximum calculation depth exceeded';
  911:         }
  912:     }
  913:     return '';
  914: }
  915: 
  916: sub templaterow {
  917:     my @cols=();
  918:     $cols[0]='<b><font size=+1>Template</font></b>';
  919:     foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
  920: 	     'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
  921: 	     'a','b','c','d','e','f','g','h','i','j','k','l','m',
  922: 	     'n','o','p','q','r','s','t','u','v','w','x','y','z') {
  923:         my $fm=$f{'template_'.$_};
  924:         $fm=~s/[\'\"]/\&\#34;/g;
  925:         push(@cols,"'template_$_','$fm'".'___eq___'.$fm);
  926:     }
  927:     return @cols;
  928: }
  929: 
  930: #
  931: # This is actually used for the student spreadsheet, not the assessment sheet
  932: # Do not be fooled by the name!
  933: #
  934: sub outrowassess {
  935:     # $n is the current row number
  936:     my $n=shift;
  937:     my @cols=();
  938:     if ($n) {
  939:         my ($usy,$ufn)=split(/__&&&\__/,$f{'A'.$n});
  940:         if ($rowlabel{$usy}) {
  941:             $cols[0]=$rowlabel{$usy}.'<br>'.
  942:                 '<select name="sel_'.$n.'" onChange="changesheet('.$n.')">'.
  943:                     '<option name="default">Default</option>';
  944:         } else { 
  945:             $cols[0]=''; 
  946:         }
  947:         foreach (@os) {
  948:             $cols[0].='<option name="'.$_.'"';
  949:             if ($ufn eq $_) {
  950:                 $cols[0].=' selected';
  951:             }
  952:             $cols[0].='>'.$_.'</option>';
  953:         }
  954:         $cols[0].='</select>';
  955:     } else {
  956:         $cols[0]='<b><font size=+1>Export</font></b>';
  957:     }
  958:     foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
  959: 	     'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
  960: 	     'a','b','c','d','e','f','g','h','i','j','k','l','m',
  961: 	     'n','o','p','q','r','s','t','u','v','w','x','y','z') {
  962:         my $fm=$f{$_.$n};
  963:         $fm=~s/[\'\"]/\&\#34;/g;
  964:         push(@cols,"'$_$n','$fm'".'___eq___'.$sheet_values{$_.$n});
  965:     }
  966:     return @cols;
  967: }
  968: 
  969: sub outrow {
  970:     my $n=shift;
  971:     my @cols=();
  972:     if ($n) {
  973:        $cols[0]=$rowlabel{$f{'A'.$n}};
  974:     } else {
  975:        $cols[0]='<b><font size=+1>Export</font></b>';
  976:     }
  977:     foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
  978: 	     'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
  979: 	     'a','b','c','d','e','f','g','h','i','j','k','l','m',
  980: 	     'n','o','p','q','r','s','t','u','v','w','x','y','z') {
  981:         my $fm=$f{$_.$n};
  982:         $fm=~s/[\'\"]/\&\#34;/g;
  983:         push(@cols,"'$_$n','$fm'".'___eq___'.$sheet_values{$_.$n});
  984:     }
  985:     return @cols;
  986: }
  987: 
  988: sub exportrowa {
  989:     my @exportarray=();
  990:     foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
  991: 	     'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
  992: 	push(@exportarray,$sheet_values{$_.'0'});
  993:     } 
  994:     return @exportarray;
  995: }
  996: 
  997: # ------------------------------------------- End of "Inside of the safe space"
  998: ENDDEFS
  999:     $safeeval->reval($code);
 1000:     return $safeeval;
 1001: }
 1002: 
 1003: # ------------------------------------------------ Add or change formula values
 1004: 
 1005: sub setformulas {
 1006:     my ($safeeval,%f)=@_;
 1007:     %{$safeeval->varglob('f')}=%f;
 1008: }
 1009: 
 1010: # ------------------------------------------------ Add or change formula values
 1011: 
 1012: sub setconstants {
 1013:     my ($safeeval,%c)=@_;
 1014:     %{$safeeval->varglob('c')}=%c;
 1015: }
 1016: 
 1017: # --------------------------------------------- Set names of other spreadsheets
 1018: 
 1019: sub setothersheets {
 1020:     my ($safeeval,@os)=@_;
 1021:     @{$safeeval->varglob('os')}=@os;
 1022: }
 1023: 
 1024: # ------------------------------------------------ Add or change formula values
 1025: 
 1026: sub setrowlabels {
 1027:     my ($safeeval,%rowlabel)=@_;
 1028:     %{$safeeval->varglob('rowlabel')}=%rowlabel;
 1029: }
 1030: 
 1031: # ------------------------------------------------------- Calculate spreadsheet
 1032: 
 1033: sub calcsheet {
 1034:     my $safeeval=shift;
 1035:     return $safeeval->reval('&calc();');
 1036: }
 1037: 
 1038: # ------------------------------------------------------------------ Get values
 1039: 
 1040: sub getvalues {
 1041:     my $safeeval=shift;
 1042:     return $safeeval->reval('%sheet_values');
 1043: }
 1044: 
 1045: # ---------------------------------------------------------------- Get formulas
 1046: 
 1047: sub getformulas {
 1048:     my $safeeval=shift;
 1049:     return %{$safeeval->varglob('f')};
 1050: }
 1051: 
 1052: # ----------------------------------------------------- Get value of $f{'A'.$n}
 1053: 
 1054: sub getfa {
 1055:     my ($safeeval,$n)=@_;
 1056:     return $safeeval->reval('$f{"A'.$n.'"}');
 1057: }
 1058: 
 1059: # -------------------------------------------------------------------- Get type
 1060: 
 1061: sub gettype {
 1062:     my $safeeval=shift;
 1063:     return $safeeval->reval('$sheettype');
 1064: }
 1065: 
 1066: # ------------------------------------------------------------------ Set maxrow
 1067: 
 1068: sub setmaxrow {
 1069:     my ($safeeval,$row)=@_;
 1070:     $safeeval->reval('$maxrow='.$row.';');
 1071: }
 1072: 
 1073: # ------------------------------------------------------------------ Get maxrow
 1074: 
 1075: sub getmaxrow {
 1076:     my $safeeval=shift;
 1077:     return $safeeval->reval('$maxrow');
 1078: }
 1079: 
 1080: # ---------------------------------------------------------------- Set filename
 1081: 
 1082: sub setfilename {
 1083:     my ($safeeval,$fn)=@_;
 1084:     $safeeval->reval('$filename="'.$fn.'";');
 1085: }
 1086: 
 1087: # ---------------------------------------------------------------- Get filename
 1088: 
 1089: sub getfilename {
 1090:     my $safeeval=shift;
 1091:     return $safeeval->reval('$filename');
 1092: }
 1093: 
 1094: # --------------------------------------------------------------- Get course ID
 1095: 
 1096: sub getcid {
 1097:     my $safeeval=shift;
 1098:     return $safeeval->reval('$cid');
 1099: }
 1100: 
 1101: # --------------------------------------------------------- Get course filename
 1102: 
 1103: sub getcoursefilename {
 1104:     my $safeeval=shift;
 1105:     return $safeeval->reval('$coursefilename');
 1106: }
 1107: 
 1108: # ----------------------------------------------------------- Get course number
 1109: 
 1110: sub getcnum {
 1111:     my $safeeval=shift;
 1112:     return $safeeval->reval('$cnum');
 1113: }
 1114: 
 1115: # ------------------------------------------------------------- Get course home
 1116: 
 1117: sub getchome {
 1118:     my $safeeval=shift;
 1119:     return $safeeval->reval('$chome');
 1120: }
 1121: 
 1122: # ----------------------------------------------------------- Get course domain
 1123: 
 1124: sub getcdom {
 1125:     my $safeeval=shift;
 1126:     return $safeeval->reval('$cdom');
 1127: }
 1128: 
 1129: # ---------------------------------------------------------- Get course section
 1130: 
 1131: sub getcsec {
 1132:     my $safeeval=shift;
 1133:     return $safeeval->reval('$csec');
 1134: }
 1135: 
 1136: # --------------------------------------------------------------- Get user name
 1137: 
 1138: sub getuname {
 1139:     my $safeeval=shift;
 1140:     return $safeeval->reval('$uname');
 1141: }
 1142: 
 1143: # ------------------------------------------------------------- Get user domain
 1144: 
 1145: sub getudom {
 1146:     my $safeeval=shift;
 1147:     return $safeeval->reval('$udom');
 1148: }
 1149: 
 1150: # --------------------------------------------------------------- Get user home
 1151: 
 1152: sub getuhome {
 1153:     my $safeeval=shift;
 1154:     return $safeeval->reval('$uhome');
 1155: }
 1156: 
 1157: # -------------------------------------------------------------------- Get symb
 1158: 
 1159: sub getusymb {
 1160:     my $safeeval=shift;
 1161:     return $safeeval->reval('$usymb');
 1162: }
 1163: 
 1164: # ------------------------------------------------------------- Export of A-row
 1165: 
 1166: sub exportdata {
 1167:     my $safeeval=shift;
 1168:     return $safeeval->reval('&exportrowa()');
 1169: }
 1170: 
 1171: 
 1172: # ========================================================== End of Spreadsheet
 1173: # =============================================================================
 1174: 
 1175: #
 1176: # Procedures for screen output
 1177: #
 1178: # --------------------------------------------- Produce output row n from sheet
 1179: 
 1180: sub rown {
 1181:     my ($safeeval,$n)=@_;
 1182:     my $defaultbg;
 1183:     my $rowdata='';
 1184:     my $dataflag=0;
 1185:     unless ($n eq '-') {
 1186:         $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
 1187:     } else {
 1188:         $defaultbg='#E0FF';
 1189:     }
 1190:     unless ($ENV{'form.showcsv'}) {
 1191:         $rowdata.="\n<tr><td><b><font size=+1>$n</font></b></td>";
 1192:     } else {
 1193:         $rowdata.="\n".'"'.$n.'"';
 1194:     }
 1195:     my $showf=0;
 1196:     my $proc;
 1197:     my $maxred=1;
 1198:     my $sheettype=&gettype($safeeval);
 1199:     if ($sheettype eq 'studentcalc') {
 1200:         $proc='&outrowassess';
 1201:         $maxred=26;
 1202:     } else {
 1203:         $proc='&outrow';
 1204:     }
 1205:     if ($sheettype eq 'assesscalc') {
 1206:         $maxred=1;
 1207:     } else {
 1208:         $maxred=26;
 1209:     }
 1210:     if (&getfa($safeeval,$n)=~/^[\~\-]/) { $maxred=1; }
 1211:     if ($n eq '-') { 
 1212:         $proc='&templaterow'; 
 1213:         $n=-1; 
 1214:         $dataflag=1; 
 1215:     }
 1216:     foreach ($safeeval->reval($proc.'('.$n.')')) {
 1217:         my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
 1218:         my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
 1219:         if ((($vl ne '') || ($vl eq '0')) &&
 1220:             (($showf==1) || ($sheettype ne 'studentcalc'))) { $dataflag=1; }
 1221:         if ($showf==0) { $vl=$_; }
 1222:         unless ($ENV{'form.showcsv'}) {
 1223:             if ($showf<=$maxred) { $bgcolor='#FFDDDD'; }
 1224:             if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; } 
 1225:             if (($showf>$maxred) || ((!$n) && ($showf>0))) {
 1226:                 if ($vl eq '') {
 1227:                     $vl='<font size=+2 color='.$bgcolor.'>&#35;</font>';
 1228:                 }
 1229:                 $rowdata.='<td bgcolor='.$bgcolor.'>';
 1230:                 if ($ENV{'request.role'} =~ /^st\./) {
 1231:                     $rowdata.=$vl;
 1232:                 } else {
 1233:                     $rowdata.='<a href="javascript:celledit('.$fm.');">'.
 1234:                         $vl.'</a>';
 1235:                 }
 1236:                 $rowdata.='</td>';
 1237:             } else {
 1238:                 $rowdata.='<td bgcolor='.$bgcolor.'>&nbsp;'.$vl.'&nbsp;</td>';
 1239:             }
 1240:         } else {
 1241:             $rowdata.=',"'.$vl.'"';
 1242:         }
 1243:         $showf++;
 1244:     }  # End of foreach($safeval...)
 1245:     if ($ENV{'form.showall'} || ($dataflag)) {
 1246:         return $rowdata.($ENV{'form.showcsv'}?'':'</tr>');
 1247:     } else {
 1248:         return '';
 1249:     }
 1250: }
 1251: 
 1252: # ------------------------------------------------------------- Print out sheet
 1253: 
 1254: sub outsheet {
 1255:     my ($r,$safeeval,$sheetdata)=@_;
 1256:     my $maxred = 26;    # The maximum number of cells to show as 
 1257:                         # red (uneditable) 
 1258:                         # To make student sheets uneditable could we 
 1259:                         # set $maxred = 52?
 1260:                         #
 1261:     my $realm='Course'; # 'assessment', 'user', or 'course' sheet
 1262:     if ($sheetdata->{'sheettype'} eq 'assesscalc') {
 1263:         $maxred=1;
 1264:         $realm='Assessment';
 1265:     } elsif ($sheetdata->{'sheettype'} eq 'studentcalc') {
 1266:         $maxred=26;
 1267:         $realm='User';
 1268:     }
 1269:     #
 1270:     # Column label
 1271:     my $tabledata;
 1272:     if ($ENV{'form.showcsv'}) {
 1273:         $tabledata='<pre>';
 1274:     } else { 
 1275:         $tabledata='<table border=2><tr><th colspan=2 rowspan=2>'.
 1276:             '<font size=+2>'.$realm.'</font></th>'.
 1277:                   '<td bgcolor=#FFDDDD colspan='.$maxred.
 1278:                   '><b><font size=+1>Import</font></b></td>'.
 1279:                   '<td colspan='.(52-$maxred).
 1280: 		  '><b><font size=+1>Calculations</font></b></td></tr><tr>';
 1281:         my $showf=0;
 1282:         foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
 1283:                  'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
 1284:                  'a','b','c','d','e','f','g','h','i','j','k','l','m',
 1285:                  'n','o','p','q','r','s','t','u','v','w','x','y','z') {
 1286:             $showf++;
 1287:             if ($showf<=$maxred) { 
 1288:                 $tabledata.='<td bgcolor="#FFDDDD">'; 
 1289:             } else {
 1290:                 $tabledata.='<td>';
 1291:             }
 1292:             $tabledata.="<b><font size=+1>$_</font></b></td>";
 1293:         }
 1294:         $tabledata.='</tr>'.&rown($safeeval,'-').&rown($safeeval,0);
 1295:     }
 1296:     $r->print($tabledata);
 1297:     #
 1298:     # Prepare to output rows
 1299:     my $row;
 1300:     my $maxrow=&getmaxrow($safeeval);
 1301:     #
 1302:     my @sortby=();
 1303:     my @sortidx=();
 1304:     for ($row=1;$row<=$maxrow;$row++) {
 1305:         push (@sortby, $safeeval->reval('$f{"A'.$row.'"}'));
 1306:         push (@sortidx, $row-1);
 1307:     }
 1308:     @sortidx=sort { lc($sortby[$a]) cmp lc($sortby[$b]); } @sortidx;
 1309:     #
 1310:     # Determine the type of child spreadsheets
 1311:     my $what='Student';
 1312:     if ($sheetdata->{'sheettype'} eq 'assesscalc') {
 1313:         $what='Item';
 1314:     } elsif ($sheetdata->{'sheettype'} eq 'studentcalc') {
 1315:         $what='Assessment';
 1316:     }
 1317:     #
 1318:     # Loop through the rows and output them one at a time
 1319:     my $n=0;
 1320:     for ($row=0;$row<$maxrow;$row++) {
 1321:         my $thisrow=&rown($safeeval,$sortidx[$row]+1);
 1322:         if ($thisrow) {
 1323:             if (($n/25==int($n/25)) && (!$ENV{'form.showcsv'})) {
 1324:                 $r->print("</table>\n<br>\n");
 1325:                 $r->rflush();
 1326:                 $r->print('<table border=2><tr><td>&nbsp;<td>'.$what.'</td>');
 1327:                 $r->print('<td>'.
 1328:                           join('</td><td>',
 1329:                                (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
 1330:                                       'abcdefghijklmnopqrstuvwxyz'))).
 1331:                           "</td></tr>\n");
 1332:             }
 1333:             $n++;
 1334:             $r->print($thisrow);
 1335:         }
 1336:     }
 1337:     $r->print($ENV{'form.showcsv'}?'</pre>':'</table>');
 1338: }
 1339: 
 1340: #
 1341: # ----------------------------------------------- Read list of available sheets
 1342: # 
 1343: sub othersheets {
 1344:     my ($safeeval,$stype)=@_;
 1345:     #
 1346:     my $cnum  = &getcnum($safeeval);
 1347:     my $cdom  = &getcdom($safeeval);
 1348:     my $chome = &getchome($safeeval);
 1349:     #
 1350:     my @alternatives=();
 1351:     my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum);
 1352:     my ($tmp) = keys(%results);
 1353:     unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
 1354:         @alternatives = sort (keys(%results));
 1355:     }
 1356:     return @alternatives; 
 1357: }
 1358: 
 1359: 
 1360: #
 1361: # -------------------------------------- Parse a spreadsheet
 1362: # 
 1363: sub parse_sheet {
 1364:     # $sheetxml is a scalar reference or a scalar
 1365:     my ($sheetxml) = @_;
 1366:     if (! ref($sheetxml)) {
 1367:         my $tmp = $sheetxml;
 1368:         $sheetxml = \$tmp;
 1369:     }
 1370:     my %f;
 1371:     my $parser=HTML::TokeParser->new($sheetxml);
 1372:     my $token;
 1373:     while ($token=$parser->get_token) {
 1374:         if ($token->[0] eq 'S') {
 1375:             if ($token->[1] eq 'field') {
 1376:                 $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
 1377:                     $parser->get_text('/field');
 1378:             }
 1379:             if ($token->[1] eq 'template') {
 1380:                 $f{'template_'.$token->[2]->{'col'}}=
 1381:                     $parser->get_text('/template');
 1382:             }
 1383:         }
 1384:     }
 1385:     return \%f;
 1386: }
 1387: 
 1388: #
 1389: # -------------------------------------- Read spreadsheet formulas for a course
 1390: #
 1391: sub readsheet {
 1392:     my ($safeeval,$sheetdata,$fn)=@_;
 1393:     #
 1394:     my $stype = $sheetdata->{'sheettype'};
 1395:     my $cnum  = $sheetdata->{'cnum'};
 1396:     my $cdom  = $sheetdata->{'cdom'};
 1397:     my $chome = $sheetdata->{'chome'};
 1398:     #
 1399:     if (! defined($fn)) {
 1400:         # There is no filename. Look for defaults in course and global, cache
 1401:         unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {
 1402:             my %tmphash = &Apache::lonnet::get('environment',
 1403:                                                ['spreadsheet_default_'.$stype],
 1404:                                                $cdom,$cnum);
 1405:             my ($tmp) = keys(%tmphash);
 1406:             if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
 1407:                 $fn = 'default_'.$stype;
 1408:             } else {
 1409:                 $fn = $tmphash{'spreadsheet_default_'.$stype};
 1410:             } 
 1411:             unless (($fn) && ($fn!~/^error\:/)) {
 1412:                 $fn='default_'.$stype;
 1413:             }
 1414:             $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 
 1415:         }
 1416:     }
 1417:     # $fn now has a value
 1418:     &setfilename($safeeval,$fn);
 1419:     # see if sheet is cached
 1420:     my $fstring='';
 1421:     if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) {
 1422:         &setformulas($safeeval,split(/\_\_\_\;\_\_\_/,$fstring));
 1423:     } else {
 1424:         # Not cached, need to read
 1425:         my %f=();
 1426:         if ($fn=~/^default\_/) {
 1427:             my $sheetxml='';
 1428:             my $fh;
 1429:             my $dfn=$fn;
 1430:             $dfn=~s/\_/\./g;
 1431:             if ($fh=Apache::File->new($includedir.'/'.$dfn)) {
 1432:                 $sheetxml=join('',<$fh>);
 1433:             } else {
 1434:                 $sheetxml='<field row="0" col="A">"Error"</field>';
 1435:             }
 1436:             %f=%{&parse_sheet(\$sheetxml)};
 1437:         } elsif($fn=~/\/*\.spreadsheet$/) {
 1438:             my $sheetxml=&Apache::lonnet::getfile
 1439:                 (&Apache::lonnet::filelocation('',$fn));
 1440:             if ($sheetxml == -1) {
 1441:                 $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
 1442:                     .$fn.'"</field>';
 1443:             }
 1444:             %f=%{&parse_sheet(\$sheetxml)};
 1445:         } else {
 1446:             my $sheet='';
 1447:             my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
 1448:             my ($tmp) = keys(%tmphash);
 1449:             unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
 1450:                 foreach (keys(%tmphash)) {
 1451:                     $f{$_}=$tmphash{$_};
 1452:                 }
 1453:             }
 1454:         }
 1455:         # Cache and set
 1456:         $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);  
 1457:         &setformulas($safeeval,%f);
 1458:     }
 1459: }
 1460: 
 1461: # -------------------------------------------------------- Make new spreadsheet
 1462: sub makenewsheet {
 1463:     my ($uname,$udom,$stype,$usymb)=@_;
 1464:     my %sheetdata=();
 1465:     $sheetdata{'uname'} = $uname;
 1466:     $sheetdata{'udom'}  = $udom;
 1467:     $sheetdata{'sheettype'} = $stype;
 1468:     $sheetdata{'usymb'} = $usymb;
 1469:     $sheetdata{'cid'}   = $ENV{'request.course.id'};
 1470:     $sheetdata{'csec'}  = &Apache::lonnet::usection
 1471:                                ($udom,$uname,$ENV{'request.course.id'});
 1472:     $sheetdata{'coursefilename'}   = $ENV{'request.course.fn'};
 1473:     $sheetdata{'cnum'}  = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
 1474:     $sheetdata{'cdom'}  = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
 1475:     $sheetdata{'chome'} = $ENV{'course.'.$ENV{'request.course.id'}.'.home'};
 1476:     $sheetdata{'uhome'} = &Apache::lonnet::homeserver($uname,$udom);
 1477:     
 1478:     my $safeeval=initsheet($stype);
 1479:     my $initstring = '';
 1480:     foreach (keys(%sheetdata)) {
 1481:         $initstring.= qq{\$$_="$sheetdata{$_}";};
 1482:     }
 1483:     $safeeval->reval($initstring);
 1484:     return $safeeval,\%sheetdata;
 1485: }
 1486: 
 1487: # ------------------------------------------------------------ Save spreadsheet
 1488: sub writesheet {
 1489:     my ($safeeval,$makedef)=@_;
 1490:     my $cid=&getcid($safeeval);
 1491:     if (&Apache::lonnet::allowed('opa',$cid)) {
 1492:         my %f=&getformulas($safeeval);
 1493:         my $stype=&gettype($safeeval);
 1494:         my $cnum=&getcnum($safeeval);
 1495:         my $cdom=&getcdom($safeeval);
 1496:         my $chome=&getchome($safeeval);
 1497:         my $fn=&getfilename($safeeval);
 1498:         # Cache new sheet
 1499:         $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
 1500:         # Write sheet
 1501:         my $sheetdata='';
 1502:         foreach (keys(%f)) {
 1503:             unless ($f{$_} eq 'import') {
 1504:                 $sheetdata.=&Apache::lonnet::escape($_).'='.
 1505:                     &Apache::lonnet::escape($f{$_}).'&';
 1506:             }
 1507:         }
 1508:         $sheetdata=~s/\&$//;
 1509:         my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'.
 1510:                                          $sheetdata,$chome);
 1511:         if ($reply eq 'ok') {
 1512:             $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.
 1513:                                           $stype.'_spreadsheets:'.
 1514:                                           &Apache::lonnet::escape($fn).
 1515:                                           '='.$ENV{'user.name'}.'@'.
 1516:                                           $ENV{'user.domain'},
 1517:                                           $chome);
 1518:             if ($reply eq 'ok') {
 1519:                 if ($makedef) { 
 1520:                     return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum.
 1521:                                                   ':environment:'.
 1522:                                                   'spreadsheet_default_'.
 1523:                                                   $stype.'='.
 1524:                                                   &Apache::lonnet::escape($fn),
 1525:                                                   $chome);
 1526:                 } 
 1527:                 return $reply;
 1528:             } 
 1529:             return $reply;
 1530:         } 
 1531:         return $reply;
 1532:     }
 1533:     return 'unauthorized';
 1534: }
 1535: 
 1536: # ----------------------------------------------- Make a temp copy of the sheet
 1537: # "Modified workcopy" - interactive only
 1538: #
 1539: sub tmpwrite {
 1540:     my $safeeval=shift;
 1541:     my $fn=$ENV{'user.name'}.'_'.
 1542:         $ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'.
 1543:            &getfilename($safeeval);
 1544:     $fn=~s/\W/\_/g;
 1545:     $fn=$tmpdir.$fn.'.tmp';
 1546:     my $fh;
 1547:     if ($fh=Apache::File->new('>'.$fn)) {
 1548: 	print $fh join("\n",&getformulas($safeeval));
 1549:     }
 1550: }
 1551: 
 1552: # ---------------------------------------------------------- Read the temp copy
 1553: sub tmpread {
 1554:     my ($safeeval,$nfield,$nform)=@_;
 1555:     my $fn=$ENV{'user.name'}.'_'.
 1556:            $ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'.
 1557:            &getfilename($safeeval);
 1558:     $fn=~s/\W/\_/g;
 1559:     $fn=$tmpdir.$fn.'.tmp';
 1560:     my $fh;
 1561:     my %fo=();
 1562:     my $countrows=0;
 1563:     if ($fh=Apache::File->new($fn)) {
 1564:         my $name;
 1565:         while ($name=<$fh>) {
 1566: 	    chomp($name);
 1567:             my $value=<$fh>;
 1568:             chomp($value);
 1569:             $fo{$name}=$value;
 1570:             if ($name=~/^A(\d+)$/) {
 1571: 		if ($1>$countrows) {
 1572: 		    $countrows=$1;
 1573:                 }
 1574:             }
 1575:         }
 1576:     }
 1577:     if ($nform eq 'changesheet') {
 1578:         $fo{'A'.$nfield}=(split(/\_\_\&\&\&\_\_/,$fo{'A'.$nfield}))[0];
 1579:         unless ($ENV{'form.sel_'.$nfield} eq 'Default') {
 1580: 	    $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};
 1581:         }
 1582:     } elsif ($nfield eq 'insertrow') {
 1583:         $countrows++;
 1584:         my $newrow=substr('000000'.$countrows,-7);
 1585:         if ($nform eq 'top') {
 1586: 	    $fo{'A'.$countrows}='--- '.$newrow;
 1587:         } else {
 1588:             $fo{'A'.$countrows}='~~~ '.$newrow;
 1589:         }
 1590:     } else {
 1591:        if ($nfield) { $fo{$nfield}=$nform; }
 1592:     }
 1593:     &setformulas($safeeval,%fo);
 1594: }
 1595: 
 1596: ##################################################
 1597: ##################################################
 1598: 
 1599: =pod
 1600: 
 1601: =item &parmval()
 1602: 
 1603: Determine the value of a parameter.
 1604: 
 1605: Inputs: $what, the parameter needed, $safeeval, the safe space
 1606: 
 1607: Returns: The value of a parameter, or '' if none.
 1608: 
 1609: This function cascades through the possible levels searching for a value for
 1610: a parameter.  The levels are checked in the following order:
 1611: user, course (at section level and course level), map, and lonnet::metadata.
 1612: This function uses %parmhash, which must be tied prior to calling it.
 1613: This function also requires %courseopt and %useropt to be initialized for
 1614: this user and course.
 1615: 
 1616: =cut
 1617: 
 1618: ##################################################
 1619: ##################################################
 1620: sub parmval {
 1621:     my ($what,$safeeval,$sheetdata)=@_;
 1622:     my $symb  = $sheetdata->{'usymb'};
 1623:     unless ($symb) { return ''; }
 1624:     #
 1625:     my $cid   = $sheetdata->{'cid'};
 1626:     my $csec  = $sheetdata->{'csec'};
 1627:     my $uname = $sheetdata->{'uname'};
 1628:     my $udom  = $sheetdata->{'udom'};
 1629:     my $result='';
 1630:     #
 1631:     my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
 1632:     # Cascading lookup scheme
 1633:     my $rwhat=$what;
 1634:     $what =~ s/^parameter\_//;
 1635:     $what =~ s/\_([^\_]+)$/\.$1/;
 1636:     #
 1637:     my $symbparm = $symb.'.'.$what;
 1638:     my $mapparm  = $mapname.'___(all).'.$what;
 1639:     my $usercourseprefix = $uname.'_'.$udom.'_'.$cid;
 1640:     #
 1641:     my $seclevel  = $usercourseprefix.'.['.$csec.'].'.$what;
 1642:     my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm;
 1643:     my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm;
 1644:     #
 1645:     my $courselevel  = $usercourseprefix.'.'.$what;
 1646:     my $courselevelr = $usercourseprefix.'.'.$symbparm;
 1647:     my $courselevelm = $usercourseprefix.'.'.$mapparm;
 1648:     # fourth, check user
 1649:     if ($uname) { 
 1650:         return $useropt{$courselevelr} if ($useropt{$courselevelr});
 1651:         return $useropt{$courselevelm} if ($useropt{$courselevelm});
 1652:         return $useropt{$courselevel}  if ($useropt{$courselevel});
 1653:     }
 1654:     # third, check course
 1655:     if ($csec) {
 1656:         return $courseopt{$seclevelr} if ($courseopt{$seclevelr});
 1657:         return $courseopt{$seclevelm} if ($courseopt{$seclevelm});
 1658:         return $courseopt{$seclevel}  if ($courseopt{$seclevel});
 1659:     }
 1660:     #
 1661:     return $courseopt{$courselevelr} if ($courseopt{$courselevelr});
 1662:     return $courseopt{$courselevelm} if ($courseopt{$courselevelm});
 1663:     return $courseopt{$courselevel}  if ($courseopt{$courselevel});
 1664:     # second, check map parms
 1665:     my $thisparm = $parmhash{$symbparm};
 1666:     return $thisparm if ($thisparm);
 1667:     # first, check default
 1668:     return &Apache::lonnet::metadata($fn,$rwhat.'.default');
 1669: }
 1670: 
 1671: # ---------------------------------------------- Update rows for course listing
 1672: sub updateclasssheet {
 1673:     my ($safeeval,$sheetdata) = @_;
 1674:     my $cnum  =$sheetdata->{'cnum'};
 1675:     my $cdom  =$sheetdata->{'cdom'};
 1676:     my $cid   =$sheetdata->{'cid'};
 1677:     my $chome =$sheetdata->{'chome'};
 1678:     #
 1679:     # Read class list and row labels
 1680:     my %classlist;
 1681:     my @tmp = &Apache::lonnet::dump('classlist',$cdom,$cnum);
 1682:     if ($tmp[0] !~ /^error/) {
 1683:         %classlist = @tmp;
 1684:     } else {
 1685:         return 'Could not access course data';
 1686:     }
 1687:     undef @tmp;
 1688:     #
 1689:     my %currentlist=();
 1690:     my $now=time;
 1691:     foreach my $student (keys(%classlist)) {
 1692:         my ($end,$start)=split(/\:/,$classlist{$student});
 1693:         my $active=1;
 1694:         $active = 0 if (($end) && ($now>$end));
 1695:         $active = 1 if ($ENV{'form.Status'} eq 'Any');
 1696:         $active = !$active if ($ENV{'form.Status'} eq 'Expired');
 1697:         if ($active) {
 1698:             my $rowlabel='';
 1699:             my ($studentName,$studentDomain)=split(/\:/,$student);
 1700:             my $studentSection=&Apache::lonnet::usection($studentDomain,
 1701:                                                          $studentName,$cid);
 1702: #            if ($studentSection==-1) {
 1703: #                unless ($ENV{'form.showcsv'}) {
 1704: #                    $rowlabel='<font color=red>Data not available: '.
 1705: #                        $studentName.'</font>';
 1706: #                } else {
 1707: #                    $rowlabel='ERROR","'.$studentName.
 1708: #                        '","Data not available","","","';
 1709: #                }
 1710: #            } else {
 1711:                 my %reply=&Apache::lonnet::idrget($studentDomain,$studentName);
 1712:                 my %studentInformation=&Apache::lonnet::get
 1713:                     ('environment',
 1714:                      ['lastname','generation','firstname','middlename','id'],
 1715:                      $studentDomain,$studentName);
 1716:                 if (! $ENV{'form.showcsv'}) {
 1717:                     $rowlabel='<a href="/adm/studentcalc?uname='.$studentName.
 1718:                         '&udom='.$studentDomain.'">'.
 1719:                             $studentSection.'&nbsp;';
 1720:                     foreach ('id','firstname','middlename',
 1721:                              'lastname','generation'){
 1722:                         $rowlabel.=$studentInformation{$_}."&nbsp;";
 1723:                     }
 1724:                     $rowlabel.='</a>';
 1725:                 } else {
 1726:                     $rowlabel= '"'.join('","',
 1727:                                         ($studentSection,
 1728:                                          $studentInformation{'id'},
 1729:                                          $studentInformation{'firstname'},
 1730:                                          $studentInformation{'middlename'},
 1731:                                          $studentInformation{'lastname'},
 1732:                                          $studentInformation{'generation'})
 1733:                                         ).'"';
 1734:                 }
 1735:  #           }
 1736:             $currentlist{$student}=$rowlabel;
 1737:         } # end of if ($active)
 1738:     } # end of foreach my $student (keys(%classlist))
 1739:     #
 1740:     # Find discrepancies between the course row table and this
 1741:     #
 1742:     my %f=&getformulas($safeeval);
 1743:     my $changed=0;
 1744:     #
 1745:     my $maxrow=0;
 1746:     my %existing=();
 1747:     #
 1748:     # Now obsolete rows
 1749:     foreach (keys(%f)) {
 1750:         if ($_=~/^A(\d+)/) {
 1751:             $maxrow=($1>$maxrow)?$1:$maxrow;
 1752:             $existing{$f{$_}}=1;
 1753:             unless ((defined($currentlist{$f{$_}})) || (!$1) ||
 1754:                     ($f{$_}=~/^(\~\~\~|\-\-\-)/)) {
 1755:                 $f{$_}='!!! Obsolete';
 1756:                 $changed=1;
 1757:             }
 1758:         }
 1759:     }
 1760:     #
 1761:     # New and unknown keys
 1762:     foreach (sort keys(%currentlist)) {
 1763:         unless ($existing{$_}) {
 1764:             $changed=1;
 1765:             $maxrow++;
 1766:             $f{'A'.$maxrow}=$_;
 1767:         }
 1768:     }
 1769:     if ($changed) { &setformulas($safeeval,%f); }
 1770:     #
 1771:     &setmaxrow($safeeval,$maxrow);
 1772:     &setrowlabels($safeeval,%currentlist);
 1773: }
 1774: 
 1775: # ----------------------------------- Update rows for student and assess sheets
 1776: sub updatestudentassesssheet {
 1777:     my ($safeeval,$sheetdata) = @_;
 1778:     my %bighash;
 1779:     my $stype=$sheetdata->{'sheettype'};
 1780:     my $uname=$sheetdata->{'uname'};
 1781:     my $udom =$sheetdata->{'udom'};
 1782:     my %current=();
 1783:     if  ($updatedata
 1784:          {$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}) {
 1785:         %current=split(/\_\_\_\;\_\_\_/,
 1786:                        $updatedata{$ENV{'request.course.fn'}.
 1787:                                        '_'.$stype.'_'.$uname.'_'.$udom});
 1788:     } else {
 1789:         # Tie hash
 1790:         tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
 1791:             &GDBM_READER(),0640);
 1792:         if (! tied(%bighash)) {
 1793:             return 'Could not access course data';
 1794:         }
 1795:         # Get all assessments
 1796:         my %allkeys=('timestamp' => 
 1797:                      'Timestamp of Last Transaction<br>timestamp',
 1798:                      'subnumber' =>
 1799:                      'Number of Submissions<br>subnumber',
 1800:                      'tutornumber' =>
 1801:                      'Number of Tutor Responses<br>tutornumber',
 1802:                      'totalpoints' =>
 1803:                      'Total Points Granted<br>totalpoints');
 1804:         my $adduserstr='';
 1805:         if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})){
 1806:             $adduserstr='&uname='.$uname.'&udom='.$udom;
 1807:         }
 1808:         my %allassess =
 1809:             ('_feedback' =>'<a href="/adm/assesscalc?usymb=_feedback'.
 1810:              $adduserstr.'">Feedback</a>',
 1811:              '_evaluation' =>'<a href="/adm/assesscalc?usymb=_evaluation'.
 1812:              $adduserstr.'">Evaluation</a>',
 1813:              '_tutoring' =>'<a href="/adm/assesscalc?usymb=_tutoring'.
 1814:              $adduserstr.'">Tutoring</a>',
 1815:              '_discussion' =>'<a href="/adm/assesscalc?usymb=_discussion'.
 1816:              $adduserstr.'">Discussion</a>'
 1817:              );
 1818:         while (($_,undef) = each(%bighash)) {
 1819:             next if ($_!~/^src\_(\d+)\.(\d+)$/);
 1820:             my $mapid=$1;
 1821:             my $resid=$2;
 1822:             my $id=$mapid.'.'.$resid;
 1823:             my $srcf=$bighash{$_};
 1824:             if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
 1825:                 my $symb=
 1826:                     &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
 1827:                         '___'.$resid.'___'.&Apache::lonnet::declutter($srcf);
 1828:                 $allassess{$symb}=
 1829:                     '<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'.
 1830:                         $bighash{'title_'.$id}.'</a>';
 1831:                 next if ($stype ne 'assesscalc');
 1832:                 foreach my $key (split(/\,/,
 1833:                                        &Apache::lonnet::metadata($srcf,'keys')
 1834:                                        )) {
 1835:                     next if ($key !~ /^(stores|parameter)_/);
 1836:                     my $display=
 1837:                         &Apache::lonnet::metadata($srcf,$key.'.display');
 1838:                     unless ($display) {
 1839:                         $display.=
 1840:                             &Apache::lonnet::metadata($srcf,$key.'.name');
 1841:                     }
 1842:                     $display.='<br>'.$key;
 1843:                     $allkeys{$key}=$display;
 1844:                 } # end of foreach
 1845:             }
 1846:         } # end of foreach (keys(%bighash))
 1847:         untie(%bighash);
 1848:         #
 1849:         # %allkeys has a list of storage and parameter displays by unikey
 1850:         # %allassess has a list of all resource displays by symb
 1851:         #
 1852:         if ($stype eq 'assesscalc') {
 1853:             %current=%allkeys;
 1854:         } elsif ($stype eq 'studentcalc') {
 1855:             %current=%allassess;
 1856:         }
 1857:         $updatedata{$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}=
 1858:             join('___;___',%current);
 1859:         # Get current from cache
 1860:     }
 1861:     # Find discrepancies between the course row table and this
 1862:     #
 1863:     my %f=&getformulas($safeeval);
 1864:     my $changed=0;
 1865:     
 1866:     my $maxrow=0;
 1867:     my %existing=();
 1868:     # Now obsolete rows
 1869:     foreach (keys(%f)) {
 1870:         next if ($_!~/^A(\d+)/);
 1871:         $maxrow=($1>$maxrow)?$1:$maxrow;
 1872:         my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});
 1873:         $existing{$usy}=1;
 1874:         unless ((defined($current{$usy})) || (!$1) ||
 1875:                 ($f{$_}=~/^(\~\~\~|\-\-\-)/)){
 1876:             $f{$_}='!!! Obsolete';
 1877:             $changed=1;
 1878:         } elsif ($ufn) {
 1879:             $current{$usy}
 1880:             =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/;
 1881:         }
 1882:     }
 1883:     # New and unknown keys
 1884:     foreach (keys(%current)) {
 1885:         unless ($existing{$_}) {
 1886:             $changed=1;
 1887:             $maxrow++;
 1888:             $f{'A'.$maxrow}=$_;
 1889:         }
 1890:     }
 1891:     if ($changed) { &setformulas($safeeval,%f); }
 1892:     &setmaxrow($safeeval,$maxrow);
 1893:     &setrowlabels($safeeval,%current);
 1894:     #
 1895:     undef %current;
 1896:     undef %existing;
 1897: }
 1898: 
 1899: # ------------------------------------------------ Load data for one assessment
 1900: 
 1901: sub loadstudent {
 1902:     my ($safeeval,$sheetdata)=@_;
 1903:     my %c=();
 1904:     my %f=&getformulas($safeeval);
 1905:     $cachedassess=$sheetdata->{'uname'}.':'.$sheetdata->{'udom'};
 1906:     # Get ALL the student preformance data
 1907:     my @tmp = &Apache::lonnet::dump($sheetdata->{'cid'},
 1908:                                     $sheetdata->{'udom'},
 1909:                                     $sheetdata->{'uname'},
 1910:                                     undef);
 1911:     if ($tmp[0] !~ /^error:/) {
 1912:         %cachedstores = @tmp;
 1913:     }
 1914:     undef @tmp;
 1915:     # 
 1916:     my @assessdata=();
 1917:     foreach (keys(%f)) {
 1918: 	next if ($_!~/^A(\d+)/);
 1919:         my $row=$1;
 1920:         next if (($f{$_}=~/^[\!\~\-]/) || ($row==0));
 1921:         my ($usy,$ufn)=split(/__&&&\__/,$f{$_});
 1922:         @assessdata=&exportsheet($sheetdata->{'uname'},
 1923:                                  $sheetdata->{'udom'},
 1924:                                  'assesscalc',$usy,$ufn);
 1925:         my $index=0;
 1926:         foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
 1927:                  'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
 1928:             if ($assessdata[$index]) {
 1929:                 my $col=$_;
 1930:                 if ($assessdata[$index]=~/\D/) {
 1931:                     $c{$col.$row}="'".$assessdata[$index]."'";
 1932:                 } else {
 1933:                     $c{$col.$row}=$assessdata[$index];
 1934:                 }
 1935:                 unless ($col eq 'A') { 
 1936:                     $f{$col.$row}='import';
 1937:                 }
 1938:             }
 1939:             $index++;
 1940:         }
 1941:     }
 1942:     $cachedassess='';
 1943:     undef %cachedstores;
 1944:     &setformulas($safeeval,%f);
 1945:     &setconstants($safeeval,%c);
 1946: }
 1947: 
 1948: # --------------------------------------------------- Load data for one student
 1949: #
 1950: sub loadcourse {
 1951:     my ($safeeval,$sheetdata,$r)=@_;
 1952:     my %c=();
 1953:     my %f=&getformulas($safeeval);
 1954:     my $total=0;
 1955:     foreach (keys(%f)) {
 1956: 	if ($_=~/^A(\d+)/) {
 1957: 	    unless ($f{$_}=~/^[\!\~\-]/) { $total++; }
 1958:         }
 1959:     }
 1960:     my $now=0;
 1961:     my $since=time;
 1962:     $r->print(<<ENDPOP);
 1963: <script>
 1964:     popwin=open('','popwin','width=400,height=100');
 1965:     popwin.document.writeln('<html><body bgcolor="#FFFFFF">'+
 1966:       '<h3>Spreadsheet Calculation Progress</h3>'+
 1967:       '<form name=popremain>'+
 1968:       '<input type=text size=35 name=remaining value=Starting></form>'+
 1969:       '</body></html>');
 1970:     popwin.document.close();
 1971: </script>
 1972: ENDPOP
 1973:     $r->rflush();
 1974:     foreach (keys(%f)) {
 1975: 	next if ($_!~/^A(\d+)/);
 1976:         my $row=$1;
 1977:         next if (($f{$_}=~/^[\!\~\-]/)  || ($row==0));
 1978:         my @studentdata=&exportsheet(split(/\:/,$f{$_}),
 1979:                                      'studentcalc');
 1980:         undef %userrdatas;
 1981:         $now++;
 1982:         $r->print('<script>popwin.document.popremain.remaining.value="'.
 1983:                   $now.'/'.$total.': '.int((time-$since)/$now*($total-$now)).
 1984:                   ' secs remaining";</script>');
 1985:         $r->rflush(); 
 1986:         #
 1987:         my $index=0;
 1988:         foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
 1989:                  'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
 1990:             if ($studentdata[$index]) {
 1991:                 my $col=$_;
 1992:                 if ($studentdata[$index]=~/\D/) {
 1993:                     $c{$col.$row}="'".$studentdata[$index]."'";
 1994:                 } else {
 1995:                     $c{$col.$row}=$studentdata[$index];
 1996:                 }
 1997:                 unless ($col eq 'A') { 
 1998:                     $f{$col.$row}='import';
 1999:                 }
 2000:                 $index++;
 2001:             }
 2002:         }
 2003:     }
 2004:     &setformulas($safeeval,%f);
 2005:     &setconstants($safeeval,%c);
 2006:     $r->print('<script>popwin.close()</script>');
 2007:     $r->rflush(); 
 2008: }
 2009: 
 2010: # ------------------------------------------------ Load data for one assessment
 2011: #
 2012: sub loadassessment {
 2013:     my ($safeeval,$sheetdata)=@_;
 2014: 
 2015:     my $uhome = $sheetdata->{'uhome'};
 2016:     my $uname = $sheetdata->{'uname'};
 2017:     my $udom  = $sheetdata->{'udom'};
 2018:     my $symb  = $sheetdata->{'usymb'};
 2019:     my $cid   = $sheetdata->{'cid'};
 2020:     my $cnum  = $sheetdata->{'cnum'};
 2021:     my $cdom  = $sheetdata->{'cdom'};
 2022:     my $chome = $sheetdata->{'chome'};
 2023: 
 2024:     my $namespace;
 2025:     unless ($namespace=$cid) { return ''; }
 2026:     # Get stored values
 2027:     my %returnhash=();
 2028:     if ($cachedassess eq $uname.':'.$udom) {
 2029:         #
 2030:         # get data out of the dumped stores
 2031:         # 
 2032:         my $version=$cachedstores{'version:'.$symb};
 2033:         my $scope;
 2034:         for ($scope=1;$scope<=$version;$scope++) {
 2035:             foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) {
 2036:                 $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};
 2037:             } 
 2038:         }
 2039:     } else {
 2040:         #
 2041:         # restore individual
 2042:         #
 2043:         %returnhash = &Apache::lonnet::restore($symb,$namespace,$udom,$uname);
 2044:         for (my $version=1;$version<=$returnhash{'version'};$version++) {
 2045:             foreach (split(/\:/,$returnhash{$version.':keys'})) {
 2046:                 $returnhash{$_}=$returnhash{$version.':'.$_};
 2047:             } 
 2048:         }
 2049:     }
 2050:     #
 2051:     # returnhash now has all stores for this resource
 2052:     # convert all "_" to "." to be able to use libraries, multiparts, etc
 2053:     #
 2054:     # This is dumb.  It is also necessary :(
 2055:     my @oldkeys=keys %returnhash;
 2056:     #
 2057:     foreach (@oldkeys) {
 2058:         my $name=$_;
 2059:         my $value=$returnhash{$_};
 2060:         delete $returnhash{$_};
 2061:         $name=~s/\_/\./g;
 2062:         $returnhash{$name}=$value;
 2063:     }
 2064:     # initialize coursedata and userdata for this user
 2065:     undef %courseopt;
 2066:     undef %useropt;
 2067: 
 2068:     my $userprefix=$uname.'_'.$udom.'_';
 2069:     
 2070:     unless ($uhome eq 'no_host') { 
 2071:         # Get coursedata
 2072:         unless ((time-$courserdatas{$cid.'.last_cache'})<240) {
 2073:             my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
 2074:                                              ':resourcedata',$chome);
 2075:             if ($reply!~/^error\:/) {
 2076:                 $courserdatas{$cid}=$reply;
 2077:                 $courserdatas{$cid.'.last_cache'}=time;
 2078:             }
 2079:         }
 2080:         foreach (split(/\&/,$courserdatas{$cid})) {
 2081:             my ($name,$value)=split(/\=/,$_);
 2082:             $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
 2083:                 &Apache::lonnet::unescape($value);  
 2084:         }
 2085:         # Get userdata (if present)
 2086:         unless ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
 2087:             my $reply=
 2088:                 &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
 2089:             if ($reply!~/^error\:/) {
 2090:                 $userrdatas{$uname.'___'.$udom}=$reply;
 2091:                 $userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
 2092:             }
 2093:         }
 2094:         foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) {
 2095:             my ($name,$value)=split(/\=/,$_);
 2096:             $useropt{$userprefix.&Apache::lonnet::unescape($name)}=
 2097:                 &Apache::lonnet::unescape($value);
 2098:         }
 2099:     }
 2100:     # now courseopt, useropt initialized for this user and course
 2101:     # (used by parmval)
 2102:     #
 2103:     # Load keys for this assessment only
 2104:     #
 2105:     my %thisassess=();
 2106:     my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb);
 2107:     foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) {
 2108:         $thisassess{$_}=1;
 2109:     } 
 2110:     #
 2111:     # Load parameters
 2112:     #
 2113:     my %c=();
 2114:     if (tie(%parmhash,'GDBM_File',
 2115:             &getcoursefilename($safeeval).'_parms.db',&GDBM_READER(),0640)) {
 2116:         my %f=&getformulas($safeeval);
 2117:         foreach (keys(%f))  {
 2118:             next if ($_!~/^A/);
 2119:             next if  ($f{$_}=~/^[\!\~\-]/);
 2120:             if ($f{$_}=~/^parameter/) {
 2121:                 if ($thisassess{$f{$_}}) {
 2122:                     my $val=&parmval($f{$_},$safeeval,$sheetdata);
 2123:                     $c{$_}=$val;
 2124:                     $c{$f{$_}}=$val;
 2125:                 }
 2126:             } else {
 2127:                 my $key=$f{$_};
 2128:                 my $ckey=$key;
 2129:                 $key=~s/^stores\_/resource\./;
 2130:                 $key=~s/\_/\./g;
 2131:                 $c{$_}=$returnhash{$key};
 2132:                 $c{$ckey}=$returnhash{$key};
 2133:             }
 2134:         }
 2135:         untie(%parmhash);
 2136:     }
 2137:     &setconstants($safeeval,%c);
 2138: }
 2139: 
 2140: # --------------------------------------------------------- Various form fields
 2141: 
 2142: sub textfield {
 2143:     my ($title,$name,$value)=@_;
 2144:     return "\n<p><b>$title:</b><br>".
 2145:         '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
 2146: }
 2147: 
 2148: sub hiddenfield {
 2149:     my ($name,$value)=@_;
 2150:     return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
 2151: }
 2152: 
 2153: sub selectbox {
 2154:     my ($title,$name,$value,%options)=@_;
 2155:     my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
 2156:     foreach (sort keys(%options)) {
 2157:         $selout.='<option value="'.$_.'"';
 2158:         if ($_ eq $value) { $selout.=' selected'; }
 2159:         $selout.='>'.$options{$_}.'</option>';
 2160:     }
 2161:     return $selout.'</select>';
 2162: }
 2163: 
 2164: # =============================================== Update information in a sheet
 2165: #
 2166: # Add new users or assessments, etc.
 2167: #
 2168: 
 2169: sub updatesheet {
 2170:     my ($safeeval,$sheetdata)=@_;
 2171:     my $stype=$sheetdata->{'sheettype'};
 2172:     if ($stype eq 'classcalc') {
 2173: 	return &updateclasssheet($safeeval,$sheetdata);
 2174:     } else {
 2175:         return &updatestudentassesssheet($safeeval,$sheetdata);
 2176:     }
 2177: }
 2178: 
 2179: # =================================================== Load the rows for a sheet
 2180: #
 2181: # Import the data for rows
 2182: #
 2183: 
 2184: sub loadrows {
 2185:     my ($safeeval,$sheetdata,$r)=@_;
 2186:     my $stype=$sheetdata->{'sheettype'};
 2187:     if ($stype eq 'classcalc') {
 2188: 	&loadcourse($safeeval,$sheetdata,$r);
 2189:     } elsif ($stype eq 'studentcalc') {
 2190:         &loadstudent($safeeval,$sheetdata);
 2191:     } else {
 2192:         &loadassessment($safeeval,$sheetdata);
 2193:     }
 2194: }
 2195: 
 2196: # ======================================================= Forced recalculation?
 2197: 
 2198: sub checkthis {
 2199:     my ($keyname,$time)=@_;
 2200:     return ($time<$expiredates{$keyname});
 2201: }
 2202: 
 2203: sub forcedrecalc {
 2204:     my ($uname,$udom,$stype,$usymb)=@_;
 2205:     my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
 2206:     my $time=$oldsheets{$key.'.time'};
 2207:     if ($ENV{'form.forcerecalc'}) { return 1; }
 2208:     unless ($time) { return 1; }
 2209:     if ($stype eq 'assesscalc') {
 2210:         my $map=(split(/\_\_\_/,$usymb))[0];
 2211:         if (&checkthis('::assesscalc:',$time) ||
 2212:             &checkthis('::assesscalc:'.$map,$time) ||
 2213:             &checkthis('::assesscalc:'.$usymb,$time) ||
 2214:             &checkthis($uname.':'.$udom.':assesscalc:',$time) ||
 2215:             &checkthis($uname.':'.$udom.':assesscalc:'.$map,$time) ||
 2216:             &checkthis($uname.':'.$udom.':assesscalc:'.$usymb,$time)) {
 2217:             return 1;
 2218:         } 
 2219:     } else {
 2220:         if (&checkthis('::studentcalc:',$time) || 
 2221:             &checkthis($uname.':'.$udom.':studentcalc:',$time)) {
 2222: 	    return 1;
 2223:         }
 2224:     }
 2225:     return 0; 
 2226: }
 2227: 
 2228: # ============================================================== Export handler
 2229: #
 2230: # Non-interactive call from with program
 2231: #
 2232: 
 2233: sub exportsheet {
 2234:     my ($uname,$udom,$stype,$usymb,$fn)=@_;
 2235:     my @exportarr=();
 2236:     if (($usymb=~/^\_(\w+)/) && (!$fn)) {
 2237:         $fn='default_'.$1;
 2238:     }
 2239:     #
 2240:     # Check if cached
 2241:     #
 2242:     my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
 2243:     my $found='';
 2244:     if ($oldsheets{$key}) {
 2245:         foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
 2246:             my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
 2247:             if ($name eq $fn) {
 2248:                 $found=$value;
 2249:             }
 2250:         }
 2251:     }
 2252:     unless ($found) {
 2253:         &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom));
 2254:         if ($oldsheets{$key}) {
 2255:             foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) {
 2256:                 my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_);
 2257:                 if ($name eq $fn) {
 2258:                     $found=$value;
 2259:                 }
 2260:             } 
 2261:         }
 2262:     }
 2263:     #
 2264:     # Check if still valid
 2265:     #
 2266:     if ($found) {
 2267:         if (&forcedrecalc($uname,$udom,$stype,$usymb)) {
 2268:             $found='';
 2269:         }
 2270:     }
 2271:     if ($found) {
 2272:         #
 2273:         # Return what was cached
 2274:         #
 2275:         @exportarr=split(/\_\_\_\;\_\_\_/,$found);
 2276:     } else {
 2277:         #
 2278:         # Not cached
 2279:         #        
 2280:         my ($thissheet,$sheetdata)=&makenewsheet($uname,$udom,$stype,$usymb);
 2281:         &readsheet($thissheet,$sheetdata,$fn);
 2282:         &updatesheet($thissheet,$sheetdata);
 2283:         &loadrows($thissheet,$sheetdata);
 2284:         &calcsheet($thissheet,$sheetdata); 
 2285:         @exportarr=&exportdata($thissheet,$sheetdata);
 2286:         #
 2287:         # Store now
 2288:         #
 2289:         my $cid=$ENV{'request.course.id'}; 
 2290:         my $current='';
 2291:         if ($stype eq 'studentcalc') {
 2292:             $current=&Apache::lonnet::reply('get:'.
 2293:                                             $ENV{'course.'.$cid.'.domain'}.':'.
 2294:                                             $ENV{'course.'.$cid.'.num'}.
 2295:                                             ':nohist_calculatedsheets:'.
 2296:                                             &Apache::lonnet::escape($key),
 2297:                                             $ENV{'course.'.$cid.'.home'});
 2298:         } else {
 2299:             $current=&Apache::lonnet::reply('get:'.$sheetdata->{'udom'}.':'.
 2300:                                             $sheetdata->{'uname'}.
 2301:                                             ':nohist_calculatedsheets_'.
 2302:                                             $ENV{'request.course.id'}.':'.
 2303:                                             &Apache::lonnet::escape($key),
 2304:                                             $sheetdata->{'uhome'});
 2305:         }
 2306:         my %currentlystored=();
 2307:         unless ($current=~/^error\:/) {
 2308:             foreach (split(/___&\___/,&Apache::lonnet::unescape($current))) {
 2309:                 my ($name,$value)=split(/___=___/,$_);
 2310:                 $currentlystored{$name}=$value;
 2311:             }
 2312:         }
 2313:         $currentlystored{$fn}=join('___;___',@exportarr);
 2314:         #
 2315:         my $newstore='';
 2316:         foreach (keys(%currentlystored)) {
 2317:             if ($newstore) { $newstore.='___&___'; }
 2318:             $newstore.=$_.'___=___'.$currentlystored{$_};
 2319:         }
 2320:         my $now=time;
 2321:         if ($stype eq 'studentcalc') {
 2322:             &Apache::lonnet::reply('put:'.
 2323:                                    $ENV{'course.'.$cid.'.domain'}.':'.
 2324:                                    $ENV{'course.'.$cid.'.num'}.
 2325:                                    ':nohist_calculatedsheets:'.
 2326:                                    &Apache::lonnet::escape($key).'='.
 2327:                                    &Apache::lonnet::escape($newstore).'&'.
 2328:                                    &Apache::lonnet::escape($key).'.time='.$now,
 2329:                                    $ENV{'course.'.$cid.'.home'});
 2330:         } else {
 2331:             &Apache::lonnet::reply('put:'.
 2332:                                    $sheetdata->{'udom'}.':'.
 2333:                                    $sheetdata->{'uname'}.
 2334:                                    ':nohist_calculatedsheets_'.
 2335:                                    $ENV{'request.course.id'}.':'.
 2336:                                    &Apache::lonnet::escape($key).'='.
 2337:                                    &Apache::lonnet::escape($newstore).'&'.
 2338:                                    &Apache::lonnet::escape($key).'.time='.$now,
 2339:                                    $sheetdata->{'uhome'});
 2340:         }
 2341:     }
 2342:     return @exportarr;
 2343: }
 2344: 
 2345: # ============================================================ Expiration Dates
 2346: #
 2347: # Load previously cached student spreadsheets for this course
 2348: #
 2349: sub expirationdates {
 2350:     undef %expiredates;
 2351:     my $cid=$ENV{'request.course.id'};
 2352:     my $reply=&Apache::lonnet::reply('dump:'.
 2353: 				     $ENV{'course.'.$cid.'.domain'}.':'.
 2354:                                      $ENV{'course.'.$cid.'.num'}.
 2355: 				     ':nohist_expirationdates',
 2356:                                      $ENV{'course.'.$cid.'.home'});
 2357:     unless ($reply=~/^error\:/) {
 2358: 	foreach (split(/\&/,$reply)) {
 2359:             my ($name,$value)=split(/\=/,$_);
 2360:             $expiredates{&Apache::lonnet::unescape($name)}
 2361:                         =&Apache::lonnet::unescape($value);
 2362:         }
 2363:     }
 2364: }
 2365: 
 2366: # ===================================================== Calculated sheets cache
 2367: #
 2368: # Load previously cached student spreadsheets for this course
 2369: #
 2370: 
 2371: sub cachedcsheets {
 2372:     my $cid=$ENV{'request.course.id'};
 2373:     my $reply=&Apache::lonnet::reply('dump:'.
 2374: 				     $ENV{'course.'.$cid.'.domain'}.':'.
 2375:                                      $ENV{'course.'.$cid.'.num'}.
 2376: 				     ':nohist_calculatedsheets',
 2377:                                      $ENV{'course.'.$cid.'.home'});
 2378:     unless ($reply=~/^error\:/) {
 2379: 	foreach ( split(/\&/,$reply)) {
 2380:             my ($name,$value)=split(/\=/,$_);
 2381:             $oldsheets{&Apache::lonnet::unescape($name)}
 2382:                       =&Apache::lonnet::unescape($value);
 2383:         }
 2384:     }
 2385: }
 2386: 
 2387: # ===================================================== Calculated sheets cache
 2388: #
 2389: # Load previously cached assessment spreadsheets for this student
 2390: #
 2391: 
 2392: sub cachedssheets {
 2393:   my ($sname,$sdom,$shome)=@_;
 2394:   unless (($loadedcaches{$sname.'_'.$sdom}) || ($shome eq 'no_host')) {
 2395:     my $cid=$ENV{'request.course.id'};
 2396:     my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname.
 2397: 			             ':nohist_calculatedsheets_'.
 2398:                                       $ENV{'request.course.id'},
 2399:                                      $shome);
 2400:     unless ($reply=~/^error\:/) {
 2401: 	foreach ( split(/\&/,$reply)) {
 2402:             my ($name,$value)=split(/\=/,$_);
 2403:             $oldsheets{&Apache::lonnet::unescape($name)}
 2404:                       =&Apache::lonnet::unescape($value);
 2405:         }
 2406:     }
 2407:     $loadedcaches{$sname.'_'.$sdom}=1;
 2408:   }
 2409: }
 2410: 
 2411: # ===================================================== Calculated sheets cache
 2412: #
 2413: # Load previously cached assessment spreadsheets for this student
 2414: #
 2415: 
 2416: # ================================================================ Main handler
 2417: #
 2418: # Interactive call to screen
 2419: #
 2420: #
 2421: sub handler {
 2422:     my $r=shift;
 2423: 
 2424:     my $loaderror=&Apache::lonnet::overloaderror($r);
 2425:     if ($loaderror) { return $loaderror; }
 2426:     $loaderror= &Apache::lonnet::overloaderror($r,
 2427:                       $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
 2428:     if ($loaderror) { return $loaderror; } 
 2429: 
 2430:     if ($r->header_only) {
 2431:         $r->content_type('text/html');
 2432:         $r->send_http_header;
 2433:         return OK;
 2434:     }
 2435:     # Global directory configs
 2436:     $includedir = $r->dir_config('lonIncludes');
 2437:     $tmpdir = $r->dir_config('lonDaemons').'/tmp/';
 2438:     # Needs to be in a course
 2439:     if (! $ENV{'request.course.fn'}) { 
 2440:         # Not in a course, or not allowed to modify parms
 2441:         $ENV{'user.error.msg'}=
 2442:             $r->uri.":opa:0:0:Cannot modify spreadsheet";
 2443:         return HTTP_NOT_ACCEPTABLE; 
 2444:     }
 2445:     # Get query string for limited number of parameters
 2446:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
 2447:                                             ['uname','udom','usymb','ufn']);
 2448:     if ($ENV{'request.role'} =~ /^st\./) {
 2449:         delete $ENV{'form.unewfield'}   if (exists($ENV{'form.unewfield'}));
 2450:         delete $ENV{'form.unewformula'} if (exists($ENV{'form.unewformula'}));
 2451:     }
 2452:     if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) {
 2453:         $ENV{'form.ufn'}='default_'.$1;
 2454:     }
 2455:     # Interactive loading of specific sheet?
 2456:     if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {
 2457:         $ENV{'form.ufn'}=$ENV{'form.loadthissheet'};
 2458:     }
 2459:     #
 2460:     # Determine the user name and domain for the sheet.
 2461:     my $aname;
 2462:     my $adom;
 2463:     unless ($ENV{'form.uname'}) {
 2464:         $aname=$ENV{'user.name'};
 2465:         $adom=$ENV{'user.domain'};
 2466:     } else {
 2467:         $aname=$ENV{'form.uname'};
 2468:         $adom=$ENV{'form.udom'};
 2469:     }
 2470:     #
 2471:     # Open page
 2472:     $r->content_type('text/html');
 2473:     $r->header_out('Cache-control','no-cache');
 2474:     $r->header_out('Pragma','no-cache');
 2475:     $r->send_http_header;
 2476:     # Screen output
 2477:     $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
 2478:     if ($ENV{'request.role'} !~ /^st\./) {
 2479:         $r->print(<<ENDSCRIPT);
 2480: <script language="JavaScript">
 2481: 
 2482:     function celledit(cn,cf) {
 2483:         var cnf=prompt(cn,cf);
 2484:         if (cnf!=null) {
 2485:             document.sheet.unewfield.value=cn;
 2486:             document.sheet.unewformula.value=cnf;
 2487:             document.sheet.submit();
 2488:         }
 2489:     }
 2490: 
 2491:     function changesheet(cn) {
 2492: 	document.sheet.unewfield.value=cn;
 2493:         document.sheet.unewformula.value='changesheet';
 2494:         document.sheet.submit();
 2495:     }
 2496: 
 2497:     function insertrow(cn) {
 2498: 	document.sheet.unewfield.value='insertrow';
 2499:         document.sheet.unewformula.value=cn;
 2500:         document.sheet.submit();
 2501:     }
 2502: 
 2503: </script>
 2504: ENDSCRIPT
 2505:     }
 2506:     $r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet').
 2507:               '<form action="'.$r->uri.'" name=sheet method=post>');
 2508:     $r->print(&hiddenfield('uname',$ENV{'form.uname'}).
 2509:               &hiddenfield('udom',$ENV{'form.udom'}).
 2510:               &hiddenfield('usymb',$ENV{'form.usymb'}).
 2511:               &hiddenfield('unewfield','').
 2512:               &hiddenfield('unewformula',''));
 2513:     $r->rflush();
 2514:     #
 2515:     # Full recalc?
 2516:     if ($ENV{'form.forcerecalc'}) {
 2517:         $r->print('<h4>Completely Recalculating Sheet ...</h4>');
 2518:         undef %spreadsheets;
 2519:         undef %courserdatas;
 2520:         undef %userrdatas;
 2521:         undef %defaultsheets;
 2522:         undef %updatedata;
 2523:     }
 2524:     # Read new sheet or modified worksheet
 2525:     $r->uri=~/\/(\w+)$/;
 2526:     my ($asheet,$asheetdata)=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'});
 2527:     #
 2528:     # If a new formula had been entered, go from work copy
 2529:     if ($ENV{'form.unewfield'}) {
 2530:         $r->print('<h2>Modified Workcopy</h2>');
 2531:         $ENV{'form.unewformula'}=~s/\'/\"/g;
 2532:         $r->print('<p>New formula: '.$ENV{'form.unewfield'}.'='.
 2533:                   $ENV{'form.unewformula'}.'<p>');
 2534:         &setfilename($asheet,$ENV{'form.ufn'});
 2535:         &tmpread($asheet,$ENV{'form.unewfield'},$ENV{'form.unewformula'});
 2536:     } elsif ($ENV{'form.saveas'}) {
 2537:         &setfilename($asheet,$ENV{'form.ufn'});
 2538:         &tmpread($asheet);
 2539:     } else {
 2540:         &readsheet($asheet,$asheetdata,$ENV{'form.ufn'});
 2541:     }
 2542:     # Print out user information
 2543:     unless ($asheetdata->{'sheettype'} eq 'classcalc') {
 2544:         $r->print('<p><b>User:</b> '.$asheetdata->{'uname'}.
 2545:                   '<br><b>Domain:</b> '.$asheetdata->{'udom'});
 2546: #        if (&getcsec($asheet) eq '-1') {
 2547: #            $r->print('<h3><font color=red>'.
 2548: #                      'Not a student in this course</font></h3>');
 2549: #        } else {
 2550:             $r->print('<br><b>Section/Group:</b> '.$asheetdata->{'csec'});
 2551: #        }
 2552:         if ($ENV{'form.usymb'}) {
 2553:             $r->print('<br><b>Assessment:</b> <tt>'.
 2554:                       $ENV{'form.usymb'}.'</tt>');
 2555:         }
 2556:     }
 2557:     #
 2558:     # Check user permissions
 2559:     if (($asheetdata->{'sheettype'} eq 'classcalc'       ) || 
 2560:         ($asheetdata->{'uname'}     ne $ENV{'user.name'} ) ||
 2561:         ($asheetdata->{'udom'}      ne $ENV{'user.domain'})) {
 2562:         unless (&Apache::lonnet::allowed('vgr',$asheetdata->{'cid'})) {
 2563:             $r->print('<h1>Access Permission Denied</h1>'.
 2564:                       '</form></body></html>');
 2565:             return OK;
 2566:         }
 2567:     }
 2568:     # Additional options
 2569:     $r->print('<br />'.
 2570:               '<input type="submit" name="forcerecalc" '.
 2571:               'value="Completely Recalculate Sheet"><p>');
 2572:     if ($asheetdata->{'sheettype'} eq 'assesscalc') {
 2573:         $r->print('<p><font size=+2>'.
 2574:                   '<a href="/adm/studentcalc?'.
 2575:                   'uname='.$asheetdata->{'uname'}.
 2576:                   '&udom='.$asheetdata->{'udom'}.'">'.
 2577:                   'Level up: Student Sheet</a></font><p>');
 2578:     }
 2579:     if (($asheetdata->{'sheettype'} eq 'studentcalc') && 
 2580:         (&Apache::lonnet::allowed('vgr',$asheetdata->{'cid'}))) {
 2581:         $r->print ('<p><font size=+2><a href="/adm/classcalc">'.
 2582:                    'Level up: Course Sheet</a></font><p>');
 2583:     }
 2584:     # Save dialog
 2585:     if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
 2586:         my $fname=$ENV{'form.ufn'};
 2587:         $fname=~s/\_[^\_]+$//;
 2588:         if ($fname eq 'default') { $fname='course_default'; }
 2589:         $r->print('<input type=submit name=saveas value="Save as ...">'.
 2590:                   '<input type=text size=20 name=newfn value="'.$fname.'">'.
 2591:                   'make default: <input type=checkbox name="makedefufn"><p>');
 2592:     }
 2593:     $r->print(&hiddenfield('ufn',&getfilename($asheet)));
 2594:     # Load dialog
 2595:     if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
 2596:         $r->print('<p><input type=submit name=load value="Load ...">'.
 2597:                   '<select name="loadthissheet">'.
 2598:                   '<option name="default">Default</option>');
 2599:         foreach (&othersheets($asheet,$asheetdata->{'sheettype'})) {
 2600:             $r->print('<option name="'.$_.'"');
 2601:             if ($ENV{'form.ufn'} eq $_) {
 2602:                 $r->print(' selected');
 2603:             }
 2604:             $r->print('>'.$_.'</option>');
 2605:         } 
 2606:         $r->print('</select><p>');
 2607:         if ($asheetdata->{'sheettype'} eq 'studentcalc') {
 2608:             &setothersheets($asheet,&othersheets($asheet,'assesscalc'));
 2609:         }
 2610:     }
 2611:     # Cached sheets
 2612:     &expirationdates();
 2613:     undef %oldsheets;
 2614:     undef %loadedcaches;
 2615:     if ($asheetdata->{'sheettype'} eq 'classcalc') {
 2616:         $r->print("Loading previously calculated student sheets ...\n");
 2617:         $r->rflush();
 2618:         &cachedcsheets();
 2619:     } elsif ($asheetdata->{'sheettype'} eq 'studentcalc') {
 2620:         $r->print("Loading previously calculated assessment sheets ...\n");
 2621:         $r->rflush();
 2622:         &cachedssheets($asheetdata->{'uname'},$asheetdata->{'udom'},
 2623:                        $asheetdata->{'uhome'});
 2624:     }
 2625:     # Update sheet, load rows
 2626:     $r->print("Loaded sheet(s), updating rows ...<br>\n");
 2627:     $r->rflush();
 2628:     #
 2629:     &updatesheet($asheet,$asheetdata);
 2630:     $r->print("Updated rows, loading row data ...\n");
 2631:     $r->rflush();
 2632:     #
 2633:     &loadrows($asheet,$asheetdata,$r);
 2634:     $r->print("Loaded row data, calculating sheet ...<br>\n");
 2635:     $r->rflush();
 2636:     #
 2637:     my $calcoutput=&calcsheet($asheet);
 2638:     $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');
 2639:     # See if something to save
 2640:     if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
 2641:         my $fname='';
 2642:         if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) {
 2643:             $fname=~s/\W/\_/g;
 2644:             if ($fname eq 'default') { $fname='course_default'; }
 2645:             $fname.='_'.$asheetdata->{'sheettype'};
 2646:             &setfilename($asheet,$fname);
 2647:             $ENV{'form.ufn'}=$fname;
 2648:             $r->print('<p>Saving spreadsheet: '.
 2649:                       &writesheet($asheet,$ENV{'form.makedefufn'}).'<p>');
 2650:         }
 2651:     }
 2652:     #
 2653:     #Write the modified worksheet
 2654:     $r->print('<b>Current sheet:</b> '.&getfilename($asheet).'<p>');
 2655:     &tmpwrite($asheet);
 2656:     if ($asheetdata->{'sheettype'} eq 'studentcalc') {
 2657:         $r->print('<br>Show rows with empty A column: ');
 2658:     } else {
 2659:         $r->print('<br>Show empty rows: ');
 2660:     } 
 2661:     #
 2662:     $r->print(&hiddenfield('userselhidden','true').
 2663:               '<input type="checkbox" name="showall" onClick="submit()"');
 2664:     #
 2665:     if ($ENV{'form.showall'}) { 
 2666:         $r->print(' checked'); 
 2667:     } else {
 2668:         unless ($ENV{'form.userselhidden'}) {
 2669:             unless 
 2670:                 ($ENV{'course.'.$ENV{'request.course.id'}.'.hideemptyrows'} eq 'yes') {
 2671:                     $r->print(' checked');
 2672:                     $ENV{'form.showall'}=1;
 2673:                 }
 2674:         }
 2675:     }
 2676:     $r->print('>');
 2677:     #
 2678:     # CSV format checkbox (classcalc sheets only)
 2679:     if ($asheetdata->{'sheettype'} eq 'classcalc') {
 2680:         $r->print(' Output CSV format: <input type="checkbox" '.
 2681:                   'name="showcsv" onClick="submit()"');
 2682:         if ($ENV{'form.showcsv'}) { $r->print(' checked'); }
 2683:         $r->print('>');
 2684:     }
 2685:     #
 2686:     # Buttons to insert rows
 2687:     $r->print('&nbsp;Student Status: '.
 2688:               &Apache::lonhtmlcommon::StatusOptions
 2689:               ($ENV{'form.Status'},'sheet'));
 2690:     $r->print(<<ENDINSERTBUTTONS);
 2691: <br>
 2692: <input type='button' onClick='insertrow("top");' 
 2693: value='Insert Row Top'>
 2694: <input type='button' onClick='insertrow("bottom");' 
 2695: value='Insert Row Bottom'><br>
 2696: ENDINSERTBUTTONS
 2697:     # Print out sheet
 2698:     &outsheet($r,$asheet,$asheetdata);
 2699:     $r->print('</form></body></html>');
 2700:     #  Done
 2701:     return OK;
 2702: }
 2703: 
 2704: 1;
 2705: __END__
 2706: 
 2707: 
 2708: 
 2709: 

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