# # $Id: lonspreadsheet.pm,v 1.119 2002/10/21 17:59:36 matthew Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # The LearningOnline Network with CAPA # Spreadsheet/Grades Display Handler # # POD required stuff: =head1 NAME lonspreadsheet =head1 SYNOPSIS Spreadsheet interface to internal LON-CAPA data =head1 DESCRIPTION Lonspreadsheet provides course coordinators the ability to manage their students grades online. The students are able to view their own grades, but not the grades of their peers. The spreadsheet is highly customizable, offering the ability to use Perl code to manipulate data, as well as many built-in functions. =head2 Functions available to user of lonspreadsheet =over 4 =cut package Apache::lonspreadsheet; use strict; use Safe; use Safe::Hole; use Opcode; use Apache::lonnet; use Apache::Constants qw(:common :http); use GDBM_File; use HTML::TokeParser; use Apache::lonhtmlcommon; use Apache::loncoursedata; # # Caches for coursewide information # my %Section; # # Caches for previously calculated spreadsheets # my %oldsheets; my %loadedcaches; my %expiredates; # # Cache for stores of an individual user # my $cachedassess; my %cachedstores; # # These cache hashes need to be independent of user, resource and course # (user and course can/should be in the keys) # my %spreadsheets; my %courserdatas; my %userrdatas; my %defaultsheets; my %updatedata; # # These global hashes are dependent on user, course and resource, # and need to be initialized every time when a sheet is calculated # my %courseopt; my %useropt; my %parmhash; # # Some hashes for stats on timing and performance # my %starttimes; my %usedtimes; my %numbertimes; # Stuff that only the screen handler can know my $includedir; my $tmpdir; # ============================================================================= # ===================================== Implements an instance of a spreadsheet ## ## mask - used to reside in the safe space. ## sub mask { my ($lower,$upper)=@_; $lower=~/([A-Za-z]|\*)(\d+|\*)/; my $la=$1; my $ld=$2; $upper=~/([A-Za-z]|\*)(\d+|\*)/; my $ua=$1; my $ud=$2; my $alpha=''; my $num=''; if (($la eq '*') || ($ua eq '*')) { $alpha='[A-Za-z]'; } else { if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) || ($la=~/[a-z]/) && ($ua=~/[a-z]/)) { $alpha='['.$la.'-'.$ua.']'; } else { $alpha='['.$la.'-Za-'.$ua.']'; } } if (($ld eq '*') || ($ud eq '*')) { $num='\d+'; } else { if (length($ld)!=length($ud)) { $num.='('; foreach ($ld=~m/\d/g) { $num.='['.$_.'-9]'; } if (length($ud)-length($ld)>1) { $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}'; } $num.='|'; foreach ($ud=~m/\d/g) { $num.='[0-'.$_.']'; } $num.=')'; } else { my @lda=($ld=~m/\d/g); my @uda=($ud=~m/\d/g); my $i; my $j=0; my $notdone=1; for ($i=0;($i<=$#lda)&&($notdone);$i++) { if ($lda[$i]==$uda[$i]) { $num.=$lda[$i]; $j=$i; } else { $notdone=0; } } if ($j<$#lda-1) { $num.='('.$lda[$j+1]; for ($i=$j+2;$i<=$#lda;$i++) { $num.='['.$lda[$i].'-9]'; } if ($uda[$j+1]-$lda[$j+1]>1) { $num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'. ($#lda-$j-1).'}'; } $num.='|'.$uda[$j+1]; for ($i=$j+2;$i<=$#uda;$i++) { $num.='[0-'.$uda[$i].']'; } $num.=')'; } else { if ($lda[$#lda]!=$uda[$#uda]) { $num.='['.$lda[$#lda].'-'.$uda[$#uda].']'; } } } } return '^'.$alpha.$num."\$"; } sub initsheet { my $safeeval = new Safe(shift); my $safehole = new Safe::Hole; $safeeval->permit("entereval"); $safeeval->permit(":base_math"); $safeeval->permit("sort"); $safeeval->deny(":base_io"); $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); $safehole->wrap(\&Apache::lonspreadsheet::mask,$safeeval,'&mask'); $safehole->wrap(\&Apache::lonspreadsheet::templaterow,$safeeval,'&templaterow'); $safeeval->share('$@'); my $code=<<'ENDDEFS'; # ---------------------------------------------------- Inside of the safe space # # f: formulas # t: intermediate format (variable references expanded) # v: output values # c: preloaded constants (A-column) # rl: row label # os: other spreadsheets (for student spreadsheet only) undef %sheet_values; # Holds the (computed, final) values for the sheet # This is only written to by &calc, the spreadsheet computation routine. # It is read by many functions undef %t; # Holds the values of the spreadsheet temporarily. Set in &sett, # which does the translation of strings like C5 into the value in C5. # Used in &calc - %t holds the values that are actually eval'd. undef %f; # Holds the formulas for each cell. This is the users # (spreadsheet authors) data for each cell. # set by &setformulas and returned by &getformulas # &setformulas is called by &readsheet, &tmpread, &updateclasssheet, # &updatestudentassesssheet, &loadstudent, &loadcourse # &getformulas is called by &writesheet, &tmpwrite, &updateclasssheet, # &updatestudentassesssheet, &loadstudent, &loadcourse, &loadassessment, undef %c; # Holds the constants for a sheet. In the assessment # sheets, this is the A column. Used in &MINPARM, &MAXPARM, &expandnamed, # &sett, and &setconstants. There is no &getconstants. # &setconstants is called by &loadstudent, &loadcourse, &load assessment, undef %rowlabel; # Holds the 'prefix' for each row. Set by &setrowlabels. # &setrowlabels is called by &updateclasssheet, &updatestudentassesssheet, undef @os; # Holds the names of other spreadsheets - this is used to specify # the spreadsheets that are available for the assessment sheet. # Set by &setothersheets. &setothersheets is called by &handler. A # related subroutine is &othersheets. $maxrow = 0; $sheettype = ''; # filename/reference of the sheet $filename = ''; # user data $uname = ''; $uhome = ''; $udom = ''; # course data $csec = ''; $chome= ''; $cnum = ''; $cdom = ''; $cid = ''; $coursefilename = ''; # symb $usymb = ''; # error messages $errormsg = ''; #------------------------------------------------------- =item UWCALC(hashname,modules,units,date) returns the proportion of the module weights not previously completed by the student. =over 4 =item hashname name of the hash the module dates have been inserted into =item modules reference to a cell which contains a comma deliminated list of modules covered by the assignment. =item units reference to a cell which contains a comma deliminated list of module weights with respect to the assignment =item date reference to a cell which contains the date the assignment was completed. =back =cut #------------------------------------------------------- sub UWCALC { my ($hashname,$modules,$units,$date) = @_; my @Modules = split(/,/,$modules); my @Units = split(/,/,$units); my $total_weight; foreach (@Units) { $total_weight += $_; } my $usum=0; for (my $i=0; $i<=$#Modules; $i++) { if (&HASH($hashname,$Modules[$i]) eq $date) { $usum += $Units[$i]; } } return $usum/$total_weight; } #------------------------------------------------------- =item CDLSUM(list) returns the sum of the elements in a cell which contains a Comma Deliminate List of numerical values. 'list' is a reference to a cell which contains a comma deliminated list. =cut #------------------------------------------------------- sub CDLSUM { my ($list)=@_; my $sum; foreach (split/,/,$list) { $sum += $_; } return $sum; } #------------------------------------------------------- =item CDLITEM(list,index) returns the item at 'index' in a Comma Deliminated List. =over 4 =item list reference to a cell which contains a comma deliminated list. =item index the Perl index of the item requested (first element in list has an index of 0) =back =cut #------------------------------------------------------- sub CDLITEM { my ($list,$index)=@_; my @Temp = split/,/,$list; return $Temp[$index]; } #------------------------------------------------------- =item CDLHASH(name,key,value) loads a comma deliminated list of keys into the hash 'name', all with a value of 'value'. =over 4 =item name name of the hash. =item key (a pointer to) a comma deliminated list of keys. =item value a single value to be entered for each key. =back =cut #------------------------------------------------------- sub CDLHASH { my ($name,$key,$value)=@_; my @Keys; my @Values; # Check to see if we have multiple $key values if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { my $keymask = &mask($key); # Assume the keys are addresses my @Temp = grep /$keymask/,keys(%sheet_values); @Keys = $sheet_values{@Temp}; } else { $Keys[0]= $key; } my @Temp; foreach $key (@Keys) { @Temp = (@Temp, split/,/,$key); } @Keys = @Temp; if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { my $valmask = &mask($value); my @Temp = grep /$valmask/,keys(%sheet_values); @Values =$sheet_values{@Temp}; } else { $Values[0]= $value; } $value = $Values[0]; # Add values to hash for (my $i = 0; $i<=$#Keys; $i++) { my $key = $Keys[$i]; if (! exists ($hashes{$name}->{$key})) { $hashes{$name}->{$key}->[0]=$value; } else { my @Temp = sort(@{$hashes{$name}->{$key}},$value); $hashes{$name}->{$key} = \@Temp; } } return "hash '$name' updated"; } #------------------------------------------------------- =item GETHASH(name,key,index) returns the element in hash 'name' reference by the key 'key', at index 'index' in the values list. =cut #------------------------------------------------------- sub GETHASH { my ($name,$key,$index)=@_; if (! defined($index)) { $index = 0; } if ($key =~ /^[A-z]\d+$/) { $key = $sheet_values{$key}; } return $hashes{$name}->{$key}->[$index]; } #------------------------------------------------------- =item CLEARHASH(name) clears all the values from the hash 'name' =item CLEARHASH(name,key) clears all the values from the hash 'name' associated with the given key. =cut #------------------------------------------------------- sub CLEARHASH { my ($name,$key)=@_; if (defined($key)) { if (exists($hashes{$name}->{$key})) { $hashes{$name}->{$key}=undef; return "hash '$name' key '$key' cleared"; } } else { if (exists($hashes{$name})) { $hashes{$name}=undef; return "hash '$name' cleared"; } } return "Error in clearing hash"; } #------------------------------------------------------- =item HASH(name,key,value) loads values into an internal hash. If a key already has a value associated with it, the values are sorted numerically. =item HASH(name,key) returns the 0th value in the hash 'name' associated with 'key'. =cut #------------------------------------------------------- sub HASH { my ($name,$key,$value)=@_; my @Keys; undef @Keys; my @Values; # Check to see if we have multiple $key values if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { my $keymask = &mask($key); # Assume the keys are addresses my @Temp = grep /$keymask/,keys(%sheet_values); @Keys = $sheet_values{@Temp}; } else { $Keys[0]= $key; } # If $value is empty, return the first value associated # with the first key. if (! $value) { return $hashes{$name}->{$Keys[0]}->[0]; } # Check to see if we have multiple $value(s) if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { my $valmask = &mask($value); my @Temp = grep /$valmask/,keys(%sheet_values); @Values =$sheet_values{@Temp}; } else { $Values[0]= $value; } # Add values to hash for (my $i = 0; $i<=$#Keys; $i++) { my $key = $Keys[$i]; my $value = ($i<=$#Values ? $Values[$i] : $Values[0]); if (! exists ($hashes{$name}->{$key})) { $hashes{$name}->{$key}->[0]=$value; } else { my @Temp = sort(@{$hashes{$name}->{$key}},$value); $hashes{$name}->{$key} = \@Temp; } } return $Values[-1]; } #------------------------------------------------------- =item NUM(range) returns the number of items in the range. =cut #------------------------------------------------------- sub NUM { my $mask=mask(@_); my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1; return $num; } sub BIN { my ($low,$high,$lower,$upper)=@_; my $mask=mask($lower,$upper); my $num=0; foreach (grep /$mask/,keys(%sheet_values)) { if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) { $num++; } } return $num; } #------------------------------------------------------- =item SUM(range) returns the sum of items in the range. =cut #------------------------------------------------------- sub SUM { my $mask=mask(@_); my $sum=0; foreach (grep /$mask/,keys(%sheet_values)) { $sum+=$sheet_values{$_}; } return $sum; } #------------------------------------------------------- =item MEAN(range) compute the average of the items in the range. =cut #------------------------------------------------------- sub MEAN { my $mask=mask(@_); my $sum=0; my $num=0; foreach (grep /$mask/,keys(%sheet_values)) { $sum+=$sheet_values{$_}; $num++; } if ($num) { return $sum/$num; } else { return undef; } } #------------------------------------------------------- =item STDDEV(range) compute the standard deviation of the items in the range. =cut #------------------------------------------------------- sub STDDEV { my $mask=mask(@_); my $sum=0; my $num=0; foreach (grep /$mask/,keys(%sheet_values)) { $sum+=$sheet_values{$_}; $num++; } unless ($num>1) { return undef; } my $mean=$sum/$num; $sum=0; foreach (grep /$mask/,keys(%sheet_values)) { $sum+=($sheet_values{$_}-$mean)**2; } return sqrt($sum/($num-1)); } #------------------------------------------------------- =item PROD(range) compute the product of the items in the range. =cut #------------------------------------------------------- sub PROD { my $mask=mask(@_); my $prod=1; foreach (grep /$mask/,keys(%sheet_values)) { $prod*=$sheet_values{$_}; } return $prod; } #------------------------------------------------------- =item MAX(range) compute the maximum of the items in the range. =cut #------------------------------------------------------- sub MAX { my $mask=mask(@_); my $max='-'; foreach (grep /$mask/,keys(%sheet_values)) { unless ($max) { $max=$sheet_values{$_}; } if (($sheet_values{$_}>$max) || ($max eq '-')) { $max=$sheet_values{$_}; } } return $max; } #------------------------------------------------------- =item MIN(range) compute the minimum of the items in the range. =cut #------------------------------------------------------- sub MIN { my $mask=mask(@_); my $min='-'; foreach (grep /$mask/,keys(%sheet_values)) { unless ($max) { $max=$sheet_values{$_}; } if (($sheet_values{$_}<$min) || ($min eq '-')) { $min=$sheet_values{$_}; } } return $min; } #------------------------------------------------------- =item SUMMAX(num,lower,upper) compute the sum of the largest 'num' items in the range from 'lower' to 'upper' =cut #------------------------------------------------------- sub SUMMAX { my ($num,$lower,$upper)=@_; my $mask=mask($lower,$upper); my @inside=(); foreach (grep /$mask/,keys(%sheet_values)) { push (@inside,$sheet_values{$_}); } @inside=sort(@inside); my $sum=0; my $i; for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { $sum+=$inside[$i]; } return $sum; } #------------------------------------------------------- =item SUMMIN(num,lower,upper) compute the sum of the smallest 'num' items in the range from 'lower' to 'upper' =cut #------------------------------------------------------- sub SUMMIN { my ($num,$lower,$upper)=@_; my $mask=mask($lower,$upper); my @inside=(); foreach (grep /$mask/,keys(%sheet_values)) { $inside[$#inside+1]=$sheet_values{$_}; } @inside=sort(@inside); my $sum=0; my $i; for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { $sum+=$inside[$i]; } return $sum; } #------------------------------------------------------- =item MINPARM(parametername) Returns the minimum value of the parameters matching the parametername. parametername should be a string such as 'duedate'. =cut #------------------------------------------------------- sub MINPARM { my ($expression) = @_; my $min = undef; study($expression); foreach $parameter (keys(%c)) { next if ($parameter !~ /$expression/); if ((! defined($min)) || ($min > $c{$parameter})) { $min = $c{$parameter} } } return $min; } #------------------------------------------------------- =item MAXPARM(parametername) Returns the maximum value of the parameters matching the input parameter name. parametername should be a string such as 'duedate'. =cut #------------------------------------------------------- sub MAXPARM { my ($expression) = @_; my $max = undef; study($expression); foreach $parameter (keys(%c)) { next if ($parameter !~ /$expression/); if ((! defined($min)) || ($max < $c{$parameter})) { $max = $c{$parameter} } } return $max; } #-------------------------------------------------------- sub expandnamed { my $expression=shift; if ($expression=~/^\&/) { my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/); my @vars=split(/\W+/,$formula); my %values=(); undef %values; foreach ( @vars ) { my $varname=$_; if ($varname=~/\D/) { $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge; $varname=~s/$var/\(\\w\+\)/g; foreach (keys(%c)) { if ($_=~/$varname/) { $values{$1}=1; } } } } if ($func eq 'EXPANDSUM') { my $result=''; foreach (keys(%values)) { my $thissum=$formula; $thissum=~s/$var/$_/g; $result.=$thissum.'+'; } $result=~s/\+$//; return $result; } else { return 0; } } else { # it is not a function, so it is a parameter name # We should do the following: # 1. Take the list of parameter names # 2. look through the list for ones that match the parameter we want # 3. If there are no collisions, return the one that matches # 4. If there is a collision, return 'bad parameter name error' my $returnvalue = ''; my @matches = (); $#matches = -1; study $expression; foreach $parameter (keys(%c)) { push @matches,$parameter if ($parameter =~ /$expression/); } if ($#matches == 0) { $returnvalue = '$c{\''.$matches[0].'\'}'; } elsif ($#matches > 0) { # more than one match. Look for a concise one $returnvalue = "'non-unique parameter name : $expression'"; foreach (@matches) { if (/^$expression$/) { $returnvalue = '$c{\''.$_.'\'}'; } } } else { $returnvalue = "'bad parameter name : $expression'"; } return $returnvalue; } } sub sett { %t=(); my $pattern=''; if ($sheettype eq 'assesscalc') { $pattern='A'; } else { $pattern='[A-Z]'; } # Deal with the template row foreach (keys(%f)) { next if ($_!~/template\_(\w)/); my $col=$1; next if ($col=~/^$pattern/); foreach (keys(%f)) { next if ($_!~/A(\d+)/); my $trow=$1; next if (! $trow); # Get the name of this cell my $lb=$col.$trow; # Grab the template declaration $t{$lb}=$f{'template_'.$col}; # Replace '#' with the row number $t{$lb}=~s/\#/$trow/g; # Replace '....' with ',' $t{$lb}=~s/\.\.+/\,/g; # Replace 'A0' with the value from 'A0' $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; # Replace parameters $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; } } # Deal with the normal cells foreach (keys(%f)) { if (exists($f{$_}) && ($_!~/template\_/)) { my $matches=($_=~/^$pattern(\d+)/); if (($matches) && ($1)) { unless ($f{$_}=~/^\!/) { $t{$_}=$c{$_}; } } else { $t{$_}=$f{$_}; $t{$_}=~s/\.\.+/\,/g; $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; } } } # For inserted lines, [B-Z] is also valid unless ($sheettype eq 'assesscalc') { foreach (keys(%f)) { if ($_=~/[B-Z](\d+)/) { if ($f{'A'.$1}=~/^[\~\-]/) { $t{$_}=$f{$_}; $t{$_}=~s/\.\.+/\,/g; $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; } } } } # For some reason 'A0' gets special treatment... This seems superfluous # but I imagine it is here for a reason. $t{'A0'}=$f{'A0'}; $t{'A0'}=~s/\.\.+/\,/g; $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; } sub calc { undef %sheet_values; &sett(); my $notfinished=1; my $lastcalc=''; my $depth=0; while ($notfinished) { $notfinished=0; foreach (keys(%t)) { my $old=$sheet_values{$_}; $sheet_values{$_}=eval $t{$_}; if ($@) { undef %sheet_values; return $_.': '.$@; } if ($sheet_values{$_} ne $old) { $notfinished=1; $lastcalc=$_; } } $depth++; if ($depth>100) { undef %sheet_values; return $lastcalc.': Maximum calculation depth exceeded'; } } return ''; } # # This is actually used for the student spreadsheet, not the assessment sheet # Do not be fooled by the name! # sub outrowassess { # $n is the current row number my $n=shift; my @cols=(); if ($n) { my ($usy,$ufn)=split(/__&&&\__/,$f{'A'.$n}); if ($rowlabel{$usy}) { $cols[0]=$rowlabel{$usy}.'
'. ''; } else { $cols[0]='Export'; } foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', 'a','b','c','d','e','f','g','h','i','j','k','l','m', 'n','o','p','q','r','s','t','u','v','w','x','y','z') { my $fm=$f{$_.$n}; $fm=~s/[\'\"]/\&\#34;/g; push(@cols,"'$_$n','$fm'".'___eq___'.$sheet_values{$_.$n}); } return @cols; } sub outrow { my $n=shift; my @cols=(); if ($n) { $cols[0]=$rowlabel{$f{'A'.$n}}; } else { $cols[0]='Export'; } foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', 'a','b','c','d','e','f','g','h','i','j','k','l','m', 'n','o','p','q','r','s','t','u','v','w','x','y','z') { my $fm=$f{$_.$n}; $fm=~s/[\'\"]/\&\#34;/g; push(@cols,"'$_$n','$fm'".'___eq___'.$sheet_values{$_.$n}); } return @cols; } sub exportrowa { my @exportarray=(); foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { push(@exportarray,$sheet_values{$_.'0'}); } return @exportarray; } sub templaterow { my @cols=(); $cols[0]='Template'; foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', 'a','b','c','d','e','f','g','h','i','j','k','l','m', 'n','o','p','q','r','s','t','u','v','w','x','y','z') { my $fm=$f{'template_'.$_}; $fm=~s/[\'\"]/\&\#34;/g; push(@cols,"'template_$_','$fm'".'___eq___'.$fm); } return @cols; } # ------------------------------------------- End of "Inside of the safe space" ENDDEFS $safeeval->reval($code); return $safeeval; } # ------------------------------------------------ Add or change formula values sub setformulas { my ($sheet)=shift; %{$sheet->{'safe'}->varglob('f')}=%{$sheet->{'f'}}; } # ------------------------------------------------ Add or change formula values sub setconstants { my ($sheet)=shift; return %{$sheet->{'safe'}->varglob('c')}=%{$sheet->{'constants'}}; } # --------------------------------------------- Set names of other spreadsheets sub setothersheets { my $sheet = shift; my @othersheets = @_; $sheet->{'othersheets'} = \@othersheets; @{$sheet->{'safe'}->varglob('os')}=@othersheets; return; } # ------------------------------------------------ Add or change formula values sub setrowlabels { my $sheet=shift; %{$sheet->{'safe'}->varglob('rowlabel')}=%{$sheet->{'rowlabel'}}; } # ------------------------------------------------------- Calculate spreadsheet sub calcsheet { my $sheet=shift; return $sheet->{'safe'}->reval('&calc();'); } # ---------------------------------------------------------------- Get formulas sub getformulas { my $sheet = shift; return %{$sheet->{'safe'}->varglob('f')}; } # ----------------------------------------------------- Get value of $f{'A'.$n} sub getfa { my $sheet = shift; my ($n)=@_; return $sheet->{'safe'}->reval('$f{"A'.$n.'"}'); } # ------------------------------------------------------------- Export of A-row sub exportdata { my $sheet=shift; return $sheet->{'safe'}->reval('&exportrowa()'); } # ========================================================== End of Spreadsheet # ============================================================================= # # Procedures for screen output # # --------------------------------------------- Produce output row n from sheet sub rown { my ($sheet,$n)=@_; my $defaultbg; my $rowdata=''; my $dataflag=0; unless ($n eq '-') { $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF'; } else { $defaultbg='#E0FF'; } unless ($ENV{'form.showcsv'}) { $rowdata.="\n$n"; } else { $rowdata.="\n".'"'.$n.'"'; } my $showf=0; my $proc; my $maxred=1; my $sheettype=$sheet->{'sheettype'}; if ($sheettype eq 'studentcalc') { $proc='&outrowassess'; $maxred=26; } else { $proc='&outrow'; } if ($sheettype eq 'assesscalc') { $maxred=1; } else { $maxred=26; } if (&getfa($sheet,$n)=~/^[\~\-]/) { $maxred=1; } if ($n eq '-') { $proc='&templaterow'; $n=-1; $dataflag=1; } foreach ($sheet->{'safe'}->reval($proc.'('.$n.')')) { my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD'); my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_); if ((($vl ne '') || ($vl eq '0')) && (($showf==1) || ($sheettype ne 'studentcalc'))) { $dataflag=1; } if ($showf==0) { $vl=$_; } unless ($ENV{'form.showcsv'}) { if ($showf<=$maxred) { $bgcolor='#FFDDDD'; } if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; } if (($showf>$maxred) || ((!$n) && ($showf>0))) { if ($vl eq '') { $vl='#'; } $rowdata.=''; if ($ENV{'request.role'} =~ /^st\./) { $rowdata.=$vl; } else { $rowdata.=''. $vl.''; } $rowdata.=''; } else { $rowdata.=' '.$vl.' '; } } else { $rowdata.=',"'.$vl.'"'; } $showf++; } # End of foreach($safeval...) if ($ENV{'form.showall'} || ($dataflag)) { return $rowdata.($ENV{'form.showcsv'}?'':''); } else { return ''; } } # ------------------------------------------------------------- Print out sheet sub outsheet { my ($r,$sheet)=@_; my $maxred = 26; # The maximum number of cells to show as # red (uneditable) # To make student sheets uneditable could we # set $maxred = 52? # my $realm='Course'; # 'assessment', 'user', or 'course' sheet if ($sheet->{'sheettype'} eq 'assesscalc') { $maxred=1; $realm='Assessment'; } elsif ($sheet->{'sheettype'} eq 'studentcalc') { $maxred=26; $realm='User'; } # # Column label my $tabledata; if ($ENV{'form.showcsv'}) { $tabledata='
';
    } else { 
        $tabledata=''.
                  ''.
                  '';
        my $showf=0;
        foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M',
                 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
                 'a','b','c','d','e','f','g','h','i','j','k','l','m',
                 'n','o','p','q','r','s','t','u','v','w','x','y','z') {
            $showf++;
            if ($showf<=$maxred) { 
                $tabledata.='";
        }
        $tabledata.=''.&rown($sheet,'-').
            &rown($sheet,0);
    }
    $r->print($tabledata);
    #
    # Prepare to output rows
    my $row;
    #
    my @sortby=();
    my @sortidx=();
    for ($row=1;$row<=$sheet->{'maxrow'};$row++) {
        push (@sortby, $sheet->{'safe'}->reval('$f{"A'.$row.'"}'));
        push (@sortidx, $row-1);
    }
    @sortidx=sort { lc($sortby[$a]) cmp lc($sortby[$b]); } @sortidx;
    #
    # Determine the type of child spreadsheets
    my $what='Student';
    if ($sheet->{'sheettype'} eq 'assesscalc') {
        $what='Item';
    } elsif ($sheet->{'sheettype'} eq 'studentcalc') {
        $what='Assessment';
    }
    #
    # Loop through the rows and output them one at a time
    my $n=0;
    for ($row=0;$row<$sheet->{'maxrow'};$row++) {
        my $thisrow=&rown($sheet,$sortidx[$row]+1);
        if ($thisrow) {
            if (($n/25==int($n/25)) && (!$ENV{'form.showcsv'})) {
                $r->print("
'. ''.$realm.'ImportCalculations
'; } else { $tabledata.=''; } $tabledata.="$_
\n
\n"); $r->rflush(); $r->print(''); $r->print('\n"); } $n++; $r->print($thisrow); } } $r->print($ENV{'form.showcsv'}?'':'
 '.$what.''. join('', (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'. 'abcdefghijklmnopqrstuvwxyz'))). "
'); } # # ----------------------------------------------- Read list of available sheets # sub othersheets { my ($sheet,$stype)=@_; $stype = $sheet->{'sheettype'} if (! defined($stype)); # my $cnum = $sheet->{'cnum'}; my $cdom = $sheet->{'cdom'}; my $chome = $sheet->{'chome'}; # my @alternatives=(); my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum); my ($tmp) = keys(%results); unless ($tmp =~ /^(con_lost|error|no_such_host)/i) { @alternatives = sort (keys(%results)); } return @alternatives; } # # -------------------------------------- Parse a spreadsheet # sub parse_sheet { # $sheetxml is a scalar reference or a scalar my ($sheetxml) = @_; if (! ref($sheetxml)) { my $tmp = $sheetxml; $sheetxml = \$tmp; } my %f; my $parser=HTML::TokeParser->new($sheetxml); my $token; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { if ($token->[1] eq 'field') { $f{$token->[2]->{'col'}.$token->[2]->{'row'}}= $parser->get_text('/field'); } if ($token->[1] eq 'template') { $f{'template_'.$token->[2]->{'col'}}= $parser->get_text('/template'); } } } return \%f; } # # -------------------------------------- Read spreadsheet formulas for a course # sub readsheet { my ($sheet,$fn)=@_; # my $stype = $sheet->{'sheettype'}; my $cnum = $sheet->{'cnum'}; my $cdom = $sheet->{'cdom'}; my $chome = $sheet->{'chome'}; # if (! defined($fn)) { # There is no filename. Look for defaults in course and global, cache unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) { my %tmphash = &Apache::lonnet::get('environment', ['spreadsheet_default_'.$stype], $cdom,$cnum); my ($tmp) = keys(%tmphash); if ($tmp =~ /^(con_lost|error|no_such_host)/i) { $fn = 'default_'.$stype; } else { $fn = $tmphash{'spreadsheet_default_'.$stype}; } unless (($fn) && ($fn!~/^error\:/)) { $fn='default_'.$stype; } $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; } } # $fn now has a value $sheet->{'filename'} = $fn; # see if sheet is cached my $fstring=''; if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) { my %tmp = split(/___;___/,$fstring); $sheet->{'f'} = \%tmp; &setformulas($sheet); } else { # Not cached, need to read my %f=(); if ($fn=~/^default\_/) { my $sheetxml=''; my $fh; my $dfn=$fn; $dfn=~s/\_/\./g; if ($fh=Apache::File->new($includedir.'/'.$dfn)) { $sheetxml=join('',<$fh>); } else { $sheetxml='"Error"'; } %f=%{&parse_sheet(\$sheetxml)}; } elsif($fn=~/\/*\.spreadsheet$/) { my $sheetxml=&Apache::lonnet::getfile (&Apache::lonnet::filelocation('',$fn)); if ($sheetxml == -1) { $sheetxml='"Error loading spreadsheet ' .$fn.'"'; } %f=%{&parse_sheet(\$sheetxml)}; } else { my $sheet=''; my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum); my ($tmp) = keys(%tmphash); unless ($tmp =~ /^(con_lost|error|no_such_host)/i) { foreach (keys(%tmphash)) { $f{$_}=$tmphash{$_}; } } } # Cache and set $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); $sheet->{'f'}=\%f; &setformulas($sheet); } } # -------------------------------------------------------- Make new spreadsheet sub makenewsheet { my ($uname,$udom,$stype,$usymb)=@_; my $sheet={}; $sheet->{'uname'} = $uname; $sheet->{'udom'} = $udom; $sheet->{'sheettype'} = $stype; $sheet->{'usymb'} = $usymb; $sheet->{'cid'} = $ENV{'request.course.id'}; $sheet->{'csec'} = $Section{$uname.':'.$udom}; $sheet->{'coursefilename'} = $ENV{'request.course.fn'}; $sheet->{'cnum'} = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; $sheet->{'cdom'} = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; $sheet->{'chome'} = $ENV{'course.'.$ENV{'request.course.id'}.'.home'}; $sheet->{'uhome'} = &Apache::lonnet::homeserver($uname,$udom); # # $sheet->{'f'} = {}; $sheet->{'constants'} = {}; $sheet->{'othersheets'} = []; $sheet->{'rowlabel'} = {}; # # $sheet->{'safe'}=&initsheet($sheet->{'sheettype'}); # # Place all the %$sheet items into the safe space except the safe space # itself my $initstring = ''; foreach (qw/uname udom sheettype usymb cid csec coursefilename cnum cdom chome uhome/) { $initstring.= qq{\$$_="$sheet->{$_}";}; } $sheet->{'safe'}->reval($initstring); return $sheet; } # ------------------------------------------------------------ Save spreadsheet sub writesheet { my ($sheet,$makedef)=@_; my $cid=$sheet->{'cid'}; if (&Apache::lonnet::allowed('opa',$cid)) { my %f=&getformulas($sheet); my $stype= $sheet->{'sheettype'}; my $cnum = $sheet->{'cnum'}; my $cdom = $sheet->{'cdom'}; my $chome= $sheet->{'chome'}; my $fn = $sheet->{'filename'}; # Cache new sheet $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); # Write sheet my $sheetdata=''; foreach (keys(%f)) { unless ($f{$_} eq 'import') { $sheetdata.=&Apache::lonnet::escape($_).'='. &Apache::lonnet::escape($f{$_}).'&'; } } $sheetdata=~s/\&$//; my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'. $sheetdata,$chome); if ($reply eq 'ok') { $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'. $stype.'_spreadsheets:'. &Apache::lonnet::escape($fn). '='.$ENV{'user.name'}.'@'. $ENV{'user.domain'}, $chome); if ($reply eq 'ok') { if ($makedef) { return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum. ':environment:'. 'spreadsheet_default_'. $stype.'='. &Apache::lonnet::escape($fn), $chome); } return $reply; } return $reply; } return $reply; } return 'unauthorized'; } # ----------------------------------------------- Make a temp copy of the sheet # "Modified workcopy" - interactive only # sub tmpwrite { my ($sheet) = @_; my $fn=$ENV{'user.name'}.'_'. $ENV{'user.domain'}.'_spreadsheet_'.$sheet->{'usymb'}.'_'. $sheet->{'filename'}; $fn=~s/\W/\_/g; $fn=$tmpdir.$fn.'.tmp'; my $fh; if ($fh=Apache::File->new('>'.$fn)) { print $fh join("\n",&getformulas($sheet)); } } # ---------------------------------------------------------- Read the temp copy sub tmpread { my ($sheet,$nfield,$nform)=@_; my $fn=$ENV{'user.name'}.'_'. $ENV{'user.domain'}.'_spreadsheet_'.$sheet->{'usymb'}.'_'. $sheet->{'filename'}; $fn=~s/\W/\_/g; $fn=$tmpdir.$fn.'.tmp'; my $fh; my %fo=(); my $countrows=0; if ($fh=Apache::File->new($fn)) { my $name; while ($name=<$fh>) { chomp($name); my $value=<$fh>; chomp($value); $fo{$name}=$value; if ($name=~/^A(\d+)$/) { if ($1>$countrows) { $countrows=$1; } } } } if ($nform eq 'changesheet') { $fo{'A'.$nfield}=(split(/\_\_\&\&\&\_\_/,$fo{'A'.$nfield}))[0]; unless ($ENV{'form.sel_'.$nfield} eq 'Default') { $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield}; } } elsif ($nfield eq 'insertrow') { $countrows++; my $newrow=substr('000000'.$countrows,-7); if ($nform eq 'top') { $fo{'A'.$countrows}='--- '.$newrow; } else { $fo{'A'.$countrows}='~~~ '.$newrow; } } else { if ($nfield) { $fo{$nfield}=$nform; } } $sheet->{'f'}=\%fo; &setformulas($sheet); } ################################################## ################################################## =pod =item &parmval() Determine the value of a parameter. Inputs: $what, the parameter needed, $sheet, the safe space Returns: The value of a parameter, or '' if none. This function cascades through the possible levels searching for a value for a parameter. The levels are checked in the following order: user, course (at section level and course level), map, and lonnet::metadata. This function uses %parmhash, which must be tied prior to calling it. This function also requires %courseopt and %useropt to be initialized for this user and course. =cut ################################################## ################################################## sub parmval { my ($what,$sheet)=@_; my $symb = $sheet->{'usymb'}; unless ($symb) { return ''; } # my $cid = $sheet->{'cid'}; my $csec = $sheet->{'csec'}; my $uname = $sheet->{'uname'}; my $udom = $sheet->{'udom'}; my $result=''; # my ($mapname,$id,$fn)=split(/\_\_\_/,$symb); # Cascading lookup scheme my $rwhat=$what; $what =~ s/^parameter\_//; $what =~ s/\_([^\_]+)$/\.$1/; # my $symbparm = $symb.'.'.$what; my $mapparm = $mapname.'___(all).'.$what; my $usercourseprefix = $uname.'_'.$udom.'_'.$cid; # my $seclevel = $usercourseprefix.'.['.$csec.'].'.$what; my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm; my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm; # my $courselevel = $usercourseprefix.'.'.$what; my $courselevelr = $usercourseprefix.'.'.$symbparm; my $courselevelm = $usercourseprefix.'.'.$mapparm; # fourth, check user if (defined($uname)) { return $useropt{$courselevelr} if (defined($useropt{$courselevelr})); return $useropt{$courselevelm} if (defined($useropt{$courselevelm})); return $useropt{$courselevel} if (defined($useropt{$courselevel})); } # third, check course if (defined($csec)) { return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr})); return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm})); return $courseopt{$seclevel} if (defined($courseopt{$seclevel})); } # return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr})); return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm})); return $courseopt{$courselevel} if (defined($courseopt{$courselevel})); # second, check map parms my $thisparm = $parmhash{$symbparm}; return $thisparm if (defined($thisparm)); # first, check default return &Apache::lonnet::metadata($fn,$rwhat.'.default'); } # ---------------------------------------------- Update rows for course listing sub updateclasssheet { my ($sheet) = @_; my $cnum =$sheet->{'cnum'}; my $cdom =$sheet->{'cdom'}; my $cid =$sheet->{'cid'}; my $chome =$sheet->{'chome'}; # %Section = (); # # Read class list and row labels my $classlist = &Apache::loncoursedata::get_classlist(); if (! defined($classlist)) { return 'Could not access course classlist'; } # my %currentlist=(); foreach my $student (keys(%$classlist)) { my ($studentDomain,$studentName,$end,$start,$id,$studentSection, $fullname,$status) = @{$classlist->{$student}}; if ($ENV{'form.Status'} eq $status || $ENV{'form.Status'} eq 'Any') { my $rowlabel=''; if ($ENV{'form.showcsv'}) { $rowlabel= '"'.join('","',($studentName,$studentDomain, $fullname,$studentSection,$id).'"'); } else { $rowlabel=''; $rowlabel.=$studentSection.' '.$id." ".$fullname; $rowlabel.=''; } $currentlist{$student}=$rowlabel; } } # # Find discrepancies between the course row table and this # my %f=&getformulas($sheet); my $changed=0; # $sheet->{'maxrow'}=0; my %existing=(); # # Now obsolete rows foreach (keys(%f)) { if ($_=~/^A(\d+)/) { if ($1 > $sheet->{'maxrow'}) { $sheet->{'maxrow'}= $1; } $existing{$f{$_}}=1; unless ((defined($currentlist{$f{$_}})) || (!$1) || ($f{$_}=~/^(\~\~\~|\-\-\-)/)) { $f{$_}='!!! Obsolete'; $changed=1; } } } # # New and unknown keys foreach (sort keys(%currentlist)) { unless ($existing{$_}) { $changed=1; $sheet->{'maxrow'}++; $f{'A'.$sheet->{'maxrow'}}=$_; } } if ($changed) { $sheet->{'f'} = \%f; &setformulas($sheet,%f); } # $sheet->{'rowlabel'} = \%currentlist; &setrowlabels($sheet); } # ----------------------------------- Update rows for student and assess sheets sub updatestudentassesssheet { my ($sheet) = @_; my %bighash; my $stype=$sheet->{'sheettype'}; my $uname=$sheet->{'uname'}; my $udom =$sheet->{'udom'}; $sheet->{'rowlabel'} = {}; if ($updatedata {$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}) { %{$sheet->{'rowlabel'}}=split(/___;___/, $updatedata{$ENV{'request.course.fn'}. '_'.$stype.'_'.$uname.'_'.$udom}); } else { # Tie hash tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', &GDBM_READER(),0640); if (! tied(%bighash)) { return 'Could not access course data'; } # Get all assessments my %allkeys=('timestamp' => 'Timestamp of Last Transaction
timestamp', 'subnumber' => 'Number of Submissions
subnumber', 'tutornumber' => 'Number of Tutor Responses
tutornumber', 'totalpoints' => 'Total Points Granted
totalpoints'); my $adduserstr=''; if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})){ $adduserstr='&uname='.$uname.'&udom='.$udom; } my %allassess = ('_feedback' =>'Feedback', '_evaluation' =>'Evaluation', '_tutoring' =>'Tutoring', '_discussion' =>'Discussion' ); while (($_,undef) = each(%bighash)) { next if ($_!~/^src\_(\d+)\.(\d+)$/); my $mapid=$1; my $resid=$2; my $id=$mapid.'.'.$resid; my $srcf=$bighash{$_}; if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) { my $symb= &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}). '___'.$resid.'___'.&Apache::lonnet::declutter($srcf); $allassess{$symb}= ''. $bighash{'title_'.$id}.''; next if ($stype ne 'assesscalc'); foreach my $key (split(/\,/, &Apache::lonnet::metadata($srcf,'keys') )) { next if ($key !~ /^(stores|parameter)_/); my $display= &Apache::lonnet::metadata($srcf,$key.'.display'); unless ($display) { $display.= &Apache::lonnet::metadata($srcf,$key.'.name'); } $display.='
'.$key; $allkeys{$key}=$display; } # end of foreach } } # end of foreach (keys(%bighash)) untie(%bighash); # # %allkeys has a list of storage and parameter displays by unikey # %allassess has a list of all resource displays by symb # if ($stype eq 'assesscalc') { $sheet->{'rowlabel'} = \%allkeys; } elsif ($stype eq 'studentcalc') { $sheet->{'rowlabel'} = \%allassess; } $updatedata{$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}= join('___;___',%{$sheet->{'rowlabel'}}); # Get current from cache } # Find discrepancies between the course row table and this # my %f=&getformulas($sheet); my $changed=0; $sheet->{'maxrow'} = 0; my %existing=(); # Now obsolete rows foreach (keys(%f)) { next if ($_!~/^A(\d+)/); if ($1 > $sheet->{'maxrow'}) { $sheet->{'maxrow'} = $1; } my ($usy,$ufn)=split(/__&&&\__/,$f{$_}); $existing{$usy}=1; unless ((exists($sheet->{'rowlabel'}->{$usy}) && (defined($sheet->{'rowlabel'}->{$usy})) || (!$1) || ($f{$_}=~/^(\~\~\~|\-\-\-)/))){ $f{$_}='!!! Obsolete'; $changed=1; } elsif ($ufn) { $sheet->{'rowlabel'}->{$usy} =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/; } } # New and unknown keys foreach (keys(%{$sheet->{'rowlabel'}})) { unless ($existing{$_}) { $changed=1; $sheet->{'maxrow'}++; $f{'A'.$sheet->{'maxrow'}}=$_; } } if ($changed) { $sheet->{'f'} = \%f; &setformulas($sheet); } &setrowlabels($sheet); # undef %existing; } # ------------------------------------------------ Load data for one assessment sub loadstudent { my ($sheet)=@_; my %c=(); my %f=&getformulas($sheet); $cachedassess=$sheet->{'uname'}.':'.$sheet->{'udom'}; # Get ALL the student preformance data my @tmp = &Apache::lonnet::dump($sheet->{'cid'}, $sheet->{'udom'}, $sheet->{'uname'}, undef); if ($tmp[0] !~ /^error:/) { %cachedstores = @tmp; } undef @tmp; # my @assessdata=(); foreach (keys(%f)) { next if ($_!~/^A(\d+)/); my $row=$1; next if (($f{$_}=~/^[\!\~\-]/) || ($row==0)); my ($usy,$ufn)=split(/__&&&\__/,$f{$_}); @assessdata=&exportsheet($sheet->{'uname'}, $sheet->{'udom'}, 'assesscalc',$usy,$ufn); my $index=0; foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { if ($assessdata[$index]) { my $col=$_; if ($assessdata[$index]=~/\D/) { $c{$col.$row}="'".$assessdata[$index]."'"; } else { $c{$col.$row}=$assessdata[$index]; } unless ($col eq 'A') { $f{$col.$row}='import'; } } $index++; } } $cachedassess=''; undef %cachedstores; $sheet->{'f'} = \%f; $sheet->{'constants'} = \%c; &setformulas($sheet); &setconstants($sheet); } # --------------------------------------------------- Load data for one student # sub loadcourse { my ($sheet,$r)=@_; my %c=(); my %f=&getformulas($sheet); my $total=0; foreach (keys(%f)) { if ($_=~/^A(\d+)/) { unless ($f{$_}=~/^[\!\~\-]/) { $total++; } } } my $now=0; my $since=time; $r->print(< popwin=open('','popwin','width=400,height=100'); popwin.document.writeln(''+ '

