Annotation of loncom/interface/lonspreadsheet.pm, revision 1.124

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

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