File:  [LON-CAPA] / loncom / interface / Attic / lonspreadsheet.pm
Revision 1.154: download - view: text, annotated - select for diffs
Wed Dec 4 21:49:33 2002 UTC (21 years, 5 months ago) by matthew
Branches: MAIN
CVS tags: HEAD
Multiple bugfixes.
Correct spreadsheet is now loaded for assessment sheets (not just the default)
Spreadsheet filename is now a part of the rowlabel data for 'symb' rowlabels
    and used by all the format_xxx_rowlabel routines.
The symb, title, and spreadsheet filename are now escaped before being
    stored internally for rowlabels of type 'symb'.
The order assessments were display in the student spreadsheet was borken and
    has now been fixed.
The code marked 'I do not think this works anymore' has been removed as has
    the comment because it was correct.
IMPORTANT CHANGE: Changing the default assessment spreadsheet or the default
    student spreadsheet will now expire all student spreadsheets.  This
    makes our caching work better.

    1: #
    2: # $Id: lonspreadsheet.pm,v 1.154 2002/12/04 21:49:33 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 Apache::Constants qw(:common :http);
   57: use Apache::lonnet;
   58: use Apache::lonhtmlcommon;
   59: use Apache::loncoursedata;
   60: use Apache::File();
   61: use Safe;
   62: use Safe::Hole;
   63: use Opcode;
   64: use GDBM_File;
   65: use HTML::Entities();
   66: use HTML::TokeParser;
   67: use Spreadsheet::WriteExcel;
   68: 
   69: #
   70: # Caches for coursewide information 
   71: #
   72: my %Section;
   73: 
   74: #
   75: # Caches for previously calculated spreadsheets
   76: #
   77: 
   78: my %oldsheets;
   79: my %loadedcaches;
   80: my %expiredates;
   81: 
   82: #
   83: # Cache for stores of an individual user
   84: #
   85: 
   86: my $cachedassess;
   87: my %cachedstores;
   88: 
   89: #
   90: # These cache hashes need to be independent of user, resource and course
   91: # (user and course can/should be in the keys)
   92: #
   93: 
   94: my %spreadsheets;
   95: my %courserdatas;
   96: my %userrdatas;
   97: my %defaultsheets;
   98: my %rowlabel_cache;
   99: 
  100: #
  101: # These global hashes are dependent on user, course and resource, 
  102: # and need to be initialized every time when a sheet is calculated
  103: #
  104: my %courseopt;
  105: my %useropt;
  106: my %parmhash;
  107: 
  108: #
  109: # Some hashes for stats on timing and performance
  110: #
  111: 
  112: my %starttimes;
  113: my %usedtimes;
  114: my %numbertimes;
  115: 
  116: # Stuff that only the screen handler can know
  117: 
  118: my $includedir;
  119: my $tmpdir;
  120: 
  121: # =============================================================================
  122: # ===================================== Implements an instance of a spreadsheet
  123: 
  124: ##
  125: ## mask - used to reside in the safe space.  
  126: ##
  127: sub mask {
  128:     my ($lower,$upper)=@_;
  129:     $upper = $lower if (! defined($upper));
  130:     #
  131:     my ($la,$ld) = ($lower=~/([A-Za-z]|\*)(\d+|\*)/);
  132:     my ($ua,$ud) = ($upper=~/([A-Za-z]|\*)(\d+|\*)/);
  133:     #
  134:     my $alpha='';
  135:     my $num='';
  136:     #
  137:     if (($la eq '*') || ($ua eq '*')) {
  138:         $alpha='[A-Za-z]';
  139:     } else {
  140:        if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) ||
  141:            ($la=~/[a-z]/) && ($ua=~/[a-z]/)) {
  142:           $alpha='['.$la.'-'.$ua.']';
  143:        } else {
  144:           $alpha='['.$la.'-Za-'.$ua.']';
  145:        }
  146:     }   
  147:     if (($ld eq '*') || ($ud eq '*')) {
  148: 	$num='\d+';
  149:     } else {
  150:         if (length($ld)!=length($ud)) {
  151:            $num.='(';
  152: 	   foreach ($ld=~m/\d/g) {
  153:               $num.='['.$_.'-9]';
  154: 	   }
  155:            if (length($ud)-length($ld)>1) {
  156:               $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
  157: 	   }
  158:            $num.='|';
  159:            foreach ($ud=~m/\d/g) {
  160:                $num.='[0-'.$_.']';
  161:            }
  162:            $num.=')';
  163:        } else {
  164:            my @lda=($ld=~m/\d/g);
  165:            my @uda=($ud=~m/\d/g);
  166:            my $i; 
  167:            my $j=0; 
  168:            my $notdone=1;
  169:            for ($i=0;($i<=$#lda)&&($notdone);$i++) {
  170:                if ($lda[$i]==$uda[$i]) {
  171: 		   $num.=$lda[$i];
  172:                    $j=$i;
  173:                } else {
  174:                    $notdone=0;
  175:                }
  176:            }
  177:            if ($j<$#lda-1) {
  178: 	       $num.='('.$lda[$j+1];
  179:                for ($i=$j+2;$i<=$#lda;$i++) {
  180:                    $num.='['.$lda[$i].'-9]';
  181:                }
  182:                if ($uda[$j+1]-$lda[$j+1]>1) {
  183: 		   $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
  184:                    ($#lda-$j-1).'}';
  185:                }
  186: 	       $num.='|'.$uda[$j+1];
  187:                for ($i=$j+2;$i<=$#uda;$i++) {
  188:                    $num.='[0-'.$uda[$i].']';
  189:                }
  190:                $num.=')';
  191:            } else {
  192:                if ($lda[-1]!=$uda[-1]) {
  193:                   $num.='['.$lda[-1].'-'.$uda[-1].']';
  194: 	       }
  195:            }
  196:        }
  197:     }
  198:     return '^'.$alpha.$num."\$";
  199: }
  200: 
  201: sub initsheet {
  202:     my $safeeval = new Safe(shift);
  203:     my $safehole = new Safe::Hole;
  204:     $safeeval->permit("entereval");
  205:     $safeeval->permit(":base_math");
  206:     $safeeval->permit("sort");
  207:     $safeeval->deny(":base_io");
  208:     $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
  209:     $safehole->wrap(\&Apache::lonspreadsheet::mask,$safeeval,'&mask');
  210:     $safeeval->share('$@');
  211:     my $code=<<'ENDDEFS';
  212: # ---------------------------------------------------- Inside of the safe space
  213: 
  214: #
  215: # f: formulas
  216: # t: intermediate format (variable references expanded)
  217: # v: output values
  218: # c: preloaded constants (A-column)
  219: # rl: row label
  220: # os: other spreadsheets (for student spreadsheet only)
  221: 
  222: undef %sheet_values;   # Holds the (computed, final) values for the sheet
  223:     # This is only written to by &calc, the spreadsheet computation routine.
  224:     # It is read by many functions
  225: undef %t; # Holds the values of the spreadsheet temporarily. Set in &sett, 
  226:     # which does the translation of strings like C5 into the value in C5.
  227:     # Used in &calc - %t holds the values that are actually eval'd.
  228: undef %f;    # Holds the formulas for each cell.  This is the users
  229:     # (spreadsheet authors) data for each cell.
  230:     # set by &setformulas and returned by &getformulas
  231:     # &setformulas is called by &readsheet, &tmpread, &updateclasssheet,
  232:     # &updatestudentassesssheet, &loadstudent, &loadcourse
  233:     # &getformulas is called by &writesheet, &tmpwrite, &updateclasssheet,
  234:     # &updatestudentassesssheet, &loadstudent, &loadcourse, &loadassessment, 
  235: undef %c; # Holds the constants for a sheet.  In the assessment
  236:     # sheets, this is the A column.  Used in &MINPARM, &MAXPARM, &expandnamed,
  237:     # &sett, and &setconstants.  There is no &getconstants.
  238:     # &setconstants is called by &loadstudent, &loadcourse, &load assessment,
  239: undef @os;  # Holds the names of other spreadsheets - this is used to specify
  240:     # the spreadsheets that are available for the assessment sheet.
  241:     # Set by &setothersheets.  &setothersheets is called by &handler.  A
  242:     # related subroutine is &othersheets.
  243: #$errorlog = '';
  244: 
  245: $maxrow = 0;
  246: $sheettype = '';
  247: 
  248: # filename/reference of the sheet
  249: $filename = '';
  250: 
  251: # user data
  252: $uname = '';
  253: $uhome = '';
  254: $udom  = '';
  255: 
  256: # course data
  257: 
  258: $csec = '';
  259: $chome= '';
  260: $cnum = '';
  261: $cdom = '';
  262: $cid  = '';
  263: $coursefilename  = '';
  264: 
  265: # symb
  266: 
  267: $usymb = '';
  268: 
  269: # error messages
  270: $errormsg = '';
  271: 
  272: 
  273: #-------------------------------------------------------
  274: 
  275: =item UWCALC(hashname,modules,units,date) 
  276: 
  277: returns the proportion of the module 
  278: weights not previously completed by the student.
  279: 
  280: =over 4
  281: 
  282: =item hashname 
  283: 
  284: name of the hash the module dates have been inserted into
  285: 
  286: =item modules 
  287: 
  288: reference to a cell which contains a comma deliminated list of modules 
  289: covered by the assignment.
  290: 
  291: =item units 
  292: 
  293: reference to a cell which contains a comma deliminated list of module 
  294: weights with respect to the assignment
  295: 
  296: =item date 
  297: 
  298: reference to a cell which contains the date the assignment was completed.
  299: 
  300: =back 
  301: 
  302: =cut
  303: 
  304: #-------------------------------------------------------
  305: sub UWCALC {
  306:     my ($hashname,$modules,$units,$date) = @_;
  307:     my @Modules = split(/,/,$modules);
  308:     my @Units   = split(/,/,$units);
  309:     my $total_weight;
  310:     foreach (@Units) {
  311: 	$total_weight += $_;
  312:     }
  313:     my $usum=0;
  314:     for (my $i=0; $i<=$#Modules; $i++) {
  315: 	if (&HASH($hashname,$Modules[$i]) eq $date) {
  316: 	    $usum += $Units[$i];
  317: 	}
  318:     }
  319:     return $usum/$total_weight;
  320: }
  321: 
  322: #-------------------------------------------------------
  323: 
  324: =item CDLSUM(list) 
  325: 
  326: returns the sum of the elements in a cell which contains
  327: a Comma Deliminate List of numerical values.
  328: 'list' is a reference to a cell which contains a comma deliminated list.
  329: 
  330: =cut
  331: 
  332: #-------------------------------------------------------
  333: sub CDLSUM {
  334:     my ($list)=@_;
  335:     my $sum;
  336:     foreach (split/,/,$list) {
  337: 	$sum += $_;
  338:     }
  339:     return $sum;
  340: }
  341: 
  342: #-------------------------------------------------------
  343: 
  344: =item CDLITEM(list,index) 
  345: 
  346: returns the item at 'index' in a Comma Deliminated List.
  347: 
  348: =over 4
  349: 
  350: =item list
  351: 
  352: reference to a cell which contains a comma deliminated list.
  353: 
  354: =item index 
  355: 
  356: the Perl index of the item requested (first element in list has
  357: an index of 0) 
  358: 
  359: =back
  360: 
  361: =cut
  362: 
  363: #-------------------------------------------------------
  364: sub CDLITEM {
  365:     my ($list,$index)=@_;
  366:     my @Temp = split/,/,$list;
  367:     return $Temp[$index];
  368: }
  369: 
  370: #-------------------------------------------------------
  371: 
  372: =item CDLHASH(name,key,value) 
  373: 
  374: loads a comma deliminated list of keys into
  375: the hash 'name', all with a value of 'value'.
  376: 
  377: =over 4
  378: 
  379: =item name  
  380: 
  381: name of the hash.
  382: 
  383: =item key
  384: 
  385: (a pointer to) a comma deliminated list of keys.
  386: 
  387: =item value
  388: 
  389: a single value to be entered for each key.
  390: 
  391: =back
  392: 
  393: =cut
  394: 
  395: #-------------------------------------------------------
  396: sub CDLHASH {
  397:     my ($name,$key,$value)=@_;
  398:     my @Keys;
  399:     my @Values;
  400:     # Check to see if we have multiple $key values
  401:     if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
  402: 	my $keymask = &mask($key);
  403: 	# Assume the keys are addresses
  404: 	my @Temp = grep /$keymask/,keys(%sheet_values);
  405: 	@Keys = $sheet_values{@Temp};
  406:     } else {
  407: 	$Keys[0]= $key;
  408:     }
  409:     my @Temp;
  410:     foreach $key (@Keys) {
  411: 	@Temp = (@Temp, split/,/,$key);
  412:     }
  413:     @Keys = @Temp;
  414:     if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
  415: 	my $valmask = &mask($value);
  416: 	my @Temp = grep /$valmask/,keys(%sheet_values);
  417: 	@Values =$sheet_values{@Temp};
  418:     } else {
  419: 	$Values[0]= $value;
  420:     }
  421:     $value = $Values[0];
  422:     # Add values to hash
  423:     for (my $i = 0; $i<=$#Keys; $i++) {
  424: 	my $key   = $Keys[$i];
  425: 	if (! exists ($hashes{$name}->{$key})) {
  426: 	    $hashes{$name}->{$key}->[0]=$value;
  427: 	} else {
  428: 	    my @Temp = sort(@{$hashes{$name}->{$key}},$value);
  429: 	    $hashes{$name}->{$key} = \@Temp;
  430: 	}
  431:     }
  432:     return "hash '$name' updated";
  433: }
  434: 
  435: #-------------------------------------------------------
  436: 
  437: =item GETHASH(name,key,index) 
  438: 
  439: returns the element in hash 'name' 
  440: reference by the key 'key', at index 'index' in the values list.
  441: 
  442: =cut
  443: 
  444: #-------------------------------------------------------
  445: sub GETHASH {
  446:     my ($name,$key,$index)=@_;
  447:     if (! defined($index)) {
  448: 	$index = 0;
  449:     }
  450:     if ($key =~ /^[A-z]\d+$/) {
  451: 	$key = $sheet_values{$key};
  452:     }
  453:     return $hashes{$name}->{$key}->[$index];
  454: }
  455: 
  456: #-------------------------------------------------------
  457: 
  458: =item CLEARHASH(name) 
  459: 
  460: clears all the values from the hash 'name'
  461: 
  462: =item CLEARHASH(name,key) 
  463: 
  464: clears all the values from the hash 'name' associated with the given key.
  465: 
  466: =cut
  467: 
  468: #-------------------------------------------------------
  469: sub CLEARHASH {
  470:     my ($name,$key)=@_;
  471:     if (defined($key)) {
  472: 	if (exists($hashes{$name}->{$key})) {
  473: 	    $hashes{$name}->{$key}=undef;
  474: 	    return "hash '$name' key '$key' cleared";
  475: 	}
  476:     } else {
  477: 	if (exists($hashes{$name})) {
  478: 	    $hashes{$name}=undef;
  479: 	    return "hash '$name' cleared";
  480: 	}
  481:     }
  482:     return "Error in clearing hash";
  483: }
  484: 
  485: #-------------------------------------------------------
  486: 
  487: =item HASH(name,key,value) 
  488: 
  489: loads values into an internal hash.  If a key 
  490: already has a value associated with it, the values are sorted numerically.  
  491: 
  492: =item HASH(name,key) 
  493: 
  494: returns the 0th value in the hash 'name' associated with 'key'.
  495: 
  496: =cut
  497: 
  498: #-------------------------------------------------------
  499: sub HASH {
  500:     my ($name,$key,$value)=@_;
  501:     my @Keys;
  502:     undef @Keys;
  503:     my @Values;
  504:     # Check to see if we have multiple $key values
  505:     if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
  506: 	my $keymask = &mask($key);
  507: 	# Assume the keys are addresses
  508: 	my @Temp = grep /$keymask/,keys(%sheet_values);
  509: 	@Keys = $sheet_values{@Temp};
  510:     } else {
  511: 	$Keys[0]= $key;
  512:     }
  513:     # If $value is empty, return the first value associated 
  514:     # with the first key.
  515:     if (! $value) {
  516: 	return $hashes{$name}->{$Keys[0]}->[0];
  517:     }
  518:     # Check to see if we have multiple $value(s) 
  519:     if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) {
  520: 	my $valmask = &mask($value);
  521: 	my @Temp = grep /$valmask/,keys(%sheet_values);
  522: 	@Values =$sheet_values{@Temp};
  523:     } else {
  524: 	$Values[0]= $value;
  525:     }
  526:     # Add values to hash
  527:     for (my $i = 0; $i<=$#Keys; $i++) {
  528: 	my $key   = $Keys[$i];
  529: 	my $value = ($i<=$#Values ? $Values[$i] : $Values[0]);
  530: 	if (! exists ($hashes{$name}->{$key})) {
  531: 	    $hashes{$name}->{$key}->[0]=$value;
  532: 	} else {
  533: 	    my @Temp = sort(@{$hashes{$name}->{$key}},$value);
  534: 	    $hashes{$name}->{$key} = \@Temp;
  535: 	}
  536:     }
  537:     return $Values[-1];
  538: }
  539: 
  540: #-------------------------------------------------------
  541: 
  542: =item NUM(range)
  543: 
  544: returns the number of items in the range.
  545: 
  546: =cut
  547: 
  548: #-------------------------------------------------------
  549: sub NUM {
  550:     my $mask=mask(@_);
  551:     my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1;
  552:     return $num;   
  553: }
  554: 
  555: sub BIN {
  556:     my ($low,$high,$lower,$upper)=@_;
  557:     my $mask=mask($lower,$upper);
  558:     my $num=0;
  559:     foreach (grep /$mask/,keys(%sheet_values)) {
  560:         if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {
  561:             $num++;
  562:         }
  563:     }
  564:     return $num;   
  565: }
  566: 
  567: 
  568: #-------------------------------------------------------
  569: 
  570: =item SUM(range)
  571: 
  572: returns the sum of items in the range.
  573: 
  574: =cut
  575: 
  576: #-------------------------------------------------------
  577: sub SUM {
  578:     my $mask=mask(@_);
  579:     my $sum=0;
  580:     foreach (grep /$mask/,keys(%sheet_values)) {
  581:         $sum+=$sheet_values{$_};
  582:     }
  583:     return $sum;   
  584: }
  585: 
  586: #-------------------------------------------------------
  587: 
  588: =item MEAN(range)
  589: 
  590: compute the average of the items in the range.
  591: 
  592: =cut
  593: 
  594: #-------------------------------------------------------
  595: sub MEAN {
  596:     my $mask=mask(@_);
  597:     my $sum=0; 
  598:     my $num=0;
  599:     foreach (grep /$mask/,keys(%sheet_values)) {
  600:         $sum+=$sheet_values{$_};
  601:         $num++;
  602:     }
  603:     if ($num) {
  604:        return $sum/$num;
  605:     } else {
  606:        return undef;
  607:     }   
  608: }
  609: 
  610: #-------------------------------------------------------
  611: 
  612: =item STDDEV(range)
  613: 
  614: compute the standard deviation of the items in the range.
  615: 
  616: =cut
  617: 
  618: #-------------------------------------------------------
  619: sub STDDEV {
  620:     my $mask=mask(@_);
  621:     my $sum=0; my $num=0;
  622:     foreach (grep /$mask/,keys(%sheet_values)) {
  623:         $sum+=$sheet_values{$_};
  624:         $num++;
  625:     }
  626:     unless ($num>1) { return undef; }
  627:     my $mean=$sum/$num;
  628:     $sum=0;
  629:     foreach (grep /$mask/,keys(%sheet_values)) {
  630:         $sum+=($sheet_values{$_}-$mean)**2;
  631:     }
  632:     return sqrt($sum/($num-1));    
  633: }
  634: 
  635: #-------------------------------------------------------
  636: 
  637: =item PROD(range)
  638: 
  639: compute the product of the items in the range.
  640: 
  641: =cut
  642: 
  643: #-------------------------------------------------------
  644: sub PROD {
  645:     my $mask=mask(@_);
  646:     my $prod=1;
  647:     foreach (grep /$mask/,keys(%sheet_values)) {
  648:         $prod*=$sheet_values{$_};
  649:     }
  650:     return $prod;   
  651: }
  652: 
  653: #-------------------------------------------------------
  654: 
  655: =item MAX(range)
  656: 
  657: compute the maximum of the items in the range.
  658: 
  659: =cut
  660: 
  661: #-------------------------------------------------------
  662: sub MAX {
  663:     my $mask=mask(@_);
  664:     my $max='-';
  665:     foreach (grep /$mask/,keys(%sheet_values)) {
  666:         unless ($max) { $max=$sheet_values{$_}; }
  667:         if (($sheet_values{$_}>$max) || ($max eq '-')) { $max=$sheet_values{$_}; }
  668:     } 
  669:     return $max;   
  670: }
  671: 
  672: #-------------------------------------------------------
  673: 
  674: =item MIN(range)
  675: 
  676: compute the minimum of the items in the range.
  677: 
  678: =cut
  679: 
  680: #-------------------------------------------------------
  681: sub MIN {
  682:     my $mask=mask(@_);
  683:     my $min='-';
  684:     foreach (grep /$mask/,keys(%sheet_values)) {
  685:         unless ($max) { $max=$sheet_values{$_}; }
  686:         if (($sheet_values{$_}<$min) || ($min eq '-')) { 
  687:             $min=$sheet_values{$_}; 
  688:         }
  689:     }
  690:     return $min;   
  691: }
  692: 
  693: #-------------------------------------------------------
  694: 
  695: =item SUMMAX(num,lower,upper)
  696: 
  697: compute the sum of the largest 'num' items in the range from
  698: 'lower' to 'upper'
  699: 
  700: =cut
  701: 
  702: #-------------------------------------------------------
  703: sub SUMMAX {
  704:     my ($num,$lower,$upper)=@_;
  705:     my $mask=mask($lower,$upper);
  706:     my @inside=();
  707:     foreach (grep /$mask/,keys(%sheet_values)) {
  708: 	push (@inside,$sheet_values{$_});
  709:     }
  710:     @inside=sort(@inside);
  711:     my $sum=0; my $i;
  712:     for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { 
  713:         $sum+=$inside[$i];
  714:     }
  715:     return $sum;   
  716: }
  717: 
  718: #-------------------------------------------------------
  719: 
  720: =item SUMMIN(num,lower,upper)
  721: 
  722: compute the sum of the smallest 'num' items in the range from
  723: 'lower' to 'upper'
  724: 
  725: =cut
  726: 
  727: #-------------------------------------------------------
  728: sub SUMMIN {
  729:     my ($num,$lower,$upper)=@_;
  730:     my $mask=mask($lower,$upper);
  731:     my @inside=();
  732:     foreach (grep /$mask/,keys(%sheet_values)) {
  733: 	$inside[$#inside+1]=$sheet_values{$_};
  734:     }
  735:     @inside=sort(@inside);
  736:     my $sum=0; my $i;
  737:     for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { 
  738:         $sum+=$inside[$i];
  739:     }
  740:     return $sum;   
  741: }
  742: 
  743: #-------------------------------------------------------
  744: 
  745: =item MINPARM(parametername)
  746: 
  747: Returns the minimum value of the parameters matching the parametername.
  748: parametername should be a string such as 'duedate'.
  749: 
  750: =cut
  751: 
  752: #-------------------------------------------------------
  753: sub MINPARM {
  754:     my ($expression) = @_;
  755:     my $min = undef;
  756:     study($expression);
  757:     foreach $parameter (keys(%c)) {
  758:         next if ($parameter !~ /$expression/);
  759:         if ((! defined($min)) || ($min > $c{$parameter})) {
  760:             $min = $c{$parameter} 
  761:         }
  762:     }
  763:     return $min;
  764: }
  765: 
  766: #-------------------------------------------------------
  767: 
  768: =item MAXPARM(parametername)
  769: 
  770: Returns the maximum value of the parameters matching the input parameter name.
  771: parametername should be a string such as 'duedate'.
  772: 
  773: =cut
  774: 
  775: #-------------------------------------------------------
  776: sub MAXPARM {
  777:     my ($expression) = @_;
  778:     my $max = undef;
  779:     study($expression);
  780:     foreach $parameter (keys(%c)) {
  781:         next if ($parameter !~ /$expression/);
  782:         if ((! defined($min)) || ($max < $c{$parameter})) {
  783:             $max = $c{$parameter} 
  784:         }
  785:     }
  786:     return $max;
  787: }
  788: 
  789: #--------------------------------------------------------
  790: sub expandnamed {
  791:     my $expression=shift;
  792:     if ($expression=~/^\&/) {
  793: 	my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/);
  794: 	my @vars=split(/\W+/,$formula);
  795:         my %values=();
  796:         undef %values;
  797: 	foreach ( @vars ) {
  798:             my $varname=$_;
  799:             if ($varname=~/\D/) {
  800:                $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;
  801:                $varname=~s/$var/\(\\w\+\)/g;
  802: 	       foreach (keys(%c)) {
  803: 		  if ($_=~/$varname/) {
  804: 		      $values{$1}=1;
  805:                   }
  806:                }
  807: 	    }
  808:         }
  809:         if ($func eq 'EXPANDSUM') {
  810:             my $result='';
  811: 	    foreach (keys(%values)) {
  812:                 my $thissum=$formula;
  813:                 $thissum=~s/$var/$_/g;
  814:                 $result.=$thissum.'+';
  815:             } 
  816:             $result=~s/\+$//;
  817:             return $result;
  818:         } else {
  819: 	    return 0;
  820:         }
  821:     } else {
  822:         # it is not a function, so it is a parameter name
  823:         # We should do the following:
  824:         #    1. Take the list of parameter names
  825:         #    2. look through the list for ones that match the parameter we want
  826:         #    3. If there are no collisions, return the one that matches
  827:         #    4. If there is a collision, return 'bad parameter name error'
  828:         my $returnvalue = '';
  829:         my @matches = ();
  830:         $#matches = -1;
  831:         study $expression;
  832:         foreach $parameter (keys(%c)) {
  833:             push @matches,$parameter if ($parameter =~ /$expression/);
  834:         }
  835:         if (scalar(@matches) == 0) {
  836:             $returnvalue = 'unmatched parameter: '.$parameter;
  837:         } elsif (scalar(@matches) == 1) {
  838:             $returnvalue = '$c{\''.$matches[0].'\'}';
  839:         } elsif (scalar(@matches) > 0) {
  840:             # more than one match.  Look for a concise one
  841:             $returnvalue =  "'non-unique parameter name : $expression'";
  842:             foreach (@matches) {
  843:                 if (/^$expression$/) {
  844:                     $returnvalue = '$c{\''.$_.'\'}';
  845:                 }
  846:             }
  847:         } else {
  848:             # There was a negative number of matches, which indicates 
  849:             # something is wrong with reality.  Better warn the user.
  850:             $returnvalue = 'bizzare parameter: '.$parameter;
  851:         }
  852:         return $returnvalue;
  853:     }
  854: }
  855: 
  856: sub sett {
  857:     %t=();
  858:     my $pattern='';
  859:     if ($sheettype eq 'assesscalc') {
  860: 	$pattern='A';
  861:     } else {
  862:         $pattern='[A-Z]';
  863:     }
  864:     # Deal with the template row
  865:     foreach (keys(%f)) {
  866: 	next if ($_!~/template\_(\w)/);
  867:         my $col=$1;
  868:         next if ($col=~/^$pattern/);
  869:         foreach (keys(%f)) {
  870:             next if ($_!~/A(\d+)/);
  871:             my $trow=$1;
  872:             next if (! $trow);
  873:             # Get the name of this cell
  874:             my $lb=$col.$trow;
  875:             # Grab the template declaration
  876:             $t{$lb}=$f{'template_'.$col};
  877:             # Replace '#' with the row number
  878:             $t{$lb}=~s/\#/$trow/g;
  879:             # Replace '....' with ','
  880:             $t{$lb}=~s/\.\.+/\,/g;
  881:             # Replace 'A0' with the value from 'A0'
  882:             $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
  883:             # Replace parameters
  884:             $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
  885:         }
  886:     }
  887:     # Deal with the normal cells
  888:     foreach (keys(%f)) {
  889: 	if (exists($f{$_}) && ($_!~/template\_/)) {
  890:             my $matches=($_=~/^$pattern(\d+)/);
  891:             if  (($matches) && ($1)) {
  892: 	        unless ($f{$_}=~/^\!/) {
  893: 		    $t{$_}=$c{$_};
  894:                 }
  895:             } else {
  896: 	       $t{$_}=$f{$_};
  897:                $t{$_}=~s/\.\.+/\,/g;
  898:                $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
  899:                $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
  900:             }
  901:         }
  902:     }
  903:     # For inserted lines, [B-Z] is also valid
  904:     unless ($sheettype eq 'assesscalc') {
  905:        foreach (keys(%f)) {
  906: 	   if ($_=~/[B-Z](\d+)/) {
  907: 	       if ($f{'A'.$1}=~/^[\~\-]/) {
  908:   	          $t{$_}=$f{$_};
  909:                   $t{$_}=~s/\.\.+/\,/g;
  910:                   $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
  911:                   $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
  912:                }
  913:            }
  914:        }
  915:     }
  916:     # For some reason 'A0' gets special treatment...  This seems superfluous
  917:     # but I imagine it is here for a reason.
  918:     $t{'A0'}=$f{'A0'};
  919:     $t{'A0'}=~s/\.\.+/\,/g;
  920:     $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
  921:     $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
  922: }
  923: 
  924: sub calc {
  925:     undef %sheet_values;
  926:     &sett();
  927:     my $notfinished=1;
  928:     my $lastcalc='';
  929:     my $depth=0;
  930:     while ($notfinished) {
  931: 	$notfinished=0;
  932:         foreach (keys(%t)) {
  933:             #$errorlog .= "$_:".$t{$_};
  934:             my $old=$sheet_values{$_};
  935:             $sheet_values{$_}=eval $t{$_};
  936: 	    if ($@) {
  937: 		undef %sheet_values;
  938:                 return $_.': '.$@;
  939:             }
  940: 	    if ($sheet_values{$_} ne $old) { $notfinished=1; $lastcalc=$_; }
  941:             #$errorlog .= ":".$sheet_values{$_}."\n";
  942:         }
  943:         $depth++;
  944:         if ($depth>100) {
  945: 	    undef %sheet_values;
  946:             return $lastcalc.': Maximum calculation depth exceeded';
  947:         }
  948:     }
  949:     return '';
  950: }
  951: 
  952: # ------------------------------------------- End of "Inside of the safe space"
  953: ENDDEFS
  954:     $safeeval->reval($code);
  955:     return $safeeval;
  956: }
  957: 
  958: #
  959: # 
  960: #
  961: sub templaterow {
  962:     my $sheet = shift;
  963:     my @cols=();
  964:     my $rowlabel = 'Template';
  965:     foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
  966: 	     'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
  967: 	     'a','b','c','d','e','f','g','h','i','j','k','l','m',
  968: 	     'n','o','p','q','r','s','t','u','v','w','x','y','z') {
  969:         push(@cols,{ name    => 'template_'.$_,
  970:                      formula => $sheet->{'f'}->{'template_'.$_},
  971:                      value   => $sheet->{'f'}->{'template_'.$_} });
  972:     }
  973:     return ($rowlabel,@cols);
  974: }
  975: 
  976: sub outrowassess {
  977:     # $n is the current row number
  978:     my ($sheet,$n) = @_;
  979:     my @cols=();
  980:     my $rowlabel='';
  981:     if ($n) {
  982:         my ($usy,$ufn)=split(/__&&&\__/,$sheet->{'f'}->{'A'.$n});
  983:         if (exists($sheet->{'rowlabel'}->{$usy})) {
  984:             # This is dumb, but we need the information when we output
  985:             # the html version of the studentcalc spreadsheet for the
  986:             # links to the assesscalc sheets.
  987:             $rowlabel = $sheet->{'rowlabel'}->{$usy}.':'.
  988:                 &Apache::lonnet::escape($ufn);
  989:         } else { 
  990:             $rowlabel = '';
  991:         }
  992:     } else {
  993:         $rowlabel = 'Export';
  994:     }
  995:     foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
  996: 	     'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
  997: 	     'a','b','c','d','e','f','g','h','i','j','k','l','m',
  998: 	     'n','o','p','q','r','s','t','u','v','w','x','y','z') {
  999:         push(@cols,{ name    => $_.$n,
 1000:                      formula => $sheet->{'f'}->{$_.$n},
 1001:                      value   => $sheet->{'values'}->{$_.$n}});
 1002:     }
 1003:     return ($rowlabel,@cols);
 1004: }
 1005: 
 1006: sub outrow {
 1007:     my ($sheet,$n)=@_;
 1008:     my @cols=();
 1009:     my $rowlabel;
 1010:     if ($n) {
 1011:         $rowlabel = $sheet->{'rowlabel'}->{$sheet->{'f'}->{'A'.$n}};
 1012:     } else {
 1013:         if ($sheet->{'sheettype'} eq 'classcalc') {
 1014:             $rowlabel = 'Summary';
 1015:         } else {
 1016:             $rowlabel = 'Export';
 1017:         }
 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:         push(@cols,{ name    => $_.$n,
 1024:                      formula => $sheet->{'f'}->{$_.$n},
 1025:                      value   => $sheet->{'values'}->{$_.$n}});
 1026:     }
 1027:     return ($rowlabel,@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:     return %{$sheet->{'safe'}->varglob('c')}=%{$sheet->{'constants'}};
 1046: }
 1047: 
 1048: # --------------------------------------------- Set names of other spreadsheets
 1049: sub setothersheets {
 1050:     my $sheet = shift;
 1051:     my @othersheets = @_;
 1052:     $sheet->{'othersheets'} = \@othersheets;
 1053:     @{$sheet->{'safe'}->varglob('os')}=@othersheets;
 1054:     return;
 1055: }
 1056: 
 1057: # ------------------------------------------------ Add or change formula values
 1058: sub setrowlabels {
 1059:     my $sheet=shift;
 1060:     my ($rowlabel) = @_;
 1061:     if (! ref($rowlabel)) {
 1062:         my %tmp = @_;
 1063:         $rowlabel = \%tmp;
 1064:     }
 1065:     $sheet->{'rowlabel'}=$rowlabel;
 1066: }
 1067: 
 1068: # ------------------------------------------------------- Calculate spreadsheet
 1069: sub calcsheet {
 1070:     my $sheet=shift;
 1071:     my $result =  $sheet->{'safe'}->reval('&calc();');
 1072:     %{$sheet->{'values'}} = %{$sheet->{'safe'}->varglob('sheet_values')};
 1073:     return $result;
 1074: }
 1075: 
 1076: # ---------------------------------------------------------------- Get formulas
 1077: # Return a copy of the formulas
 1078: sub getformulas {
 1079:     my $sheet = shift;
 1080:     return %{$sheet->{'safe'}->varglob('f')};
 1081: }
 1082: 
 1083: sub geterrorlog {
 1084:     my $sheet = shift;
 1085:     return ${$sheet->{'safe'}->varglob('errorlog')};    
 1086: }
 1087: 
 1088: sub gettitle {
 1089:     my $sheet = shift;
 1090:     if ($sheet->{'sheettype'} eq 'classcalc') {
 1091:         return $sheet->{'coursedesc'};
 1092:     } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
 1093:         return 'Grades for '.$sheet->{'uname'}.'@'.$sheet->{'udom'};
 1094:     } elsif ($sheet->{'sheettype'} eq 'assesscalc') {
 1095:         if (($sheet->{'usymb'} eq '_feedback') ||
 1096:             ($sheet->{'usymb'} eq '_evaluation') ||
 1097:             ($sheet->{'usymb'} eq '_discussion') ||
 1098:             ($sheet->{'usymb'} eq '_tutoring')) {
 1099:             my $title = $sheet->{'usymb'};
 1100:             $title =~ s/^_//;
 1101:             $title = ucfirst($title);
 1102:             return $title;
 1103:         }
 1104:         return if (! defined($sheet->{'mapid'}) || 
 1105:                    $sheet->{'mapid'} !~ /^\d+$/);
 1106:         my $mapid = $sheet->{'mapid'};
 1107:         return if (! defined($sheet->{'resid'}) || 
 1108:                    $sheet->{'resid'} !~ /^\d+$/);
 1109:         my $resid = $sheet->{'resid'};
 1110:         my %course_db;
 1111:         tie(%course_db,'GDBM_File',$sheet->{'coursefilename'}.'.db',
 1112:             &GDBM_READER(),0640);
 1113:         return if (! tied(%course_db));
 1114:         my $key = 'title_'.$mapid.'.'.$resid;
 1115:         my $title = '';
 1116:         if (exists($course_db{$key})) {
 1117:             $title = $course_db{$key};
 1118:         } else {
 1119:             $title = $sheet->{'usymb'};
 1120:         }
 1121:         untie (%course_db);
 1122:         return $title;
 1123:     }
 1124: }
 1125: 
 1126: # ----------------------------------------------------- Get value of $f{'A'.$n}
 1127: sub getfa {
 1128:     my $sheet = shift;
 1129:     my ($n)=@_;
 1130:     return $sheet->{'safe'}->reval('$f{"A'.$n.'"}');
 1131: }
 1132: 
 1133: # ------------------------------------------------------------- Export of A-row
 1134: sub exportdata {
 1135:     my $sheet=shift;
 1136:     my @exportarray=();
 1137:     foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
 1138: 	     'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
 1139:         if (exists($sheet->{'values'}->{$_.'0'})) {
 1140:             push(@exportarray,$sheet->{'values'}->{$_.'0'});
 1141:         } else {
 1142:             push(@exportarray,'');
 1143:         }
 1144:     } 
 1145:     return @exportarray;
 1146: }
 1147: 
 1148: 
 1149: 
 1150: sub update_student_sheet{
 1151:     my ($sheet,$r,$c) = @_;
 1152:     # Load in the studentcalc sheet
 1153:     &readsheet($sheet,'default_studentcalc');
 1154:     # Determine the structure (contained assessments, etc) of the sheet
 1155:     &updatesheet($sheet);
 1156:     # Load in the cached sheets for this student
 1157:     &cachedssheets($sheet);
 1158:     # Load in the (possibly cached) data from the assessment sheets        
 1159:     &loadstudent($sheet,$r,$c);
 1160:     # Compute the sheet
 1161:     &calcsheet($sheet);
 1162: }
 1163: 
 1164: # ========================================================== End of Spreadsheet
 1165: # =============================================================================
 1166: #
 1167: # Procedures for spreadsheet output
 1168: #
 1169: # --------------------------------------------- Produce output row n from sheet
 1170: 
 1171: sub get_row {
 1172:     my ($sheet,$n) = @_;
 1173:     my ($rowlabel,@rowdata);
 1174:     if ($n eq '-') { 
 1175:         ($rowlabel,@rowdata) = &templaterow($sheet);
 1176:     } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
 1177:         ($rowlabel,@rowdata) = &outrowassess($sheet,$n);
 1178:     } else {
 1179:         ($rowlabel,@rowdata) = &outrow($sheet,$n);
 1180:     }
 1181:     return ($rowlabel,@rowdata);
 1182: }
 1183: 
 1184: ########################################################################
 1185: ########################################################################
 1186: sub sort_indicies {
 1187:     my $sheet = shift;
 1188:     my @sortidx=();
 1189:     #
 1190:     if ($sheet->{'sheettype'} eq 'classcalc') {
 1191:         my @sortby=(undef);
 1192:         # Skip row 0
 1193:         for (my $row=1;$row<=$sheet->{'maxrow'};$row++) {
 1194:             my (undef,$sname,$sdom,$fullname,$section,$id) = 
 1195:                 split(':',$sheet->{'rowlabel'}->{$sheet->{'f'}->{'A'.$row}});
 1196:             push (@sortby, lc($fullname));
 1197:             push (@sortidx, $row);
 1198:         }
 1199:         @sortidx = sort { $sortby[$a] cmp $sortby[$b]; } @sortidx;
 1200:     } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
 1201:         my @sortby1=(undef);
 1202:         my @sortby2=(undef);
 1203:         # Skip row 0
 1204:         for (my $row=1;$row<=$sheet->{'maxrow'};$row++) {
 1205:             my ($key,undef) = split(/__&&&\__/,$sheet->{'f'}->{'A'.$row});
 1206:             my $rowlabel = $sheet->{'rowlabel'}->{$key};
 1207:             my (undef,$symb,$mapid,$resid,$title,$ufn) = 
 1208:                 split(':',$rowlabel);
 1209:             $ufn   = &Apache::lonnet::unescape($ufn);
 1210:             $symb  = &Apache::lonnet::unescape($symb);
 1211:             $title = &Apache::lonnet::unescape($title);
 1212:             my ($sequence) = ($symb =~ /\/([^\/]*\.sequence)/);
 1213:             if ($sequence eq '') {
 1214:                 $sequence = $symb;
 1215:             }
 1216:             push (@sortby1, $sequence);
 1217:             push (@sortby2, $title);
 1218:             push (@sortidx, $row);
 1219:         }
 1220:         @sortidx = sort { $sortby1[$a] cmp $sortby1[$b] || 
 1221:                               $sortby2[$a] cmp $sortby2[$b] } @sortidx;
 1222:     } else {
 1223:         my @sortby=(undef);
 1224:         # Skip row 0
 1225:         for (my $row=1;$row<=$sheet->{'maxrow'};$row++) {
 1226:             push (@sortby, $sheet->{'safe'}->reval('$f{"A'.$row.'"}'));
 1227:             push (@sortidx, $row);
 1228:         }
 1229:         @sortidx = sort { $sortby[$a] cmp $sortby[$b]; } @sortidx;
 1230:     }
 1231:     return @sortidx;
 1232: }
 1233: 
 1234: #############################################################
 1235: ###                                                       ###
 1236: ###              Spreadsheet Output Routines              ###
 1237: ###                                                       ###
 1238: #############################################################
 1239: 
 1240: ############################################
 1241: ##         HTML output routines           ##
 1242: ############################################
 1243: sub html_editable_cell {
 1244:     my ($cell,$bgcolor) = @_;
 1245:     my $result;
 1246:     my ($name,$formula,$value);
 1247:     if (defined($cell)) {
 1248:         $name    = $cell->{'name'};
 1249:         $formula = $cell->{'formula'};
 1250:         $value   = $cell->{'value'};
 1251:     }
 1252:     $name    = '' if (! defined($name));
 1253:     $formula = '' if (! defined($formula));
 1254:     if (! defined($value)) {
 1255:         $value = '<font color="'.$bgcolor.'">#</font>';
 1256:         if ($formula ne '') {
 1257:             $value = '<i>undefined value</i>';
 1258:         }
 1259:     } elsif ($value =~ /^\s*$/ ) {
 1260:         $value = '<font color="'.$bgcolor.'">#</font>';
 1261:     } else {
 1262:         $value = &HTML::Entities::encode($value);
 1263:     }
 1264:     # Make the formula safe for outputting
 1265:     $formula =~ s/\'/\"/g;
 1266:     # The formula will be parsed by the browser *twice* before being 
 1267:     # displayed to the user for editing.
 1268:     $formula = &HTML::Entities::encode(&HTML::Entities::encode($formula));
 1269:     # Escape newlines so they make it into the edit window
 1270:     $formula =~ s/\n/\\n/gs;
 1271:     # Glue everything together
 1272:     $result .= "<a href=\"javascript:celledit(\'".
 1273:         $name."','".$formula."');\">".$value."</a>";
 1274:     return $result;
 1275: }
 1276: 
 1277: sub html_uneditable_cell {
 1278:     my ($cell,$bgcolor) = @_;
 1279:     my $value = (defined($cell) ? $cell->{'value'} : '');
 1280:     $value = &HTML::Entities::encode($value);
 1281:     return '&nbsp;'.$value.'&nbsp;';
 1282: }
 1283: 
 1284: sub outsheet_html  {
 1285:     my ($sheet,$r) = @_;
 1286:     my ($num_uneditable,$realm,$row_type);
 1287:     if ($sheet->{'sheettype'} eq 'assesscalc') {
 1288:         $num_uneditable = 1;
 1289:         $realm = 'Assessment';
 1290:         $row_type = 'Item';
 1291:     } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
 1292:         $num_uneditable = 26;
 1293:         $realm = 'User';
 1294:         $row_type = 'Assessment';
 1295:     } elsif ($sheet->{'sheettype'} eq 'classcalc') {
 1296:         $num_uneditable = 26;
 1297:         $realm = 'Course';
 1298:         $row_type = 'Student';
 1299:     } else {
 1300:         return;  # error
 1301:     }
 1302:     ####################################
 1303:     # Print out header table
 1304:     ####################################
 1305:     my $num_left = 52-$num_uneditable;
 1306:     my $tabledata =<<"END";
 1307: <table border="2">
 1308: <tr>
 1309:   <th colspan="1" rowspan="2"><font size="+2">$realm</font></th>
 1310:   <td bgcolor="#FFDDDD" colspan="$num_uneditable">
 1311:       <b><font size="+1">Import</font></b></td>
 1312:   <td colspan="$num_left">
 1313:       <b><font size="+1">Calculations</font></b></td>
 1314: </tr><tr>
 1315: END
 1316:     my $label_num = 0;
 1317:     foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){
 1318:         if ($label_num<$num_uneditable) { 
 1319:             $tabledata.='<td bgcolor="#FFDDDD">';
 1320:         } else {
 1321:             $tabledata.='<td>';
 1322:         }
 1323:         $tabledata.="<b><font size=+1>$_</font></b></td>";
 1324:         $label_num++;
 1325:     }
 1326:     $tabledata.="</tr>\n";
 1327:     $r->print($tabledata);
 1328:     ####################################
 1329:     # Print out template row
 1330:     ####################################
 1331:     my ($rowlabel,@rowdata) = &get_row($sheet,'-');
 1332:     my $row_html = '<tr><td>'.&format_html_rowlabel($sheet,$rowlabel).'</td>';
 1333:     my $num_cols_output = 0;
 1334:     foreach my $cell (@rowdata) {
 1335:         if ($num_cols_output++ < $num_uneditable) {
 1336:             $row_html .= '<td bgcolor="#FFDDDD">';
 1337:             $row_html .= &html_uneditable_cell($cell,'#FFDDDD');
 1338:         } else {
 1339:             $row_html .= '<td bgcolor="#EOFFDD">';
 1340:             $row_html .= &html_editable_cell($cell,'#E0FFDD');
 1341:         }
 1342:         $row_html .= '</td>';
 1343:     }
 1344:     $row_html.= "</tr>\n";
 1345:     $r->print($row_html);
 1346:     ####################################
 1347:     # Print out summary/export row
 1348:     ####################################
 1349:     ($rowlabel,@rowdata) = &get_row($sheet,'0');
 1350:     $row_html = '<tr><td>'.&format_html_rowlabel($sheet,$rowlabel).'</td>';
 1351:     $num_cols_output = 0;
 1352:     foreach my $cell (@rowdata) {
 1353:         if ($num_cols_output++ < 26) {
 1354:             $row_html .= '<td bgcolor="#CCCCFF">';
 1355:             $row_html .= &html_editable_cell($cell,'#CCCCFF');
 1356:         } else {
 1357:             $row_html .= '<td bgcolor="#DDCCFF">';
 1358:             $row_html .= &html_uneditable_cell(undef,'#CCCCFF');
 1359:         }
 1360:         $row_html .= '</td>';
 1361:     }
 1362:     $row_html.= "</tr>\n";
 1363:     $r->print($row_html);
 1364:     $r->print('</table>');
 1365:     ####################################
 1366:     # Prepare to output rows
 1367:     ####################################
 1368:     my @Rows = &sort_indicies($sheet);
 1369:     #
 1370:     # Loop through the rows and output them one at a time
 1371:     my $rows_output=0;
 1372:     foreach my $rownum (@Rows) {
 1373:         my ($rowlabel,@rowdata) = &get_row($sheet,$rownum);
 1374:         next if ($rowlabel =~ /^\s*$/);
 1375:         next if (($sheet->{'sheettype'} eq 'assesscalc') && 
 1376:                  (! $ENV{'form.showall'})                &&
 1377:                  ($rowdata[0]->{'value'} =~ /^\s*$/));
 1378:         if (! $ENV{'form.showall'} &&
 1379:             $sheet->{'sheettype'} =~ /^(studentcalc|classcalc)$/) {
 1380:             my $row_is_empty = 1;
 1381:             foreach my $cell (@rowdata) {
 1382:                 if ($cell->{'value'} !~  /^\s*$/) {
 1383:                     $row_is_empty = 0;
 1384:                     last;
 1385:                 }
 1386:             }
 1387:             next if ($row_is_empty);
 1388:         }
 1389:         #
 1390:         my $defaultbg='#E0FF';
 1391:         #
 1392:         my $row_html ="\n".'<tr><td><b><font size=+1>'.$rownum.
 1393:             '</font></b></td>';
 1394:         #
 1395:         if ($sheet->{'sheettype'} eq 'classcalc') {
 1396:             $row_html.='<td>'.&format_html_rowlabel($sheet,$rowlabel).'</td>';
 1397:             # Output links for each student?
 1398:             # Nope, that is already done for us in format_html_rowlabel 
 1399:             # (for now)
 1400:         } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
 1401:             my $ufn = (split(/:/,$rowlabel))[5];
 1402:             $row_html.='<td>'.&format_html_rowlabel($sheet,$rowlabel);
 1403:             $row_html.= '<br>'.
 1404:                 '<select name="sel_'.$rownum.'" '.
 1405:                     'onChange="changesheet('.$rownum.')">'.
 1406:                         '<option name="default">Default</option>';
 1407: 
 1408:             foreach (@{$sheet->{'othersheets'}}) {
 1409:                 $row_html.='<option name="'.$_.'"';
 1410:                 if ($ufn eq $_) {
 1411:                     $row_html.=' selected';
 1412:                 }
 1413:                 $row_html.='>'.$_.'</option>';
 1414:             }
 1415:             $row_html.='</select></td>';
 1416:         } elsif ($sheet->{'sheettype'} eq 'assesscalc') {
 1417:             $row_html.='<td>'.&format_html_rowlabel($sheet,$rowlabel).'</td>';
 1418:         }
 1419:         #
 1420:         my $shown_cells = 0;
 1421:         foreach my $cell (@rowdata) {
 1422:             my $value    = $cell->{'value'};
 1423:             my $formula  = $cell->{'formula'};
 1424:             my $cellname = $cell->{'name'};
 1425:             #
 1426:             my $bgcolor;
 1427:             if ($shown_cells && ($shown_cells/5 == int($shown_cells/5))) {
 1428:                 $bgcolor = $defaultbg.'99';
 1429:             } else {
 1430:                 $bgcolor = $defaultbg.'DD';
 1431:             }
 1432:             $bgcolor='#FFDDDD' if ($shown_cells < $num_uneditable);
 1433:             #
 1434:             $row_html.='<td bgcolor='.$bgcolor.'>';
 1435:             if ($shown_cells < $num_uneditable) {
 1436:                 $row_html .= &html_uneditable_cell($cell,$bgcolor);
 1437:             } else {
 1438:                 $row_html .= &html_editable_cell($cell,$bgcolor);
 1439:             }
 1440:             $row_html.='</td>';
 1441:             $shown_cells++;
 1442:         }
 1443:         if ($row_html) {
 1444:             if ($rows_output % 25 == 0) {
 1445:                 $r->print("</table>\n<br>\n");
 1446:                 $r->rflush();
 1447:                 $r->print('<table border=2>'.
 1448:                           '<tr><td>&nbsp;<td>'.$row_type.'</td>'.
 1449:                           '<td>'.
 1450:                           join('</td><td>',
 1451:                                (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
 1452:                                       'abcdefghijklmnopqrstuvwxyz'))).
 1453:                           "</td></tr>\n");
 1454:             }
 1455:             $rows_output++;
 1456:             $r->print($row_html);
 1457:         }
 1458:     }
 1459:     #
 1460:     $r->print('</table>');
 1461:     #
 1462:     # Debugging code (be sure to uncomment errorlog code in safe space):
 1463:     #
 1464:     # $r->print("\n<pre>");
 1465:     # $r->print(&geterrorlog($sheet));
 1466:     # $r->print("\n</pre>");
 1467:     return 1;
 1468: }
 1469: 
 1470: ############################################
 1471: ##         csv output routines            ##
 1472: ############################################
 1473: sub outsheet_csv   {
 1474:     my ($sheet,$r) = @_;
 1475:     my $csvdata = '';
 1476:     my @Values;
 1477:     ####################################
 1478:     # Prepare to output rows
 1479:     ####################################
 1480:     my @Rows = &sort_indicies($sheet);
 1481:     #
 1482:     # Loop through the rows and output them one at a time
 1483:     my $rows_output=0;
 1484:     foreach my $rownum (@Rows) {
 1485:         my ($rowlabel,@rowdata) = &get_row($sheet,$rownum);
 1486:         next if ($rowlabel =~ /^\s*$/);
 1487:         push (@Values,&format_csv_rowlabel($sheet,$rowlabel));
 1488:         foreach my $cell (@rowdata) {
 1489:             push (@Values,'"'.$cell->{'value'}.'"');
 1490:         }
 1491:         $csvdata.= join(',',@Values)."\n";
 1492:         @Values = ();
 1493:     }
 1494:     #
 1495:     # Write the CSV data to a file and serve up a link
 1496:     #
 1497:     my $filename = '/prtspool/'.
 1498:         $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
 1499:         time.'_'.rand(1000000000).'.csv';
 1500:     my $file;
 1501:     unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) {
 1502:         $r->log_error("Couldn't open $filename for output $!");
 1503:         $r->print("Problems occured in writing the csv file.  ".
 1504:                   "This error has been logged.  ".
 1505:                   "Please alert your LON-CAPA administrator.");
 1506:         $r->print("<pre>\n".$csvdata."</pre>\n");
 1507:         return 0;
 1508:     }
 1509:     print $file $csvdata;
 1510:     close($file);
 1511:     $r->print('<br /><br />'.
 1512:               '<a href="'.$filename.'">Your CSV spreadsheet.</a>'."\n");
 1513:     #
 1514:     return 1;
 1515: }
 1516: 
 1517: ############################################
 1518: ##        Excel output routines           ##
 1519: ############################################
 1520: sub outsheet_recursive_excel {
 1521:     my ($sheet,$r) = @_;
 1522:     my $c = $r->connection;
 1523:     return undef if ($sheet->{'sheettype'} ne 'classcalc');
 1524:     my ($workbook,$filename) = &create_excel_spreadsheet($sheet,$r);
 1525:     return undef if (! defined($workbook));
 1526:     #
 1527:     # Create main worksheet
 1528:     my $main_worksheet = $workbook->addworksheet('main');
 1529:     #
 1530:     # Figure out who the students are
 1531:     my %f=&getformulas($sheet);
 1532:     my $count = 0;
 1533:     $r->print(<<END);
 1534: <p>
 1535: Compiling Excel Workbook with a worksheet for each student.
 1536: </p><p>
 1537: This operation may take longer than a complete recalculation of the
 1538: spreadsheet. 
 1539: </p><p>
 1540: To abort this operation, hit the stop button on your browser.
 1541: </p><p>
 1542: A link to the spreadsheet will be available at the end of this process.
 1543: </p>
 1544: <p>
 1545: END
 1546:     $r->rflush();
 1547:     my $starttime = time;
 1548:     foreach my $rownum (&sort_indicies($sheet)) {
 1549:         $count++;
 1550:         my ($sname,$sdom) = split(':',$f{'A'.$rownum});
 1551:         my $student_excel_worksheet=$workbook->addworksheet($sname.'@'.$sdom);
 1552:         # Create a new spreadsheet
 1553:         my $studentsheet = &makenewsheet($sname,$sdom,'studentcalc',undef);
 1554:         # Read in the spreadsheet definition
 1555:         &update_student_sheet($studentsheet,$r,$c);
 1556:         # Stuff the sheet into excel
 1557:         &export_sheet_as_excel($studentsheet,$student_excel_worksheet);
 1558:         my $totaltime = int((time - $starttime) / $count * $sheet->{'maxrow'});
 1559:         my $timeleft = int((time - $starttime) / $count * ($sheet->{'maxrow'} - $count));
 1560:         if ($count % 5 == 0) {
 1561:             $r->print($count.' students completed.'.
 1562:                       '  Time remaining: '.$timeleft.' sec. '.
 1563:                       '  Estimated total time: '.$totaltime." sec <br />\n");
 1564:             $r->rflush();
 1565:         }
 1566:         if(defined($c) && ($c->aborted())) {
 1567:             last;
 1568:         }
 1569:     }
 1570:     #
 1571:     if(! $c->aborted() ) {
 1572:         $r->print('All students spreadsheets completed!<br />');
 1573:         $r->rflush();
 1574:         #
 1575:         # &export_sheet_as_excel fills $worksheet with the data from $sheet
 1576:         &export_sheet_as_excel($sheet,$main_worksheet);
 1577:         #
 1578:         $workbook->close();
 1579:         # Okay, the spreadsheet is taken care of, so give the user a link.
 1580:         $r->print('<br /><br />'.
 1581:                   '<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n");
 1582:     } else {
 1583:         $workbook->close();  # Not sure how necessary this is.
 1584:         #unlink('/home/httpd'.$filename); # No need to keep this around?
 1585:     }
 1586:     return 1;
 1587: }
 1588: 
 1589: sub outsheet_excel {
 1590:     my ($sheet,$r) = @_;
 1591:     my ($workbook,$filename) = &create_excel_spreadsheet($sheet,$r);
 1592:     return undef if (! defined($workbook));
 1593:     my $sheetname;
 1594:     if ($sheet->{'sheettype'} eq 'classcalc') {
 1595:         $sheetname = 'Main';
 1596:     } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
 1597:         $sheetname = $sheet->{'uname'}.'@'.$sheet->{'udom'};
 1598:     } elsif ($sheet->{'sheettype'} eq 'assesscalc') {
 1599:         $sheetname = $sheet->{'uname'}.'@'.$sheet->{'udom'}.' assessment';
 1600:     }
 1601:     my $worksheet = $workbook->addworksheet($sheetname);
 1602:     #
 1603:     # &export_sheet_as_excel fills $worksheet with the data from $sheet
 1604:     &export_sheet_as_excel($sheet,$worksheet);
 1605:     #
 1606:     $workbook->close();
 1607:     # Okay, the spreadsheet is taken care of, so give the user a link.
 1608:     $r->print('<br /><br />'.
 1609:               '<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n");
 1610:     return 1;
 1611: }
 1612: 
 1613: sub create_excel_spreadsheet {
 1614:     my ($sheet,$r) = @_;
 1615:     my $filename = '/prtspool/'.
 1616:         $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
 1617:         time.'_'.rand(1000000000).'.xls';
 1618:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
 1619:     if (! defined($workbook)) {
 1620:         $r->log_error("Error creating excel spreadsheet $filename: $!");
 1621:         $r->print("Problems creating new Excel file.  ".
 1622:                   "This error has been logged.  ".
 1623:                   "Please alert your LON-CAPA administrator");
 1624:         return undef;
 1625:     }
 1626:     #
 1627:     # The spreadsheet stores temporary data in files, then put them
 1628:     # together.  If needed we should be able to disable this (memory only).
 1629:     # The temporary directory must be specified before calling 'addworksheet'.
 1630:     # File::Temp is used to determine the temporary directory.
 1631:     $workbook->set_tempdir('/home/httpd/perl/tmp');
 1632:     #
 1633:     # Determine the name to give the worksheet
 1634:     return ($workbook,$filename);
 1635: }
 1636: 
 1637: sub export_sheet_as_excel {
 1638:     my $sheet = shift;
 1639:     my $worksheet = shift;
 1640:     #
 1641:     my $rows_output = 0;
 1642:     my $cols_output = 0;
 1643:     ####################################
 1644:     #    Write an identifying row      #
 1645:     ####################################
 1646:     my @Headerinfo = ($sheet->{'coursedesc'});
 1647:     my $title = &gettitle($sheet);
 1648:     $cols_output = 0;    
 1649:     if (defined($title)) {
 1650:         $worksheet->write($rows_output++,$cols_output++,$title);
 1651:     }
 1652:     ####################################
 1653:     #   Write the summary/export row   #
 1654:     ####################################
 1655:     my ($rowlabel,@rowdata) = &get_row($sheet,'0');
 1656:     my $label = &format_excel_rowlabel($sheet,$rowlabel);
 1657:     $cols_output = 0;
 1658:     $worksheet->write($rows_output,$cols_output++,$label);
 1659:     foreach my $cell (@rowdata) {
 1660:         $worksheet->write($rows_output,$cols_output++,$cell->{'value'});
 1661:     }
 1662:     $rows_output+= 2;   # Skip a row, just for fun
 1663:     ####################################
 1664:     # Prepare to output rows
 1665:     ####################################
 1666:     my @Rows = &sort_indicies($sheet);
 1667:     #
 1668:     # Loop through the rows and output them one at a time
 1669:     foreach my $rownum (@Rows) {
 1670:         my ($rowlabel,@rowdata) = &get_row($sheet,$rownum);
 1671:         next if ($rowlabel =~ /^[\s]*$/);
 1672:         $cols_output = 0;
 1673:         my $label = &format_excel_rowlabel($sheet,$rowlabel);
 1674:         if ( ! $ENV{'form.showall'} &&
 1675:              $sheet->{'sheettype'} =~ /^(studentcalc|classcalc)$/) {
 1676:             my $row_is_empty = 1;
 1677:             foreach my $cell (@rowdata) {
 1678:                 if ($cell->{'value'} !~  /^\s*$/) {
 1679:                     $row_is_empty = 0;
 1680:                     last;
 1681:                 }
 1682:             }
 1683:             next if ($row_is_empty);
 1684:         }
 1685:         $worksheet->write($rows_output,$cols_output++,$label);
 1686:         if (ref($label)) {
 1687:             $cols_output = (scalar(@$label));
 1688:         }
 1689:         foreach my $cell (@rowdata) {
 1690:             $worksheet->write($rows_output,$cols_output++,$cell->{'value'});
 1691:         }
 1692:         $rows_output++;
 1693:     }
 1694:     return;
 1695: }
 1696: 
 1697: ############################################
 1698: ##          XML output routines           ##
 1699: ############################################
 1700: sub outsheet_xml   {
 1701:     my ($sheet,$r) = @_;
 1702:     ## Someday XML
 1703:     ## Will be rendered for the user
 1704:     ## But not on this day
 1705: }
 1706: 
 1707: ##
 1708: ## Outsheet - calls other outsheet_* functions
 1709: ##
 1710: sub outsheet {
 1711:     my ($sheet,$r)=@_;
 1712:     if (! exists($ENV{'form.output'})) {
 1713:         $ENV{'form.output'} = 'HTML';
 1714:     }
 1715:     if (lc($ENV{'form.output'}) eq 'csv') {
 1716:         &outsheet_csv($sheet,$r);
 1717:     } elsif (lc($ENV{'form.output'}) eq 'excel') {
 1718:         &outsheet_excel($sheet,$r);
 1719:     } elsif (lc($ENV{'form.output'}) eq 'recursive excel') {
 1720:         &outsheet_recursive_excel($sheet,$r);
 1721: #    } elsif (lc($ENV{'form.output'}) eq 'xml' ) {
 1722: #        &outsheet_xml($sheet,$r);
 1723:     } else {
 1724:         &outsheet_html($sheet,$r);
 1725:     }
 1726: }
 1727: 
 1728: ########################################################################
 1729: ########################################################################
 1730: sub othersheets {
 1731:     my ($sheet,$stype)=@_;
 1732:     $stype = $sheet->{'sheettype'} if (! defined($stype));
 1733:     #
 1734:     my $cnum  = $sheet->{'cnum'};
 1735:     my $cdom  = $sheet->{'cdom'};
 1736:     my $chome = $sheet->{'chome'};
 1737:     #
 1738:     my @alternatives=();
 1739:     my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum);
 1740:     my ($tmp) = keys(%results);
 1741:     unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
 1742:         @alternatives = sort (keys(%results));
 1743:     }
 1744:     return @alternatives; 
 1745: }
 1746: 
 1747: #
 1748: # -------------------------------------- Parse a spreadsheet
 1749: # 
 1750: sub parse_sheet {
 1751:     # $sheetxml is a scalar reference or a scalar
 1752:     my ($sheetxml) = @_;
 1753:     if (! ref($sheetxml)) {
 1754:         my $tmp = $sheetxml;
 1755:         $sheetxml = \$tmp;
 1756:     }
 1757:     my %f;
 1758:     my $parser=HTML::TokeParser->new($sheetxml);
 1759:     my $token;
 1760:     while ($token=$parser->get_token) {
 1761:         if ($token->[0] eq 'S') {
 1762:             if ($token->[1] eq 'field') {
 1763:                 $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
 1764:                     $parser->get_text('/field');
 1765:             }
 1766:             if ($token->[1] eq 'template') {
 1767:                 $f{'template_'.$token->[2]->{'col'}}=
 1768:                     $parser->get_text('/template');
 1769:             }
 1770:         }
 1771:     }
 1772:     return \%f;
 1773: }
 1774: 
 1775: #
 1776: # -------------------------------------- Read spreadsheet formulas for a course
 1777: #
 1778: sub readsheet {
 1779:     my ($sheet,$fn)=@_;
 1780:     #
 1781:     my $stype = $sheet->{'sheettype'};
 1782:     my $cnum  = $sheet->{'cnum'};
 1783:     my $cdom  = $sheet->{'cdom'};
 1784:     my $chome = $sheet->{'chome'};
 1785:     #
 1786:     if (! defined($fn)) {
 1787:         # There is no filename. Look for defaults in course and global, cache
 1788:         unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {
 1789:             my %tmphash = &Apache::lonnet::get('environment',
 1790:                                                ['spreadsheet_default_'.$stype],
 1791:                                                $cdom,$cnum);
 1792:             my ($tmp) = keys(%tmphash);
 1793:             if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
 1794:                 $fn = 'default_'.$stype;
 1795:             } else {
 1796:                 $fn = $tmphash{'spreadsheet_default_'.$stype};
 1797:             } 
 1798:             unless (($fn) && ($fn!~/^error\:/)) {
 1799:                 $fn='default_'.$stype;
 1800:             }
 1801:             $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; 
 1802:         }
 1803:     }
 1804:     # $fn now has a value
 1805:     $sheet->{'filename'} = $fn;
 1806:     # see if sheet is cached
 1807:     my $fstring='';
 1808:     if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) {
 1809:         my %tmp = split(/___;___/,$fstring);
 1810:         $sheet->{'f'} = \%tmp;
 1811:         &setformulas($sheet);
 1812:     } else {
 1813:         # Not cached, need to read
 1814:         my %f=();
 1815:         if ($fn=~/^default\_/) {
 1816:             my $sheetxml='';
 1817:             my $fh;
 1818:             my $dfn=$fn;
 1819:             $dfn=~s/\_/\./g;
 1820:             if ($fh=Apache::File->new($includedir.'/'.$dfn)) {
 1821:                 $sheetxml=join('',<$fh>);
 1822:             } else {
 1823:                 # $sheetxml='<field row="0" col="A">"Error"</field>';
 1824:                 $sheetxml='<field row="0" col="A"></field>';
 1825:             }
 1826:             %f=%{&parse_sheet(\$sheetxml)};
 1827:         } elsif($fn=~/\/*\.spreadsheet$/) {
 1828:             my $sheetxml=&Apache::lonnet::getfile
 1829:                 (&Apache::lonnet::filelocation('',$fn));
 1830:             if ($sheetxml == -1) {
 1831:                 $sheetxml='<field row="0" col="A">"Error loading spreadsheet '
 1832:                     .$fn.'"</field>';
 1833:             }
 1834:             %f=%{&parse_sheet(\$sheetxml)};
 1835:         } else {
 1836:             my $sheet='';
 1837:             my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
 1838:             my ($tmp) = keys(%tmphash);
 1839:             unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
 1840:                 foreach (keys(%tmphash)) {
 1841:                     $f{$_}=$tmphash{$_};
 1842:                 }
 1843:             }
 1844:         }
 1845:         # Cache and set
 1846:         $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);  
 1847:         $sheet->{'f'}=\%f;
 1848:         &setformulas($sheet);
 1849:     }
 1850: }
 1851: 
 1852: # -------------------------------------------------------- Make new spreadsheet
 1853: sub makenewsheet {
 1854:     my ($uname,$udom,$stype,$usymb)=@_;
 1855:     my $sheet={};
 1856:     $sheet->{'uname'} = $uname;
 1857:     $sheet->{'udom'}  = $udom;
 1858:     $sheet->{'sheettype'} = $stype;
 1859:     $sheet->{'usymb'} = $usymb;
 1860:     $sheet->{'mapid'} = $ENV{'form.mapid'};
 1861:     $sheet->{'resid'} = $ENV{'form.resid'};
 1862:     $sheet->{'cid'}   = $ENV{'request.course.id'};
 1863:     $sheet->{'csec'}  = $Section{$uname.':'.$udom};
 1864:     $sheet->{'coursefilename'}   = $ENV{'request.course.fn'};
 1865:     $sheet->{'cnum'}  = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
 1866:     $sheet->{'cdom'}  = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
 1867:     $sheet->{'chome'} = $ENV{'course.'.$ENV{'request.course.id'}.'.home'};
 1868:     $sheet->{'coursedesc'} = $ENV{'course.'.$ENV{'request.course.id'}.
 1869:                                       '.description'};
 1870:     $sheet->{'uhome'} = &Apache::lonnet::homeserver($uname,$udom);
 1871:     #
 1872:     #
 1873:     $sheet->{'f'} = {};
 1874:     $sheet->{'constants'} = {};
 1875:     $sheet->{'othersheets'} = [];
 1876:     $sheet->{'rowlabel'} = {};
 1877:     #
 1878:     #
 1879:     $sheet->{'safe'}=&initsheet($sheet->{'sheettype'});
 1880:     #
 1881:     # Place all the %$sheet items into the safe space except the safe space
 1882:     # itself
 1883:     my $initstring = '';
 1884:     foreach (qw/uname udom sheettype usymb cid csec coursefilename
 1885:              cnum cdom chome uhome/) {
 1886:         $initstring.= qq{\$$_="$sheet->{$_}";};
 1887:     }
 1888:     $sheet->{'safe'}->reval($initstring);
 1889:     return $sheet;
 1890: }
 1891: 
 1892: # ------------------------------------------------------------ Save spreadsheet
 1893: sub writesheet {
 1894:     my ($sheet,$makedef)=@_;
 1895:     my $cid=$sheet->{'cid'};
 1896:     if (&Apache::lonnet::allowed('opa',$cid)) {
 1897:         my %f=&getformulas($sheet);
 1898:         my $stype= $sheet->{'sheettype'};
 1899:         my $cnum = $sheet->{'cnum'};
 1900:         my $cdom = $sheet->{'cdom'};
 1901:         my $chome= $sheet->{'chome'};
 1902:         my $fn   = $sheet->{'filename'};
 1903:         # Cache new sheet
 1904:         $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
 1905:         # Write sheet
 1906:         foreach (keys(%f)) {
 1907:             delete($f{$_}) if ($f{$_} eq 'import');
 1908:         }
 1909:         my $reply = &Apache::lonnet::put($fn,\%f,$cdom,$cnum);
 1910:         if ($reply eq 'ok') {
 1911:             $reply = &Apache::lonnet::put($stype.'_spreadsheets',
 1912:                             {$fn => $ENV{'user.name'}.'@'.$ENV{'user.domain'}},
 1913:                                           $cdom,$cnum);
 1914:             if ($reply eq 'ok') {
 1915:                 if ($makedef) { 
 1916:                     $reply = &Apache::lonnet::put('environment',
 1917:                                     {'spreadsheet_default_'.$stype => $fn },
 1918:                                                   $cdom,$cnum);
 1919:                     if ($reply eq 'ok' && 
 1920:                         ($sheet->{'sheettype'} eq 'studentcalc' ||
 1921:                          $sheet->{'sheettype'} eq 'assesscalc')) {
 1922:                         # Expire the spreadsheets of the other students.
 1923:                         &Apache::lonnet::expirespread('','','studentcalc','');
 1924:                     }
 1925:                     return $reply;
 1926:                 } 
 1927:                 return $reply;
 1928:             } 
 1929:             return $reply;
 1930:         } 
 1931:         return $reply;
 1932:     }
 1933:     return 'unauthorized';
 1934: }
 1935: 
 1936: # ----------------------------------------------- Make a temp copy of the sheet
 1937: # "Modified workcopy" - interactive only
 1938: #
 1939: sub tmpwrite {
 1940:     my ($sheet) = @_;
 1941:     my $fn=$ENV{'user.name'}.'_'.
 1942:         $ENV{'user.domain'}.'_spreadsheet_'.$sheet->{'usymb'}.'_'.
 1943:            $sheet->{'filename'};
 1944:     $fn=~s/\W/\_/g;
 1945:     $fn=$tmpdir.$fn.'.tmp';
 1946:     my $fh;
 1947:     if ($fh=Apache::File->new('>'.$fn)) {
 1948:         my %f = &getformulas($sheet);
 1949:         while( my ($cell,$formula) = each(%f)) {
 1950:             print $fh &Apache::lonnet::escape($cell)."=".&Apache::lonnet::escape($formula)."\n";
 1951:         }
 1952:     }
 1953: }
 1954: 
 1955: # ---------------------------------------------------------- Read the temp copy
 1956: sub tmpread {
 1957:     my ($sheet,$nfield,$nform)=@_;
 1958:     my $fn=$ENV{'user.name'}.'_'.
 1959:            $ENV{'user.domain'}.'_spreadsheet_'.$sheet->{'usymb'}.'_'.
 1960:            $sheet->{'filename'};
 1961:     $fn=~s/\W/\_/g;
 1962:     $fn=$tmpdir.$fn.'.tmp';
 1963:     my $fh;
 1964:     my %fo=();
 1965:     my $countrows=0;
 1966:     if ($fh=Apache::File->new($fn)) {
 1967:         while (<$fh>) {
 1968: 	    chomp;
 1969:             my ($cell,$formula) = split(/=/);
 1970:             $cell    = &Apache::lonnet::unescape($cell);
 1971:             $formula = &Apache::lonnet::unescape($formula);
 1972:             $fo{$cell} = $formula;
 1973:         }
 1974:     }
 1975: #            chomp($value);
 1976: #            $fo{$name}=$value;
 1977: #            if ($name=~/^A(\d+)$/) {
 1978: #		if ($1>$countrows) {
 1979: #		    $countrows=$1;
 1980: #                }
 1981: #            }
 1982: #        }
 1983: #    }
 1984:     if ($nform eq 'changesheet') {
 1985:         $fo{'A'.$nfield}=(split(/__&&&\__/,$fo{'A'.$nfield}))[0];
 1986:         unless ($ENV{'form.sel_'.$nfield} eq 'Default') {
 1987: 	    $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};
 1988:         }
 1989: #    } elsif ($nfield eq 'insertrow') {
 1990: #        $countrows++;
 1991: #        my $newrow=substr('000000'.$countrows,-7);
 1992: #        if ($nform eq 'top') {
 1993: #	    $fo{'A'.$countrows}='--- '.$newrow;
 1994: #        } else {
 1995: #            $fo{'A'.$countrows}='~~~ '.$newrow;
 1996: #        }
 1997:     } else {
 1998:        if ($nfield) { $fo{$nfield}=$nform; }
 1999:     }
 2000:     $sheet->{'f'}=\%fo;
 2001:     &setformulas($sheet);
 2002: }
 2003: 
 2004: ##################################################
 2005: ##################################################
 2006: 
 2007: =pod
 2008: 
 2009: =item &parmval()
 2010: 
 2011: Determine the value of a parameter.
 2012: 
 2013: Inputs: $what, the parameter needed, $sheet, the safe space
 2014: 
 2015: Returns: The value of a parameter, or '' if none.
 2016: 
 2017: This function cascades through the possible levels searching for a value for
 2018: a parameter.  The levels are checked in the following order:
 2019: user, course (at section level and course level), map, and lonnet::metadata.
 2020: This function uses %parmhash, which must be tied prior to calling it.
 2021: This function also requires %courseopt and %useropt to be initialized for
 2022: this user and course.
 2023: 
 2024: =cut
 2025: 
 2026: ##################################################
 2027: ##################################################
 2028: sub parmval {
 2029:     my ($what,$sheet)=@_;
 2030:     my $symb  = $sheet->{'usymb'};
 2031:     unless ($symb) { return ''; }
 2032:     #
 2033:     my $cid   = $sheet->{'cid'};
 2034:     my $csec  = $sheet->{'csec'};
 2035:     my $uname = $sheet->{'uname'};
 2036:     my $udom  = $sheet->{'udom'};
 2037:     my $result='';
 2038:     #
 2039:     my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
 2040:     # Cascading lookup scheme
 2041:     my $rwhat=$what;
 2042:     $what =~ s/^parameter\_//;
 2043:     $what =~ s/\_([^\_]+)$/\.$1/;
 2044:     #
 2045:     my $symbparm = $symb.'.'.$what;
 2046:     my $mapparm  = $mapname.'___(all).'.$what;
 2047:     my $usercourseprefix = $uname.'_'.$udom.'_'.$cid;
 2048:     #
 2049:     my $seclevel  = $usercourseprefix.'.['.$csec.'].'.$what;
 2050:     my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm;
 2051:     my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm;
 2052:     #
 2053:     my $courselevel  = $usercourseprefix.'.'.$what;
 2054:     my $courselevelr = $usercourseprefix.'.'.$symbparm;
 2055:     my $courselevelm = $usercourseprefix.'.'.$mapparm;
 2056:     # fourth, check user
 2057:     if (defined($uname)) {
 2058:         return $useropt{$courselevelr} if (defined($useropt{$courselevelr}));
 2059:         return $useropt{$courselevelm} if (defined($useropt{$courselevelm}));
 2060:         return $useropt{$courselevel}  if (defined($useropt{$courselevel}));
 2061:     }
 2062:     # third, check course
 2063:     if (defined($csec)) {
 2064:         return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr}));
 2065:         return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm}));
 2066:         return $courseopt{$seclevel}  if (defined($courseopt{$seclevel}));
 2067:     }
 2068:     #
 2069:     return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr}));
 2070:     return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm}));
 2071:     return $courseopt{$courselevel}  if (defined($courseopt{$courselevel}));
 2072:     # second, check map parms
 2073:     my $thisparm = $parmhash{$symbparm};
 2074:     return $thisparm if (defined($thisparm));
 2075:     # first, check default
 2076:     return &Apache::lonnet::metadata($fn,$rwhat.'.default');
 2077: }
 2078: 
 2079: 
 2080: ##################################################################
 2081: ##                  Row label formatting routines               ##
 2082: ##################################################################
 2083: sub format_html_rowlabel {
 2084:     my $sheet = shift;
 2085:     my $rowlabel = shift;
 2086:     return '' if ($rowlabel eq '');
 2087:     my ($type,$labeldata) = split(':',$rowlabel,2);
 2088:     my $result = '';
 2089:     if ($type eq 'symb') {
 2090:         my ($symb,$mapid,$resid,$title,$ufn) = split(':',$labeldata);
 2091:         $ufn   = 'default' if (!defined($ufn) || $ufn eq '');
 2092:         $ufn   = &Apache::lonnet::unescape($ufn);
 2093:         $symb  = &Apache::lonnet::unescape($symb);
 2094:         $title = &Apache::lonnet::unescape($title);
 2095:         $result = '<a href="/adm/assesscalc?usymb='.$symb.
 2096:             '&uname='.$sheet->{'uname'}.'&udom='.$sheet->{'udom'}.
 2097:                 '&ufn='.$ufn.
 2098:                     '&mapid='.$mapid.'&resid='.$resid.'">'.$title.'</a>';
 2099:     } elsif ($type eq 'student') {
 2100:         my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata);
 2101:         if ($fullname =~ /^\s*$/) {
 2102:             $fullname = $sname.'@'.$sdom;
 2103:         }
 2104:         $result ='<a href="/adm/studentcalc?uname='.$sname.
 2105:             '&udom='.$sdom.'">';
 2106:         $result.=$section.'&nbsp;'.$id."&nbsp;".$fullname.'</a>';
 2107:     } elsif ($type eq 'parameter') {
 2108:         $result = $labeldata;
 2109:     } else {
 2110:         $result = '<b><font size=+1>'.$rowlabel.'</font></b>';
 2111:     }
 2112:     return $result;
 2113: }
 2114: 
 2115: sub format_csv_rowlabel {
 2116:     my $sheet = shift;
 2117:     my $rowlabel = shift;
 2118:     return '' if ($rowlabel eq '');
 2119:     my ($type,$labeldata) = split(':',$rowlabel,2);
 2120:     my $result = '';
 2121:     if ($type eq 'symb') {
 2122:         my ($symb,$mapid,$resid,$title,$ufn) = split(':',$labeldata);
 2123:         $ufn   = &Apache::lonnet::unescape($ufn);
 2124:         $symb  = &Apache::lonnet::unescape($symb);
 2125:         $title = &Apache::lonnet::unescape($title);
 2126:         $result = $title;
 2127:     } elsif ($type eq 'student') {
 2128:         my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata);
 2129:         $result = join('","',($sname,$sdom,$fullname,$section,$id));
 2130:     } elsif ($type eq 'parameter') {
 2131:         $labeldata =~ s/<br>/ /g;
 2132:         $result = $labeldata;
 2133:     } else {
 2134:         $result = $rowlabel;
 2135:     }
 2136:     return '"'.$result.'"';
 2137: }
 2138: 
 2139: sub format_excel_rowlabel {
 2140:     my $sheet = shift;
 2141:     my $rowlabel = shift;
 2142:     return '' if ($rowlabel eq '');
 2143:     my ($type,$labeldata) = split(':',$rowlabel,2);
 2144:     my $result = '';
 2145:     if ($type eq 'symb') {
 2146:         my ($symb,$mapid,$resid,$title,$ufn) = split(':',$labeldata);
 2147:         $ufn   = &Apache::lonnet::unescape($ufn);
 2148:         $symb  = &Apache::lonnet::unescape($symb);
 2149:         $title = &Apache::lonnet::unescape($title);
 2150:         $result = $title;
 2151:     } elsif ($type eq 'student') {
 2152:         my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata);
 2153:         $section = '' if (! defined($section));
 2154:         $id      = '' if (! defined($id));
 2155:         my @Data = ($sname,$sdom,$fullname,$section,$id);
 2156:         $result = \@Data;
 2157:     } elsif ($type eq 'parameter') {
 2158:         $labeldata =~ s/<br>/ /g;
 2159:         $result = $labeldata;
 2160:     } else {
 2161:         $result = $rowlabel;
 2162:     }
 2163:     return $result;
 2164: }
 2165: 
 2166: # ---------------------------------------------- Update rows for course listing
 2167: sub updateclasssheet {
 2168:     my ($sheet) = @_;
 2169:     my $cnum  =$sheet->{'cnum'};
 2170:     my $cdom  =$sheet->{'cdom'};
 2171:     my $cid   =$sheet->{'cid'};
 2172:     my $chome =$sheet->{'chome'};
 2173:     #
 2174:     %Section = ();
 2175:     #
 2176:     # Read class list and row labels
 2177:     my $classlist = &Apache::loncoursedata::get_classlist();
 2178:     if (! defined($classlist)) {
 2179:         return 'Could not access course classlist';
 2180:     } 
 2181:     #
 2182:     my %currentlist=();
 2183:     foreach my $student (keys(%$classlist)) {
 2184:         my ($studentDomain,$studentName,$end,$start,$id,$studentSection,
 2185:             $fullname,$status)   =   @{$classlist->{$student}};
 2186:         $Section{$studentName.':'.$studentDomain} = $studentSection;
 2187:         if ($ENV{'form.Status'} eq $status || $ENV{'form.Status'} eq 'Any') {
 2188:             $currentlist{$student}=join(':',('student',$studentName,
 2189:                                              $studentDomain,$fullname,
 2190:                                              $studentSection,$id));
 2191:         }
 2192:     }
 2193:     #
 2194:     # Find discrepancies between the course row table and this
 2195:     #
 2196:     my %f=&getformulas($sheet);
 2197:     my $changed=0;
 2198:     #
 2199:     $sheet->{'maxrow'}=0;
 2200:     my %existing=();
 2201:     #
 2202:     # Now obsolete rows
 2203:     foreach (keys(%f)) {
 2204:         if ($_=~/^A(\d+)/) {
 2205:             if ($1 > $sheet->{'maxrow'}) {
 2206:                 $sheet->{'maxrow'}= $1;
 2207:             }
 2208:             $existing{$f{$_}}=1;
 2209:             unless ((defined($currentlist{$f{$_}})) || (!$1) ||
 2210:                     ($f{$_}=~/^(~~~|---)/)) {
 2211:                 $f{$_}='!!! Obsolete';
 2212:                 $changed=1;
 2213:             }
 2214:         }
 2215:     }
 2216:     #
 2217:     # New and unknown keys
 2218:     foreach my $student (sort keys(%currentlist)) {
 2219:         unless ($existing{$student}) {
 2220:             $changed=1;
 2221:             $sheet->{'maxrow'}++;
 2222:             $f{'A'.$sheet->{'maxrow'}}=$student;
 2223:         }
 2224:     }
 2225:     if ($changed) { 
 2226:         $sheet->{'f'} = \%f;
 2227:         &setformulas($sheet,%f); 
 2228:     }
 2229:     #
 2230:     &setrowlabels($sheet,\%currentlist);
 2231: }
 2232: 
 2233: # ----------------------------------- Update rows for student and assess sheets
 2234: sub get_student_rowlabels {
 2235:     my ($sheet) = @_;
 2236:     #
 2237:     my %course_db;
 2238:     #
 2239:     my $stype = $sheet->{'sheettype'};
 2240:     my $uname = $sheet->{'uname'};
 2241:     my $udom  = $sheet->{'udom'};
 2242:     #
 2243:     $sheet->{'rowlabel'} = {};
 2244:     #
 2245:     my $identifier =$sheet->{'coursefilename'}.'_'.$stype;
 2246:     if  ($rowlabel_cache{$identifier}) {
 2247:         %{$sheet->{'rowlabel'}}=split(/___;___/,$rowlabel_cache{$identifier});
 2248:     } else {
 2249:         # Get the data and store it in the cache
 2250:         # Tie hash
 2251:         tie(%course_db,'GDBM_File',$sheet->{'coursefilename'}.'.db',
 2252:             &GDBM_READER(),0640);
 2253:         if (! tied(%course_db)) {
 2254:             return 'Could not access course data';
 2255:         }
 2256:         #
 2257:         my %assesslist = ();
 2258:         foreach ('Feedback','Evaluation','Tutoring','Discussion') {
 2259:             my $symb = '_'.lc($_);
 2260:             $assesslist{$symb} = join(':',('symb',$symb,0,0,
 2261:                                            &Apache::lonnet::escape($_)));
 2262:         }
 2263:         #
 2264:         while (my ($key,$srcf) = each(%course_db)) {
 2265:             next if ($key !~ /^src_(\d+)\.(\d+)$/);
 2266:             my $mapid = $1;
 2267:             my $resid = $2;
 2268:             my $id   = $mapid.'.'.$resid;
 2269:             if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
 2270:                 my $symb=
 2271:                     &Apache::lonnet::declutter($course_db{'map_id_'.$mapid}).
 2272:                         '___'.$resid.'___'.&Apache::lonnet::declutter($srcf);
 2273:                 $assesslist{$symb} ='symb:'.&Apache::lonnet::escape($symb).':'
 2274:                     .$mapid.':'.$resid.':'.
 2275:                         &Apache::lonnet::escape($course_db{'title_'.$id});
 2276:             }
 2277:         }
 2278:         untie(%course_db);
 2279:         # Store away the data
 2280:         $sheet->{'rowlabel'} = \%assesslist;
 2281:         $rowlabel_cache{$identifier}=join('___;___',%{$sheet->{'rowlabel'}});
 2282:     }
 2283: 
 2284: }
 2285: 
 2286: sub get_assess_rowlabels {
 2287:     my ($sheet) = @_;
 2288:     #
 2289:     my %course_db;
 2290:     #
 2291:     my $stype = $sheet->{'sheettype'};
 2292:     my $uname = $sheet->{'uname'};
 2293:     my $udom  = $sheet->{'udom'};
 2294:     my $usymb = $sheet->{'usymb'};
 2295:     #
 2296:     $sheet->{'rowlabel'} = {};
 2297:     my $identifier =$sheet->{'coursefilename'}.'_'.$stype.'_'.$usymb;
 2298:     #
 2299:     if  ($rowlabel_cache{$identifier}) {
 2300:         %{$sheet->{'rowlabel'}}=split(/___;___/,$rowlabel_cache{$identifier});
 2301:     } else {
 2302:         # Get the data and store it in the cache
 2303:         # Tie hash
 2304:         tie(%course_db,'GDBM_File',$sheet->{'coursefilename'}.'.db',
 2305:             &GDBM_READER(),0640);
 2306:         if (! tied(%course_db)) {
 2307:             return 'Could not access course data';
 2308:         }
 2309:         #
 2310:         my %parameter_labels=
 2311:             ('timestamp' => 
 2312:                  'parameter:Timestamp of Last Transaction<br>timestamp',
 2313:              'subnumber' =>
 2314:                  'parameter:Number of Submissions<br>subnumber',
 2315:              'tutornumber' =>
 2316:                  'parameter:Number of Tutor Responses<br>tutornumber',
 2317:              'totalpoints' =>
 2318:                  'parameter:Total Points Granted<br>totalpoints');
 2319:         while (my ($key,$srcf) = each(%course_db)) {
 2320:             next if ($key !~ /^src_(\d+)\.(\d+)$/);
 2321:             my $mapid = $1;
 2322:             my $resid = $2;
 2323:             my $id   = $mapid.'.'.$resid;
 2324:             if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
 2325:                 # Loop through the metadata for this key
 2326:                 my @Metadata = split(/,/,
 2327:                                      &Apache::lonnet::metadata($srcf,'keys'));
 2328:                 foreach my $key (@Metadata) {
 2329:                     next if ($key !~ /^(stores|parameter)_/);
 2330:                     my $display=
 2331:                         &Apache::lonnet::metadata($srcf,$key.'.display');
 2332:                     unless ($display) {
 2333:                         $display.=
 2334:                             &Apache::lonnet::metadata($srcf,$key.'.name');
 2335:                     }
 2336:                     $display.='<br>'.$key;
 2337:                     $parameter_labels{$key}='parameter:'.$display;
 2338:                 } # end of foreach
 2339:             }
 2340:         }
 2341:         untie(%course_db);
 2342:         # Store away the results
 2343:         $sheet->{'rowlabel'} = \%parameter_labels;
 2344:         $rowlabel_cache{$identifier}=join('___;___',%{$sheet->{'rowlabel'}});
 2345:     }
 2346:         
 2347: }
 2348: 
 2349: sub updatestudentassesssheet {
 2350:     my $sheet = shift;
 2351:     if ($sheet->{'sheettype'} eq 'studentcalc') {
 2352:         &get_student_rowlabels($sheet);
 2353:     } else {
 2354:         &get_assess_rowlabels($sheet);
 2355:     }
 2356:     # Determine if any of the information has changed
 2357:     my %f=&getformulas($sheet);
 2358:     my $changed=0;
 2359:     
 2360:     $sheet->{'maxrow'} = 0;
 2361:     my %existing=();
 2362:     # Now obsolete rows
 2363:     foreach my $cell (keys(%f)) {
 2364:         my $formula = $f{$cell};
 2365:         next if ($cell !~ /^A(\d+)/);
 2366:         $sheet->{'maxrow'} = $1 if ($1 > $sheet->{'maxrow'});
 2367:         my ($usy,$ufn)=split(/__&&&\__/,$formula);
 2368:         $existing{$usy}=1;
 2369:         unless ((exists($sheet->{'rowlabel'}->{$usy}) && 
 2370:                  (defined($sheet->{'rowlabel'}->{$usy})) || (!$1) ||
 2371:                  ($formula =~ /^(~~~|---)/) )) {
 2372:             $f{$_}='!!! Obsolete';
 2373:             $changed=1;
 2374:         }
 2375:     }
 2376:     # New and unknown keys
 2377:     foreach (keys(%{$sheet->{'rowlabel'}})) {
 2378:         unless ($existing{$_}) {
 2379:             $changed=1;
 2380:             $sheet->{'maxrow'}++;
 2381:             $f{'A'.$sheet->{'maxrow'}}=$_;
 2382:         }
 2383:     }
 2384:     if ($changed) { 
 2385:         $sheet->{'f'} = \%f;
 2386:         &setformulas($sheet); 
 2387:     }
 2388: }
 2389: 
 2390: # ------------------------------------------------ Load data for one assessment
 2391: 
 2392: sub loadstudent{
 2393:     my ($sheet,$r,$c)=@_;
 2394:     my %constants=();
 2395:     my %formulas=&getformulas($sheet);
 2396:     $cachedassess=$sheet->{'uname'}.':'.$sheet->{'udom'};
 2397:     # Get ALL the student preformance data
 2398:     my @tmp = &Apache::lonnet::dump($sheet->{'cid'},
 2399:                                     $sheet->{'udom'},
 2400:                                     $sheet->{'uname'},
 2401:                                     undef);
 2402:     if ($tmp[0] !~ /^error:/) {
 2403:         %cachedstores = @tmp;
 2404:     }
 2405:     undef @tmp;
 2406:     # 
 2407:     my @assessdata=();
 2408:     foreach my $cell (keys(%formulas)) {
 2409:         my $value = $formulas{$cell};
 2410:         if(defined($c) && ($c->aborted())) {
 2411:             last;
 2412:         }
 2413: 	next if ($cell !~ /^A(\d+)/);
 2414:         my $row=$1;
 2415:         next if (($value =~ /^[!~-]/) || ($row==0));
 2416:         my ($usy,$ufn)=split(/__&&&\__/,$value);
 2417:         @assessdata=&exportsheet($sheet,$sheet->{'uname'},
 2418:                                  $sheet->{'udom'},
 2419:                                  'assesscalc',$usy,$ufn,$r);
 2420:         my $index=0;
 2421:         foreach my $col ('A','B','C','D','E','F','G','H','I','J','K','L','M',
 2422:                          'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
 2423:             if (defined($assessdata[$index])) {
 2424:                 if ($assessdata[$index]=~/\D/) {
 2425:                     $constants{$col.$row}="'".$assessdata[$index]."'";
 2426:                 } else {
 2427:                     $constants{$col.$row}=$assessdata[$index];
 2428:                 }
 2429:                 $formulas{$col.$row}='import' if ($col ne 'A');
 2430:             }
 2431:             $index++;
 2432:         }
 2433:     }
 2434:     $cachedassess='';
 2435:     undef %cachedstores;
 2436:     $sheet->{'f'} = \%formulas;
 2437:     &setformulas($sheet);
 2438:     &setconstants($sheet,\%constants);
 2439: }
 2440: 
 2441: # --------------------------------------------------- Load data for one student
 2442: #
 2443: sub loadcourse {
 2444:     my ($sheet,$r,$c)=@_;
 2445:     #
 2446:     my %constants=();
 2447:     my %formulas=&getformulas($sheet);
 2448:     #
 2449:     my $total=0;
 2450:     foreach (keys(%formulas)) {
 2451: 	if ($_=~/^A(\d+)/) {
 2452: 	    unless ($formulas{$_}=~/^[\!\~\-]/) { $total++; }
 2453:         }
 2454:     }
 2455:     my $now=0;
 2456:     my $since=time;
 2457:     $r->print(<<ENDPOP);
 2458: <script>
 2459:     popwin=open('','popwin','width=400,height=100');
 2460:     popwin.document.writeln('<html><body bgcolor="#FFFFFF">'+
 2461:       '<h3>Spreadsheet Calculation Progress</h3>'+
 2462:       '<form name=popremain>'+
 2463:       '<input type=text size=35 name=remaining value=Starting></form>'+
 2464:       '</body></html>');
 2465:     popwin.document.close();
 2466: </script>
 2467: ENDPOP
 2468:     $r->rflush();
 2469:     foreach (keys(%formulas)) {
 2470:         if(defined($c) && ($c->aborted())) {
 2471:             last;
 2472:         }
 2473: 	next if ($_!~/^A(\d+)/);
 2474:         my $row=$1;
 2475:         next if (($formulas{$_}=~/^[\!\~\-]/)  || ($row==0));
 2476:         my ($sname,$sdom) = split(':',$formulas{$_});
 2477:         my @studentdata=&exportsheet($sheet,$sname,$sdom,'studentcalc',
 2478:                                      undef,undef,$r);
 2479:         undef %userrdatas;
 2480:         $now++;
 2481:         $r->print('<script>popwin.document.popremain.remaining.value="'.
 2482:                   $now.'/'.$total.': '.int((time-$since)/$now*($total-$now)).
 2483:                   ' secs remaining";</script>');
 2484:         $r->rflush(); 
 2485:         #
 2486:         my $index=0;
 2487:         foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
 2488:                  'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') {
 2489:             if (defined($studentdata[$index])) {
 2490:                 my $col=$_;
 2491:                 if ($studentdata[$index]=~/\D/) {
 2492:                     $constants{$col.$row}="'".$studentdata[$index]."'";
 2493:                 } else {
 2494:                     $constants{$col.$row}=$studentdata[$index];
 2495:                 }
 2496:                 unless ($col eq 'A') { 
 2497:                     $formulas{$col.$row}='import';
 2498:                 }
 2499:             } 
 2500:             $index++;
 2501:         }
 2502:     }
 2503:     $sheet->{'f'}=\%formulas;
 2504:     &setformulas($sheet);
 2505:     &setconstants($sheet,\%constants);
 2506:     $r->print('<script>popwin.close()</script>');
 2507:     $r->rflush(); 
 2508: }
 2509: 
 2510: # ------------------------------------------------ Load data for one assessment
 2511: #
 2512: sub loadassessment {
 2513:     my ($sheet,$r,$c)=@_;
 2514: 
 2515:     my $uhome = $sheet->{'uhome'};
 2516:     my $uname = $sheet->{'uname'};
 2517:     my $udom  = $sheet->{'udom'};
 2518:     my $symb  = $sheet->{'usymb'};
 2519:     my $cid   = $sheet->{'cid'};
 2520:     my $cnum  = $sheet->{'cnum'};
 2521:     my $cdom  = $sheet->{'cdom'};
 2522:     my $chome = $sheet->{'chome'};
 2523: 
 2524:     my $namespace;
 2525:     unless ($namespace=$cid) { return ''; }
 2526:     # Get stored values
 2527:     my %returnhash=();
 2528:     if ($cachedassess eq $uname.':'.$udom) {
 2529:         #
 2530:         # get data out of the dumped stores
 2531:         # 
 2532:         my $version=$cachedstores{'version:'.$symb};
 2533:         my $scope;
 2534:         for ($scope=1;$scope<=$version;$scope++) {
 2535:             foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) {
 2536:                 $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_};
 2537:             } 
 2538:         }
 2539:     } else {
 2540:         #
 2541:         # restore individual
 2542:         #
 2543:         %returnhash = &Apache::lonnet::restore($symb,$namespace,$udom,$uname);
 2544:         for (my $version=1;$version<=$returnhash{'version'};$version++) {
 2545:             foreach (split(/\:/,$returnhash{$version.':keys'})) {
 2546:                 $returnhash{$_}=$returnhash{$version.':'.$_};
 2547:             } 
 2548:         }
 2549:     }
 2550:     #
 2551:     # returnhash now has all stores for this resource
 2552:     # convert all "_" to "." to be able to use libraries, multiparts, etc
 2553:     #
 2554:     # This is dumb.  It is also necessary :(
 2555:     my @oldkeys=keys %returnhash;
 2556:     #
 2557:     foreach my $name (@oldkeys) {
 2558:         my $value=$returnhash{$name};
 2559:         delete $returnhash{$name};
 2560:         $name=~s/\_/\./g;
 2561:         $returnhash{$name}=$value;
 2562:     }
 2563:     # initialize coursedata and userdata for this user
 2564:     undef %courseopt;
 2565:     undef %useropt;
 2566: 
 2567:     my $userprefix=$uname.'_'.$udom.'_';
 2568: 
 2569:     unless ($uhome eq 'no_host') { 
 2570:         # Get coursedata
 2571:         unless ((time-$courserdatas{$cid.'.last_cache'})<240) {
 2572:             my %Tmp = &Apache::lonnet::dump('resourcedata',$cdom,$cnum);
 2573:             $courserdatas{$cid}=\%Tmp;
 2574:             $courserdatas{$cid.'.last_cache'}=time;
 2575:         }
 2576:         while (my ($name,$value) = each(%{$courserdatas{$cid}})) {
 2577:             $courseopt{$userprefix.$name}=$value;
 2578:         }
 2579:         # Get userdata (if present)
 2580:         unless ((time-$userrdatas{$uname.'@'.$udom.'.last_cache'})<240) {
 2581:             my %Tmp = &Apache::lonnet::dump('resourcedata',$udom,$uname);
 2582:             $userrdatas{$cid} = \%Tmp;
 2583:             # Most of the time the user does not have a 'resourcedata.db' 
 2584:             # file.  We need to cache that we got nothing instead of bothering
 2585:             # with requesting it every time.
 2586:             $userrdatas{$uname.'@'.$udom.'.last_cache'}=time;
 2587:         }
 2588:         while (my ($name,$value) = each(%{$userrdatas{$cid}})) {
 2589:             $useropt{$userprefix.$name}=$value;
 2590:         }
 2591:     }
 2592:     # now courseopt, useropt initialized for this user and course
 2593:     # (used by parmval)
 2594:     #
 2595:     # Load keys for this assessment only
 2596:     #
 2597:     my %thisassess=();
 2598:     my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb);
 2599:     foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) {
 2600:         $thisassess{$_}=1;
 2601:     } 
 2602:     #
 2603:     # Load parameters
 2604:     #
 2605:     my %c=();
 2606:     if (tie(%parmhash,'GDBM_File',
 2607:             $sheet->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) {
 2608:         my %f=&getformulas($sheet);
 2609:         foreach my $cell (keys(%f))  {
 2610:             next if ($cell !~ /^A/);
 2611:             next if  ($f{$cell} =~/^[\!\~\-]/);
 2612:             if ($f{$cell}=~/^parameter/) {
 2613:                 if (defined($thisassess{$f{$cell}})) {
 2614:                     my $val       = &parmval($f{$cell},$sheet);
 2615:                     $c{$cell}     = $val;
 2616:                     $c{$f{$cell}} = $val;
 2617:                 }
 2618:             } else {
 2619:                 my $key=$f{$cell};
 2620:                 my $ckey=$key;
 2621:                 $key=~s/^stores\_/resource\./;
 2622:                 $key=~s/\_/\./g;
 2623:                 $c{$cell}=$returnhash{$key};
 2624:                 $c{$ckey}=$returnhash{$key};
 2625:             }
 2626:         }
 2627:         untie(%parmhash);
 2628:     }
 2629:     &setconstants($sheet,\%c);
 2630: }
 2631: 
 2632: # --------------------------------------------------------- Various form fields
 2633: 
 2634: sub textfield {
 2635:     my ($title,$name,$value)=@_;
 2636:     return "\n<p><b>$title:</b><br>".
 2637:         '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
 2638: }
 2639: 
 2640: sub hiddenfield {
 2641:     my ($name,$value)=@_;
 2642:     return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
 2643: }
 2644: 
 2645: sub selectbox {
 2646:     my ($title,$name,$value,%options)=@_;
 2647:     my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
 2648:     foreach (sort keys(%options)) {
 2649:         $selout.='<option value="'.$_.'"';
 2650:         if ($_ eq $value) { $selout.=' selected'; }
 2651:         $selout.='>'.$options{$_}.'</option>';
 2652:     }
 2653:     return $selout.'</select>';
 2654: }
 2655: 
 2656: # =============================================== Update information in a sheet
 2657: #
 2658: # Add new users or assessments, etc.
 2659: #
 2660: 
 2661: sub updatesheet {
 2662:     my ($sheet)=@_;
 2663:     if ($sheet->{'sheettype'} eq 'classcalc') {
 2664: 	return &updateclasssheet($sheet);
 2665:     } else {
 2666:         return &updatestudentassesssheet($sheet);
 2667:     }
 2668: }
 2669: 
 2670: # =================================================== Load the rows for a sheet
 2671: #
 2672: # Import the data for rows
 2673: #
 2674: 
 2675: sub loadrows {
 2676:     my ($sheet,$r)=@_;
 2677:     my $c = $r->connection;
 2678:     my $stype=$sheet->{'sheettype'};
 2679:     if ($stype eq 'classcalc') {
 2680: 	&loadcourse($sheet,$r,$c);
 2681:     } elsif ($stype eq 'studentcalc') {
 2682:         &loadstudent($sheet,$r,$c);
 2683:     } else {
 2684:         &loadassessment($sheet,$r,$c);
 2685:     }
 2686: }
 2687: 
 2688: # ======================================================= Forced recalculation?
 2689: 
 2690: sub checkthis {
 2691:     my ($keyname,$time)=@_;
 2692:     if (! exists($expiredates{$keyname})) {
 2693:         return 0;
 2694:     } else {
 2695:         return ($time<$expiredates{$keyname});
 2696:     }
 2697: }
 2698: 
 2699: sub forcedrecalc {
 2700:     my ($uname,$udom,$stype,$usymb)=@_;
 2701:     my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
 2702:     my $time=$oldsheets{$key.'.time'};
 2703:     if ($ENV{'form.forcerecalc'}) { return 1; }
 2704:     unless ($time) { return 1; }
 2705:     if ($stype eq 'assesscalc') {
 2706:         my $map=(split(/___/,$usymb))[0];
 2707:         if (&checkthis('::assesscalc:',$time) ||
 2708:             &checkthis('::assesscalc:'.$map,$time) ||
 2709:             &checkthis('::assesscalc:'.$usymb,$time) ||
 2710:             &checkthis($uname.':'.$udom.':assesscalc:',$time) ||
 2711:             &checkthis($uname.':'.$udom.':assesscalc:'.$map,$time) ||
 2712:             &checkthis($uname.':'.$udom.':assesscalc:'.$usymb,$time)) {
 2713:             return 1;
 2714:         }
 2715:     } else {
 2716:         if (&checkthis('::studentcalc:',$time) || 
 2717:             &checkthis($uname.':'.$udom.':studentcalc:',$time)) {
 2718: 	    return 1;
 2719:         }
 2720:     }
 2721:     return 0; 
 2722: }
 2723: 
 2724: # ============================================================== Export handler
 2725: # exportsheet
 2726: # returns the export row for a spreadsheet.
 2727: #
 2728: sub exportsheet {
 2729:     my ($sheet,$uname,$udom,$stype,$usymb,$fn,$r)=@_;
 2730:     my $flag = 0;
 2731:     $uname = $uname || $sheet->{'uname'};
 2732:     $udom  = $udom  || $sheet->{'udom'};
 2733:     $stype = $stype || $sheet->{'sheettype'};
 2734:     my @exportarr=();
 2735:     # This handles the assessment sheets for '_feedback', etc
 2736:     if (defined($usymb) && ($usymb=~/^\_(\w+)/) && 
 2737:         (!defined($fn) || $fn eq '')) {
 2738:         $fn='default_'.$1;
 2739:     }
 2740:     #
 2741:     # Check if cached
 2742:     #
 2743:     my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
 2744:     my $found='';
 2745:     if ($oldsheets{$key}) {
 2746:         foreach (split(/___&\___/,$oldsheets{$key})) {
 2747:             my ($name,$value)=split(/___=___/,$_);
 2748:             if ($name eq $fn) {
 2749:                 $found=$value;
 2750:             }
 2751:         }
 2752:     }
 2753:     unless ($found) {
 2754:         &cachedssheets($sheet,$uname,$udom);
 2755:         if ($oldsheets{$key}) {
 2756:             foreach (split(/___&\___/,$oldsheets{$key})) {
 2757:                 my ($name,$value)=split(/___=___/,$_);
 2758:                 if ($name eq $fn) {
 2759:                     $found=$value;
 2760:                 }
 2761:             } 
 2762:         }
 2763:     }
 2764:     #
 2765:     # Check if still valid
 2766:     #
 2767:     if ($found) {
 2768:         if (&forcedrecalc($uname,$udom,$stype,$usymb)) {
 2769:             $found='';
 2770:         }
 2771:     }
 2772:     if ($found) {
 2773:         #
 2774:         # Return what was cached
 2775:         #
 2776:         @exportarr=split(/___;___/,$found);
 2777:         return @exportarr;
 2778:     }
 2779:     #
 2780:     # Not cached
 2781:     #
 2782:     my ($newsheet)=&makenewsheet($uname,$udom,$stype,$usymb);
 2783:     &readsheet($newsheet,$fn);
 2784:     &updatesheet($newsheet);
 2785:     &loadrows($newsheet,$r);
 2786:     &calcsheet($newsheet); 
 2787:     @exportarr=&exportdata($newsheet);
 2788:     ##
 2789:     ## Store now
 2790:     ##
 2791:     #
 2792:     # load in the old value
 2793:     #
 2794:     my %currentlystored=();
 2795:     if ($stype eq 'studentcalc') {
 2796:         my @tmp = &Apache::lonnet::get('nohist_calculatedsheets',
 2797:                                        [$key],
 2798:                                        $sheet->{'cdom'},$sheet->{'cnum'});
 2799:         if ($tmp[0]!~/^error/) {
 2800:             # We only got one key, so we will access it directly.
 2801:             foreach (split('___&___',$tmp[1])) {
 2802:                 my ($key,$value) = split('___=___',$_);
 2803:                 $key = '' if (! defined($key));
 2804:                 $currentlystored{$key} = $value;
 2805:             }
 2806:         }
 2807:     } else {
 2808:         my @tmp = &Apache::lonnet::get('nohist_calculatedsheets_'.
 2809:                                        $sheet->{'cid'},[$key],
 2810:                                        $sheet->{'udom'},$sheet->{'uname'});
 2811:         if ($tmp[0]!~/^error/) {
 2812:             # We only got one key, so we will access it directly.
 2813:             foreach (split('___&___',$tmp[1])) {
 2814:                 my ($key,$value) = split('___=___',$_);
 2815:                 $key = '' if (! defined($key));
 2816:                 $currentlystored{$key} = $value;
 2817:             }
 2818:         }
 2819:     }
 2820:     #
 2821:     # Add the new line
 2822:     #
 2823:     $currentlystored{$fn}=join('___;___',@exportarr);
 2824:     #
 2825:     # Stick everything back together
 2826:     #
 2827:     my $newstore='';
 2828:     foreach (keys(%currentlystored)) {
 2829:         if ($newstore) { $newstore.='___&___'; }
 2830:         $newstore.=$_.'___=___'.$currentlystored{$_};
 2831:     }
 2832:     my $now=time;
 2833:     #
 2834:     # Store away the new value
 2835:     #
 2836:     my $timekey = $key.'.time';
 2837:     if ($stype eq 'studentcalc') {
 2838:         my $result = &Apache::lonnet::put('nohist_calculatedsheets',
 2839:                                           { $key     => $newstore,
 2840:                                             $timekey => $now },
 2841:                                           $sheet->{'cdom'},
 2842:                                           $sheet->{'cnum'});
 2843:     } else {
 2844:         my $result = &Apache::lonnet::put('nohist_calculatedsheets_'.$sheet->{'cid'},
 2845:                                           { $key     => $newstore,
 2846:                                             $timekey => $now },
 2847:                                           $sheet->{'udom'},
 2848:                                           $sheet->{'uname'});
 2849:     }
 2850:     return @exportarr;
 2851: }
 2852: 
 2853: # ============================================================ Expiration Dates
 2854: #
 2855: # Load previously cached student spreadsheets for this course
 2856: #
 2857: sub load_spreadsheet_expirationdates {
 2858:     undef %expiredates;
 2859:     my $cid=$ENV{'request.course.id'};
 2860:     my @tmp = &Apache::lonnet::dump('nohist_expirationdates',
 2861:                                     $ENV{'course.'.$cid.'.domain'},
 2862:                                     $ENV{'course.'.$cid.'.num'});
 2863:     if (lc($tmp[0]) !~ /^error/){
 2864:         %expiredates = @tmp;
 2865:     }
 2866: }
 2867: 
 2868: # ===================================================== Calculated sheets cache
 2869: #
 2870: # Load previously cached student spreadsheets for this course
 2871: #
 2872: 
 2873: sub cachedcsheets {
 2874:     my $cid=$ENV{'request.course.id'};
 2875:     my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets',
 2876:                                     $ENV{'course.'.$cid.'.domain'},
 2877:                                     $ENV{'course.'.$cid.'.num'});
 2878:     if ($tmp[0] !~ /^error/) {
 2879:         my %StupidTempHash = @tmp;
 2880:         while (my ($key,$value) = each %StupidTempHash) {
 2881:             $oldsheets{$key} = $value;
 2882:         }
 2883:     }
 2884: }
 2885: 
 2886: # ===================================================== Calculated sheets cache
 2887: #
 2888: # Load previously cached assessment spreadsheets for this student
 2889: #
 2890: 
 2891: sub cachedssheets {
 2892:     my ($sheet,$uname,$udom) = @_;
 2893:     $uname = $uname || $sheet->{'uname'};
 2894:     $udom  = $udom  || $sheet->{'udom'};
 2895:     if (! $loadedcaches{$uname.'_'.$udom}) {
 2896:         my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets',
 2897:                                         $sheet->{'udom'},
 2898:                                         $sheet->{'uname'});
 2899:         if ($tmp[0] !~ /^error/) {
 2900:             my %TempHash = @tmp;
 2901:             my $count = 0;
 2902:             while (my ($key,$value) = each %TempHash) {
 2903:                 $oldsheets{$key} = $value;
 2904:                 $count++;
 2905:             }
 2906:             $loadedcaches{$sheet->{'uname'}.'_'.$sheet->{'udom'}}=1;
 2907:         }
 2908:     }
 2909:     
 2910: }
 2911: 
 2912: # ===================================================== Calculated sheets cache
 2913: #
 2914: # Load previously cached assessment spreadsheets for this student
 2915: #
 2916: 
 2917: # ================================================================ Main handler
 2918: #
 2919: # Interactive call to screen
 2920: #
 2921: #
 2922: sub handler {
 2923:     my $r=shift;
 2924: 
 2925:     my ($sheettype) = ($r->uri=~/\/(\w+)$/);
 2926: 
 2927:     if (! exists($ENV{'form.Status'})) {
 2928:         $ENV{'form.Status'} = 'Active';
 2929:     }
 2930:     if ( ! exists($ENV{'form.output'}) || 
 2931:              ($sheettype ne 'classcalc' && 
 2932:               lc($ENV{'form.output'}) eq 'recursive excel')) {
 2933:         $ENV{'form.output'} = 'HTML';
 2934:     }
 2935:     #
 2936:     # Overload checking
 2937:     #
 2938:     # Check this server
 2939:     my $loaderror=&Apache::lonnet::overloaderror($r);
 2940:     if ($loaderror) { return $loaderror; }
 2941:     # Check the course homeserver
 2942:     $loaderror= &Apache::lonnet::overloaderror($r,
 2943:                       $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
 2944:     if ($loaderror) { return $loaderror; } 
 2945:     #
 2946:     # HTML Header
 2947:     #
 2948:     if ($r->header_only) {
 2949:         $r->content_type('text/html');
 2950:         $r->send_http_header;
 2951:         return OK;
 2952:     }
 2953:     #
 2954:     # Global directory configs
 2955:     #
 2956:     $includedir = $r->dir_config('lonIncludes');
 2957:     $tmpdir = $r->dir_config('lonDaemons').'/tmp/';
 2958:     #
 2959:     # Roles Checking
 2960:     #
 2961:     # Needs to be in a course
 2962:     if (! $ENV{'request.course.fn'}) { 
 2963:         # Not in a course, or not allowed to modify parms
 2964:         $ENV{'user.error.msg'}=
 2965:             $r->uri.":opa:0:0:Cannot modify spreadsheet";
 2966:         return HTTP_NOT_ACCEPTABLE; 
 2967:     }
 2968:     #
 2969:     # Get query string for limited number of parameters
 2970:     #
 2971:     &Apache::loncommon::get_unprocessed_cgi
 2972:         ($ENV{'QUERY_STRING'},['uname','udom','usymb','ufn','mapid','resid']);
 2973:     #
 2974:     # Deal with restricted student permissions 
 2975:     #
 2976:     if ($ENV{'request.role'} =~ /^st\./) {
 2977:         delete $ENV{'form.unewfield'}   if (exists($ENV{'form.unewfield'}));
 2978:         delete $ENV{'form.unewformula'} if (exists($ENV{'form.unewformula'}));
 2979:     }
 2980:     #
 2981:     # Look for special assessment spreadsheets - '_feedback', etc.
 2982:     #
 2983:     if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'} || 
 2984:                                              $ENV{'form.ufn'} eq '' || 
 2985:                                              $ENV{'form.ufn'} eq 'default')) {
 2986:         $ENV{'form.ufn'}='default_'.$1;
 2987:     }
 2988:     if (!$ENV{'form.ufn'} || $ENV{'form.ufn'} eq 'default') {
 2989:         $ENV{'form.ufn'}='course_default_'.$sheettype;
 2990:     }
 2991:     #
 2992:     # Interactive loading of specific sheet?
 2993:     #
 2994:     if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {
 2995:         $ENV{'form.ufn'}=$ENV{'form.loadthissheet'};
 2996:     }
 2997:     #
 2998:     # Determine the user name and domain for the sheet.
 2999:     my $aname;
 3000:     my $adom;
 3001:     unless ($ENV{'form.uname'}) {
 3002:         $aname=$ENV{'user.name'};
 3003:         $adom=$ENV{'user.domain'};
 3004:     } else {
 3005:         $aname=$ENV{'form.uname'};
 3006:         $adom=$ENV{'form.udom'};
 3007:     }
 3008:     #
 3009:     # Open page, try to prevent browser cache.
 3010:     #
 3011:     $r->content_type('text/html');
 3012:     $r->header_out('Cache-control','no-cache');
 3013:     $r->header_out('Pragma','no-cache');
 3014:     $r->send_http_header;
 3015:     #
 3016:     # Header....
 3017:     #
 3018:     $r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
 3019:     my $nothing = "''";
 3020:     if ($ENV{'browser.type'} eq 'explorer') {
 3021:         $nothing = "'javascript:void(0);'";
 3022:     }
 3023: 
 3024:     if ($ENV{'request.role'} !~ /^st\./) {
 3025:         $r->print(<<ENDSCRIPT);
 3026: <script language="JavaScript">
 3027: 
 3028:     var editwin;
 3029: 
 3030:     function celledit(cellname,cellformula) {
 3031:         var edit_text = '';
 3032:         // cellformula may contain less-than and greater-than symbols, so
 3033:         // we need to escape them?  
 3034:         edit_text +='<html><head><title>Cell Edit Window</title></head><body>';
 3035:         edit_text += '<form name="editwinform">';
 3036:         edit_text += '<center><h3>Cell '+cellname+'</h3>';
 3037:         edit_text += '<textarea name="newformula" cols="40" rows="6"';
 3038:         edit_text += ' wrap="off" >'+cellformula+'</textarea>';
 3039:         edit_text += '</br>';
 3040:         edit_text += '<input type="button" name="accept" value="Accept"';
 3041:         edit_text += ' onClick=\\\'javascript:';
 3042:         edit_text += 'opener.document.sheet.unewfield.value=';
 3043:         edit_text +=     '"'+cellname+'";';
 3044:         edit_text += 'opener.document.sheet.unewformula.value=';
 3045:         edit_text +=     'document.editwinform.newformula.value;';
 3046:         edit_text += 'opener.document.sheet.submit();';
 3047:         edit_text += 'self.close()\\\' />';
 3048:         edit_text += '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;';
 3049:         edit_text += '<input type="button" name="abort" ';
 3050:         edit_text +=     'value="Discard Changes"';
 3051:         edit_text += ' onClick="javascript:self.close()" />';
 3052:         edit_text += '</center></body></html>';
 3053: 
 3054:         if (editwin != null && !(editwin.closed) ) {
 3055:             editwin.close();
 3056:         }
 3057: 
 3058:         editwin = window.open($nothing,'CellEditWin','height=200,width=350,scrollbars=no,resizeable=yes,alwaysRaised=yes,dependent=yes',true);
 3059:         editwin.document.write(edit_text);
 3060:     }
 3061: 
 3062:     function changesheet(cn) {
 3063: 	document.sheet.unewfield.value=cn;
 3064:         document.sheet.unewformula.value='changesheet';
 3065:         document.sheet.submit();
 3066:     }
 3067: 
 3068:     function insertrow(cn) {
 3069: 	document.sheet.unewfield.value='insertrow';
 3070:         document.sheet.unewformula.value=cn;
 3071:         document.sheet.submit();
 3072:     }
 3073: 
 3074: </script>
 3075: ENDSCRIPT
 3076:     }
 3077:     $r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet').
 3078:               '<form action="'.$r->uri.'" name="sheet" method="post">');
 3079:     $r->print(&hiddenfield('uname',$ENV{'form.uname'}).
 3080:               &hiddenfield('udom',$ENV{'form.udom'}).
 3081:               &hiddenfield('usymb',$ENV{'form.usymb'}).
 3082:               &hiddenfield('unewfield','').
 3083:               &hiddenfield('unewformula',''));
 3084:     $r->rflush();
 3085:     #
 3086:     # Full recalc?
 3087:     #
 3088:     if ($ENV{'form.forcerecalc'}) {
 3089:         $r->print('<h4>Completely Recalculating Sheet ...</h4>');
 3090:         undef %spreadsheets;
 3091:         undef %courserdatas;
 3092:         undef %userrdatas;
 3093:         undef %defaultsheets;
 3094:         undef %rowlabel_cache;
 3095:     }
 3096:     # Read new sheet or modified worksheet
 3097:     my ($sheet)=&makenewsheet($aname,$adom,$sheettype,$ENV{'form.usymb'});
 3098:     #
 3099:     # Check user permissions
 3100:     if (($sheet->{'sheettype'} eq 'classcalc'       ) || 
 3101:         ($sheet->{'uname'}     ne $ENV{'user.name'} ) ||
 3102:         ($sheet->{'udom'}      ne $ENV{'user.domain'})) {
 3103:         unless (&Apache::lonnet::allowed('vgr',$sheet->{'cid'})) {
 3104:             $r->print('<h1>Access Permission Denied</h1>'.
 3105:                       '</form></body></html>');
 3106:             return OK;
 3107:         }
 3108:     }
 3109:     # Print out user information
 3110:     $r->print('<h2>'.$sheet->{'coursedesc'}.'</h2>');
 3111:     if ($sheet->{'sheettype'} ne 'classcalc') {
 3112:         $r->print('<h2>'.&gettitle($sheet).'</h2><p>');
 3113:     }
 3114:     if ($sheet->{'sheettype'} eq 'assesscalc') {
 3115:         $r->print('<b>User:</b> '.$sheet->{'uname'}.
 3116:                   '<br /><b>Domain:</b> '.$sheet->{'udom'}.'<br />');
 3117:     }
 3118:     if ($sheet->{'sheettype'} eq 'studentcalc' || 
 3119:         $sheet->{'sheettype'} eq 'assesscalc') {
 3120:         $r->print('<b>Section/Group:</b>'.$sheet->{'csec'}.'</p>');
 3121:     } 
 3122:     #
 3123:     # If a new formula had been entered, go from work copy
 3124:     if ($ENV{'form.unewfield'}) {
 3125:         $r->print('<h2>Modified Workcopy</h2>');
 3126:         $ENV{'form.unewformula'}=~s/\'/\"/g;
 3127:         $r->print('<p>Cell '.$ENV{'form.unewfield'}.' = <pre>');
 3128:         $r->print(&HTML::Entities::encode($ENV{'form.unewformula'}).
 3129:                   '</pre></p>');
 3130:         $sheet->{'filename'} = $ENV{'form.ufn'};
 3131:         &tmpread($sheet,$ENV{'form.unewfield'},$ENV{'form.unewformula'});
 3132:     } elsif ($ENV{'form.saveas'}) {
 3133:         $sheet->{'filename'} = $ENV{'form.ufn'};
 3134:         &tmpread($sheet);
 3135:     } else {
 3136:         &readsheet($sheet,$ENV{'form.ufn'});
 3137:     }
 3138:     # Additional options
 3139:     if ($sheet->{'sheettype'} eq 'assesscalc') {
 3140:         $r->print('<p><font size=+2>'.
 3141:                   '<a href="/adm/studentcalc?'.
 3142:                   'uname='.$sheet->{'uname'}.
 3143:                   '&udom='.$sheet->{'udom'}.'">'.
 3144:                   'Level up: Student Sheet</a></font></p>');
 3145:     }
 3146:     if (($sheet->{'sheettype'} eq 'studentcalc') && 
 3147:         (&Apache::lonnet::allowed('vgr',$sheet->{'cid'}))) {
 3148:         $r->print ('<p><font size=+2><a href="/adm/classcalc">'.
 3149:                    'Level up: Course Sheet</a></font></p>');
 3150:     }
 3151:     # Recalc button
 3152:     $r->print('<br />'.
 3153:               '<input type="submit" name="forcerecalc" '.
 3154:               'value="Completely Recalculate Sheet"></p>');
 3155:     # Save dialog
 3156:     if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
 3157:         my $fname=$ENV{'form.ufn'};
 3158:         $fname=~s/\_[^\_]+$//;
 3159:         if ($fname eq 'default') { $fname='course_default'; }
 3160:         $r->print('<input type=submit name=saveas value="Save as ...">'.
 3161:                   '<input type=text size=20 name=newfn value="'.$fname.'">'.
 3162:                   'make default: <input type=checkbox name="makedefufn"><p>');
 3163:     }
 3164:     $r->print(&hiddenfield('ufn',$sheet->{'filename'}));
 3165:     # Load dialog
 3166:     if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
 3167:         $r->print('<p><input type=submit name=load value="Load ...">'.
 3168:                   '<select name="loadthissheet">'.
 3169:                   '<option name="default">Default</option>');
 3170:         foreach (&othersheets($sheet)) {
 3171:             $r->print('<option name="'.$_.'"');
 3172:             if ($ENV{'form.ufn'} eq $_) {
 3173:                 $r->print(' selected');
 3174:             }
 3175:             $r->print('>'.$_.'</option>');
 3176:         } 
 3177:         $r->print('</select><p>');
 3178:         if ($sheet->{'sheettype'} eq 'studentcalc') {
 3179:             &setothersheets($sheet,
 3180:                             &othersheets($sheet,'assesscalc'));
 3181:         }
 3182:     }
 3183:     #
 3184:     # Set up caching mechanisms
 3185:     #
 3186:     &load_spreadsheet_expirationdates();
 3187:     # Clear out old caches if we have not seen this class before.
 3188:     if (exists($oldsheets{'course'}) &&
 3189:         $oldsheets{'course'} ne $sheet->{'cid'}) {
 3190:         undef %oldsheets;
 3191:         undef %loadedcaches;
 3192:     }
 3193:     $oldsheets{'course'} = $sheet->{'cid'};
 3194:     #
 3195:     if ($sheet->{'sheettype'} eq 'classcalc') {
 3196:         $r->print("Loading previously calculated student sheets ...\n");
 3197:         $r->rflush();
 3198:         &cachedcsheets();
 3199:     } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
 3200:         $r->print("Loading previously calculated assessment sheets ...\n");
 3201:         $r->rflush();
 3202:         &cachedssheets($sheet);
 3203:     }
 3204:     # Update sheet, load rows
 3205:     $r->print("Loaded sheet(s), updating rows ...<br>\n");
 3206:     $r->rflush();
 3207:     #
 3208:     &updatesheet($sheet);
 3209:     $r->print("Updated rows, loading row data ...\n");
 3210:     $r->rflush();
 3211:     #
 3212:     &loadrows($sheet,$r);
 3213:     $r->print("Loaded row data, calculating sheet ...<br>\n");
 3214:     $r->rflush();
 3215:     #
 3216:     my $calcoutput=&calcsheet($sheet);
 3217:     $r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');
 3218:     # See if something to save
 3219:     if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
 3220:         my $fname='';
 3221:         if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) {
 3222:             $fname=~s/\W/\_/g;
 3223:             if ($fname eq 'default') { $fname='course_default'; }
 3224:             $fname.='_'.$sheet->{'sheettype'};
 3225:             $sheet->{'filename'} = $fname;
 3226:             $ENV{'form.ufn'}=$fname;
 3227:             $r->print('<p>Saving spreadsheet: '.
 3228:                       &writesheet($sheet,$ENV{'form.makedefufn'}).
 3229:                       '<p>');
 3230:         }
 3231:     }
 3232:     #
 3233:     # Write the modified worksheet
 3234:     $r->print('<b>Current sheet:</b> '.$sheet->{'filename'}.'</p>');
 3235:     &tmpwrite($sheet);
 3236:     if ($sheet->{'sheettype'} eq 'assesscalc') {
 3237:         $r->print('<p>Show rows with empty A column: ');
 3238:     } else {
 3239:         $r->print('<p>Show empty rows: ');
 3240:     }
 3241:     #
 3242:     $r->print(&hiddenfield('userselhidden','true').
 3243:               '<input type="checkbox" name="showall" onClick="submit()"');
 3244:     #
 3245:     if ($ENV{'form.showall'}) { 
 3246:         $r->print(' checked'); 
 3247:     } else {
 3248:         unless ($ENV{'form.userselhidden'}) {
 3249:             unless 
 3250:                 ($ENV{'course.'.$sheet->{'cid'}.'.hideemptyrows'} eq 'yes') {
 3251:                     $r->print(' checked');
 3252:                     $ENV{'form.showall'}=1;
 3253:                 }
 3254:         }
 3255:     }
 3256:     $r->print('>');
 3257:     #
 3258:     # CSV format checkbox (classcalc sheets only)
 3259:     $r->print(' Output as <select name="output" size="1" onClick="submit()">'.
 3260:               "\n");
 3261:     foreach my $mode (qw/HTML CSV Excel/) {
 3262:         $r->print('<option value="'.$mode.'"');
 3263:         if ($ENV{'form.output'} eq $mode) {
 3264:             $r->print(' selected ');
 3265:         } 
 3266:         $r->print('>'.$mode.'</option>'."\n");
 3267:     }
 3268: #
 3269: #    Mulit-sheet excel takes too long and does not work at all for large
 3270: #    classes.  Future inclusion of this option may be possible with the
 3271: #    Spreadsheet::WriteExcel::Big and speed improvements.
 3272: #
 3273: #    if ($sheet->{'sheettype'} eq 'classcalc') {
 3274: #        $r->print('<option value="recursive excel"');
 3275: #        if ($ENV{'form.output'} eq 'recursive excel') {
 3276: #            $r->print(' selected ');
 3277: #        } 
 3278: #        $r->print(">Multi-Sheet Excel</option>\n");
 3279: #    }
 3280:     $r->print("</select>\n");
 3281:     #
 3282:     if ($sheet->{'sheettype'} eq 'classcalc') {
 3283:         $r->print('&nbsp;Student Status: '.
 3284:                   &Apache::lonhtmlcommon::StatusOptions
 3285:                   ($ENV{'form.Status'},'sheet'));
 3286:     }
 3287:     #
 3288:     # Buttons to insert rows
 3289: #    $r->print(<<ENDINSERTBUTTONS);
 3290: #<br>
 3291: #<input type='button' onClick='insertrow("top");' 
 3292: #value='Insert Row Top'>
 3293: #<input type='button' onClick='insertrow("bottom");' 
 3294: #value='Insert Row Bottom'><br>
 3295: #ENDINSERTBUTTONS
 3296:     # Print out sheet
 3297:     &outsheet($sheet,$r);
 3298:     $r->print('</form></body></html>');
 3299:     #  Done
 3300:     return OK;
 3301: }
 3302: 
 3303: 1;
 3304: __END__
 3305: 
 3306: 

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