Spreadsheet Calculation Progress

'+ '
'+ '
'+ ''); popwin.document.close(); ENDPOP $r->rflush(); foreach (keys(%f)) { next if ($_!~/^A(\d+)/); my $row=$1; next if (($f{$_}=~/^[\!\~\-]/) || ($row==0)); my @studentdata=&exportsheet(split(/\:/,$f{$_}), 'studentcalc'); undef %userrdatas; $now++; $r->print(''); $r->rflush(); # my $index=0; foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { if ($studentdata[$index]) { my $col=$_; if ($studentdata[$index]=~/\D/) { $c{$col.$row}="'".$studentdata[$index]."'"; } else { $c{$col.$row}=$studentdata[$index]; } unless ($col eq 'A') { $f{$col.$row}='import'; } $index++; } } } $sheet->{'f'}=\%f; $sheet->{'constants'}=\%c; &setformulas($sheet); &setconstants($sheet); $r->print(''); $r->rflush(); } # ------------------------------------------------ Load data for one assessment # sub loadassessment { my ($sheet)=@_; my $uhome = $sheet->{'uhome'}; my $uname = $sheet->{'uname'}; my $udom = $sheet->{'udom'}; my $symb = $sheet->{'usymb'}; my $cid = $sheet->{'cid'}; my $cnum = $sheet->{'cnum'}; my $cdom = $sheet->{'cdom'}; my $chome = $sheet->{'chome'}; my $namespace; unless ($namespace=$cid) { return ''; } # Get stored values my %returnhash=(); if ($cachedassess eq $uname.':'.$udom) { # # get data out of the dumped stores # my $version=$cachedstores{'version:'.$symb}; my $scope; for ($scope=1;$scope<=$version;$scope++) { foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) { $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_}; } } } else { # # restore individual # %returnhash = &Apache::lonnet::restore($symb,$namespace,$udom,$uname); for (my $version=1;$version<=$returnhash{'version'};$version++) { foreach (split(/\:/,$returnhash{$version.':keys'})) { $returnhash{$_}=$returnhash{$version.':'.$_}; } } } # # returnhash now has all stores for this resource # convert all "_" to "." to be able to use libraries, multiparts, etc # # This is dumb. It is also necessary :( my @oldkeys=keys %returnhash; # foreach my $name (@oldkeys) { my $value=$returnhash{$name}; delete $returnhash{$name}; $name=~s/\_/\./g; $returnhash{$name}=$value; } # initialize coursedata and userdata for this user undef %courseopt; undef %useropt; my $userprefix=$uname.'_'.$udom.'_'; unless ($uhome eq 'no_host') { # Get coursedata unless ((time-$courserdatas{$cid.'.last_cache'})<240) { my %Tmp = &Apache::lonnet::dump('resourcedata',$cdom,$cnum); $courserdatas{$cid}=\%Tmp; $courserdatas{$cid.'.last_cache'}=time; } while (my ($name,$value) = each(%{$courserdatas{$cid}})) { $courseopt{$userprefix.$name}=$value; } # Get userdata (if present) unless ((time-$userrdatas{$uname.'@'.$udom.'.last_cache'})<240) { my %Tmp = &Apache::lonnet::dump('resourcedata',$udom,$uname); $userrdatas{$cid} = \%Tmp; # Most of the time the user does not have a 'resourcedata.db' # file. We need to cache that we got nothing instead of bothering # with requesting it every time. $userrdatas{$uname.'@'.$udom.'.last_cache'}=time; } while (my ($name,$value) = each(%{$userrdatas{$cid}})) { $useropt{$userprefix.$name}=$value; } } # now courseopt, useropt initialized for this user and course # (used by parmval) # # Load keys for this assessment only # my %thisassess=(); my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb); foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) { $thisassess{$_}=1; } # # Load parameters # my %c=(); if (tie(%parmhash,'GDBM_File', $sheet->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { my %f=&getformulas($sheet); foreach (keys(%f)) { next if ($_!~/^A/); next if ($f{$_}=~/^[\!\~\-]/); if ($f{$_}=~/^parameter/) { if ($thisassess{$f{$_}}) { my $val=&parmval($f{$_},$sheet); $c{$_}=$val; $c{$f{$_}}=$val; } } else { my $key=$f{$_}; my $ckey=$key; $key=~s/^stores\_/resource\./; $key=~s/\_/\./g; $c{$_}=$returnhash{$key}; $c{$ckey}=$returnhash{$key}; } } untie(%parmhash); } $sheet->{'constants'}=\%c; &setconstants($sheet); } # --------------------------------------------------------- Various form fields sub textfield { my ($title,$name,$value)=@_; return "\n

