File:  [LON-CAPA] / loncom / interface / Attic / lonspreadsheet.pm
Revision 1.125: download - view: text, annotated - select for diffs
Thu Oct 24 14:34:07 2002 UTC (21 years, 8 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Added &format_rowlabel.
Changed the calling of &setrowlabels
The row labels are no longer a part of the safe space.
The row labels now have formats that must be respected.  See &format_rowlabel
for the code which acts on them.
A few other minor changes.
There is a bug in here somewhere which causes the assessment sheets to not
have any data in them.  Not for general consumption.

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

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