$title:
". ''; } sub hiddenfield { my ($name,$value)=@_; return "\n".''; } sub selectbox { my ($title,$name,$value,%options)=@_; my $selout="\n

$title:
".''; } # =============================================== Update information in a sheet # # Add new users or assessments, etc. # sub updatesheet { my ($sheet)=@_; my $stype=$sheet->{'sheettype'}; if ($stype eq 'classcalc') { return &updateclasssheet($sheet); } else { return &updatestudentassesssheet($sheet); } } # =================================================== Load the rows for a sheet # # Import the data for rows # sub loadrows { my ($sheet,$r)=@_; my $stype=$sheet->{'sheettype'}; if ($stype eq 'classcalc') { &loadcourse($sheet,$r); } elsif ($stype eq 'studentcalc') { &loadstudent($sheet); } else { &loadassessment($sheet); } } # ======================================================= Forced recalculation? sub checkthis { my ($keyname,$time)=@_; return ($time<$expiredates{$keyname}); } sub forcedrecalc { my ($uname,$udom,$stype,$usymb)=@_; my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; my $time=$oldsheets{$key.'.time'}; if ($ENV{'form.forcerecalc'}) { return 1; } unless ($time) { return 1; } if ($stype eq 'assesscalc') { my $map=(split(/\_\_\_/,$usymb))[0]; if (&checkthis('::assesscalc:',$time) || &checkthis('::assesscalc:'.$map,$time) || &checkthis('::assesscalc:'.$usymb,$time) || &checkthis($uname.':'.$udom.':assesscalc:',$time) || &checkthis($uname.':'.$udom.':assesscalc:'.$map,$time) || &checkthis($uname.':'.$udom.':assesscalc:'.$usymb,$time)) { return 1; } } else { if (&checkthis('::studentcalc:',$time) || &checkthis($uname.':'.$udom.':studentcalc:',$time)) { return 1; } } return 0; } # ============================================================== Export handler # # Non-interactive call from with program # sub exportsheet { my ($uname,$udom,$stype,$usymb,$fn)=@_; my @exportarr=(); if (($usymb=~/^\_(\w+)/) && (!$fn)) { $fn='default_'.$1; } # # Check if cached # my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; my $found=''; if ($oldsheets{$key}) { foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) { my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); if ($name eq $fn) { $found=$value; } } } unless ($found) { &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom)); if ($oldsheets{$key}) { foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) { my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); if ($name eq $fn) { $found=$value; } } } } # # Check if still valid # if ($found) { if (&forcedrecalc($uname,$udom,$stype,$usymb)) { $found=''; } } if ($found) { # # Return what was cached # @exportarr=split(/\_\_\_\;\_\_\_/,$found); } else { # # Not cached # my ($sheet)=&makenewsheet($uname,$udom,$stype,$usymb); &readsheet($sheet,$fn); &updatesheet($sheet); &loadrows($sheet); &calcsheet($sheet); @exportarr=&exportdata($sheet); # # Store now # my $cid=$ENV{'request.course.id'}; my $current=''; if ($stype eq 'studentcalc') { $current=&Apache::lonnet::reply('get:'. $ENV{'course.'.$cid.'.domain'}.':'. $ENV{'course.'.$cid.'.num'}. ':nohist_calculatedsheets:'. &Apache::lonnet::escape($key), $ENV{'course.'.$cid.'.home'}); } else { $current=&Apache::lonnet::reply('get:'.$sheet->{'udom'}.':'. $sheet->{'uname'}. ':nohist_calculatedsheets_'. $ENV{'request.course.id'}.':'. &Apache::lonnet::escape($key), $sheet->{'uhome'}); } my %currentlystored=(); unless ($current=~/^error\:/) { foreach (split(/___&\___/,&Apache::lonnet::unescape($current))) { my ($name,$value)=split(/___=___/,$_); $currentlystored{$name}=$value; } } $currentlystored{$fn}=join('___;___',@exportarr); # my $newstore=''; foreach (keys(%currentlystored)) { if ($newstore) { $newstore.='___&___'; } $newstore.=$_.'___=___'.$currentlystored{$_}; } my $now=time; if ($stype eq 'studentcalc') { &Apache::lonnet::reply('put:'. $ENV{'course.'.$cid.'.domain'}.':'. $ENV{'course.'.$cid.'.num'}. ':nohist_calculatedsheets:'. &Apache::lonnet::escape($key).'='. &Apache::lonnet::escape($newstore).'&'. &Apache::lonnet::escape($key).'.time='.$now, $ENV{'course.'.$cid.'.home'}); } else { &Apache::lonnet::reply('put:'. $sheet->{'udom'}.':'. $sheet->{'uname'}. ':nohist_calculatedsheets_'. $ENV{'request.course.id'}.':'. &Apache::lonnet::escape($key).'='. &Apache::lonnet::escape($newstore).'&'. &Apache::lonnet::escape($key).'.time='.$now, $sheet->{'uhome'}); } } return @exportarr; } # ============================================================ Expiration Dates # # Load previously cached student spreadsheets for this course # sub expirationdates { undef %expiredates; my $cid=$ENV{'request.course.id'}; my $reply=&Apache::lonnet::reply('dump:'. $ENV{'course.'.$cid.'.domain'}.':'. $ENV{'course.'.$cid.'.num'}. ':nohist_expirationdates', $ENV{'course.'.$cid.'.home'}); unless ($reply=~/^error\:/) { foreach (split(/\&/,$reply)) { my ($name,$value)=split(/\=/,$_); $expiredates{&Apache::lonnet::unescape($name)} =&Apache::lonnet::unescape($value); } } } # ===================================================== Calculated sheets cache # # Load previously cached student spreadsheets for this course # sub cachedcsheets { my $cid=$ENV{'request.course.id'}; my $reply=&Apache::lonnet::reply('dump:'. $ENV{'course.'.$cid.'.domain'}.':'. $ENV{'course.'.$cid.'.num'}. ':nohist_calculatedsheets', $ENV{'course.'.$cid.'.home'}); unless ($reply=~/^error\:/) { foreach ( split(/\&/,$reply)) { my ($name,$value)=split(/\=/,$_); $oldsheets{&Apache::lonnet::unescape($name)} =&Apache::lonnet::unescape($value); } } } # ===================================================== Calculated sheets cache # # Load previously cached assessment spreadsheets for this student # sub cachedssheets { my ($sname,$sdom,$shome)=@_; unless (($loadedcaches{$sname.'_'.$sdom}) || ($shome eq 'no_host')) { my $cid=$ENV{'request.course.id'}; my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname. ':nohist_calculatedsheets_'. $ENV{'request.course.id'}, $shome); unless ($reply=~/^error\:/) { foreach ( split(/\&/,$reply)) { my ($name,$value)=split(/\=/,$_); $oldsheets{&Apache::lonnet::unescape($name)} =&Apache::lonnet::unescape($value); } } $loadedcaches{$sname.'_'.$sdom}=1; } } # ===================================================== Calculated sheets cache # # Load previously cached assessment spreadsheets for this student # # ================================================================ Main handler # # Interactive call to screen # # sub handler { my $r=shift; if (! exists($ENV{'form.Status'})) { $ENV{'form.Status'} = 'Active'; } # Check this server my $loaderror=&Apache::lonnet::overloaderror($r); if ($loaderror) { return $loaderror; } # Check the course homeserver $loaderror= &Apache::lonnet::overloaderror($r, $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); if ($loaderror) { return $loaderror; } if ($r->header_only) { $r->content_type('text/html'); $r->send_http_header; return OK; } # Global directory configs $includedir = $r->dir_config('lonIncludes'); $tmpdir = $r->dir_config('lonDaemons').'/tmp/'; # Needs to be in a course if (! $ENV{'request.course.fn'}) { # Not in a course, or not allowed to modify parms $ENV{'user.error.msg'}= $r->uri.":opa:0:0:Cannot modify spreadsheet"; return HTTP_NOT_ACCEPTABLE; } # Get query string for limited number of parameters &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['uname','udom','usymb','ufn']); if ($ENV{'request.role'} =~ /^st\./) { delete $ENV{'form.unewfield'} if (exists($ENV{'form.unewfield'})); delete $ENV{'form.unewformula'} if (exists($ENV{'form.unewformula'})); } if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) { $ENV{'form.ufn'}='default_'.$1; } # Interactive loading of specific sheet? if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) { $ENV{'form.ufn'}=$ENV{'form.loadthissheet'}; } # # Determine the user name and domain for the sheet. my $aname; my $adom; unless ($ENV{'form.uname'}) { $aname=$ENV{'user.name'}; $adom=$ENV{'user.domain'}; } else { $aname=$ENV{'form.uname'}; $adom=$ENV{'form.udom'}; } # # Open page $r->content_type('text/html'); $r->header_out('Cache-control','no-cache'); $r->header_out('Pragma','no-cache'); $r->send_http_header; # Screen output $r->print('LON-CAPA Spreadsheet'); if ($ENV{'request.role'} !~ /^st\./) { $r->print(< function celledit(cn,cf) { var cnf=prompt(cn,cf); if (cnf!=null) { document.sheet.unewfield.value=cn; document.sheet.unewformula.value=cnf; document.sheet.submit(); } } function changesheet(cn) { document.sheet.unewfield.value=cn; document.sheet.unewformula.value='changesheet'; document.sheet.submit(); } function insertrow(cn) { document.sheet.unewfield.value='insertrow'; document.sheet.unewformula.value=cn; document.sheet.submit(); } ENDSCRIPT } $r->print(''.&Apache::loncommon::bodytag('Grades Spreadsheet'). '

'); $r->print(&hiddenfield('uname',$ENV{'form.uname'}). &hiddenfield('udom',$ENV{'form.udom'}). &hiddenfield('usymb',$ENV{'form.usymb'}). &hiddenfield('unewfield',''). &hiddenfield('unewformula','')); $r->rflush(); # # Full recalc? if ($ENV{'form.forcerecalc'}) { $r->print('

Completely Recalculating Sheet ...

'); undef %spreadsheets; undef %courserdatas; undef %userrdatas; undef %defaultsheets; undef %updatedata; } # Read new sheet or modified worksheet $r->uri=~/\/(\w+)$/; my ($sheet)=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'}); # # If a new formula had been entered, go from work copy if ($ENV{'form.unewfield'}) { $r->print('

Modified Workcopy

'); $ENV{'form.unewformula'}=~s/\'/\"/g; $r->print('

New formula: '.$ENV{'form.unewfield'}.'='. $ENV{'form.unewformula'}.'

'); $sheet->{'filename'} = $ENV{'form.ufn'}; &tmpread($sheet,$ENV{'form.unewfield'},$ENV{'form.unewformula'}); } elsif ($ENV{'form.saveas'}) { $sheet->{'filename'} = $ENV{'form.ufn'}; &tmpread($sheet); } else { &readsheet($sheet,$ENV{'form.ufn'}); } # Print out user information unless ($sheet->{'sheettype'} eq 'classcalc') { $r->print('

User: '.$sheet->{'uname'}. '
Domain: '.$sheet->{'udom'}); $r->print('
Section/Group: '.$sheet->{'csec'}); if ($ENV{'form.usymb'}) { $r->print('
Assessment: '. $ENV{'form.usymb'}.''); } } # # Check user permissions if (($sheet->{'sheettype'} eq 'classcalc' ) || ($sheet->{'uname'} ne $ENV{'user.name'} ) || ($sheet->{'udom'} ne $ENV{'user.domain'})) { unless (&Apache::lonnet::allowed('vgr',$sheet->{'cid'})) { $r->print('

Access Permission Denied

'. '
'); return OK; } } # Additional options $r->print('
'. '

'); if ($sheet->{'sheettype'} eq 'assesscalc') { $r->print('

'. ''. 'Level up: Student Sheet

'); } if (($sheet->{'sheettype'} eq 'studentcalc') && (&Apache::lonnet::allowed('vgr',$sheet->{'cid'}))) { $r->print ('

'. 'Level up: Course Sheet

'); } # Save dialog if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { my $fname=$ENV{'form.ufn'}; $fname=~s/\_[^\_]+$//; if ($fname eq 'default') { $fname='course_default'; } $r->print(''. ''. 'make default:

'); } $r->print(&hiddenfield('ufn',$sheet->{'filename'})); # Load dialog if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { $r->print('

'. '

'); if ($sheet->{'sheettype'} eq 'studentcalc') { &setothersheets($sheet, &othersheets($sheet,'assesscalc')); } } # Cached sheets &expirationdates(); undef %oldsheets; undef %loadedcaches; if ($sheet->{'sheettype'} eq 'classcalc') { $r->print("Loading previously calculated student sheets ...\n"); $r->rflush(); &cachedcsheets(); } elsif ($sheet->{'sheettype'} eq 'studentcalc') { $r->print("Loading previously calculated assessment sheets ...\n"); $r->rflush(); &cachedssheets($sheet->{'uname'},$sheet->{'udom'},$sheet->{'uhome'}); } # Update sheet, load rows $r->print("Loaded sheet(s), updating rows ...
\n"); $r->rflush(); # &updatesheet($sheet); $r->print("Updated rows, loading row data ...\n"); $r->rflush(); # &loadrows($sheet,$r); $r->print("Loaded row data, calculating sheet ...
\n"); $r->rflush(); # my $calcoutput=&calcsheet($sheet); $r->print('

'.$calcoutput.'

'); # See if something to save if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { my $fname=''; if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) { $fname=~s/\W/\_/g; if ($fname eq 'default') { $fname='course_default'; } $fname.='_'.$sheet->{'sheettype'}; $sheet->{'filename'} = $fname; $ENV{'form.ufn'}=$fname; $r->print('

Saving spreadsheet: '. &writesheet($sheet,$ENV{'form.makedefufn'}). '

'); } } # # Write the modified worksheet $r->print('Current sheet: '.$sheet->{'filename'}.'

'); &tmpwrite($sheet); if ($sheet->{'sheettype'} eq 'studentcalc') { $r->print('
Show rows with empty A column: '); } else { $r->print('
Show empty rows: '); } # $r->print(&hiddenfield('userselhidden','true'). 'print(' checked'); } else { unless ($ENV{'form.userselhidden'}) { unless ($ENV{'course.'.$ENV{'request.course.id'}.'.hideemptyrows'} eq 'yes') { $r->print(' checked'); $ENV{'form.showall'}=1; } } } $r->print('>'); if ($sheet->{'sheettype'} eq 'classcalc') { # # CSV format checkbox (classcalc sheets only) $r->print(' Output CSV format: print(' checked'); } $r->print('>'); # # Buttons to insert rows $r->print(' Student Status: '. &Apache::lonhtmlcommon::StatusOptions ($ENV{'form.Status'},'sheet')); } $r->print(<
ENDINSERTBUTTONS # Print out sheet &outsheet($r,$sheet); $r->print(''); # Done return OK; } 1; __END__