--- loncom/interface/Attic/lonspreadsheet.pm 2000/11/27 12:13:10 1.2
+++ loncom/interface/Attic/lonspreadsheet.pm 2000/12/08 17:16:37 1.9
@@ -1,39 +1,72 @@
# The LearningOnline Network with CAPA
# Spreadsheet/Grades Display Handler
#
-# 11/11,11/15,11/27 Gerd Kortemeyer
+# 11/11,11/15,11/27,12/04,12/05,12/06,12/07,12/08 Gerd Kortemeyer
package Apache::lonspreadsheet;
use strict;
use Safe;
+use Safe::Hole;
use Opcode;
-use vars qw(%v %t %f);
use Apache::lonnet;
-use Apache::Constants qw(:common);
+use Apache::Constants qw(:common :http);
+use HTML::TokeParser;
+use GDBM_File;
-sub deffunc {
- my $safeeval=shift;
+# =============================================================================
+# ===================================== Implements an instance of a spreadsheet
+
+sub initsheet {
+ my $safeeval = new Safe;
+ 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');
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
+
+%v=();
+%t=();
+%f=();
+%c=();
+%rl=();
+
+$maxrow=0;
+$sheettype='';
+$filename='';
+
sub mask {
my ($lower,$upper)=@_;
- $lower=~/([A-Z]|\*)(\d+|\*)/;
+ $lower=~/([A-Za-z]|\*)(\d+|\*)/;
my $la=$1;
my $ld=$2;
- $upper=~/([A-Z]|\*)(\d+|\*)/;
+ $upper=~/([A-Za-z]|\*)(\d+|\*)/;
my $ua=$1;
my $ud=$2;
my $alpha='';
my $num='';
if (($la eq '*') || ($ua eq '*')) {
- $alpha='[A-Z]';
+ $alpha='[A-Za-z]';
} else {
- $alpha='['.$la.'-'.$ua.']';
+ 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 '*')) {
@@ -55,11 +88,13 @@ sub mask {
} else {
my @lda=($ld=~m/\d/g);
my @uda=($ud=~m/\d/g);
- my $i; $j=0;
- for ($i=0;$i<=$#lda;$i++) {
+ my $i; $j=0; $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) {
@@ -77,14 +112,15 @@ sub mask {
}
$num.=')';
} else {
- $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
+ if ($lda[$#lda]!=$uda[$#uda]) {
+ $num.='['.$lda[$#lda].'-'.$uda[$#uda].']';
+ }
}
}
}
- return '^'.$alpha.$num.'$';
+ return '^'.$alpha.$num."\$";
}
-
sub NUM {
my $mask=mask(@_);
my $num=0;
@@ -205,33 +241,33 @@ sub SUMMIN {
return $sum;
}
-
-# ------------------------------------------- End of "Inside of the safe space"
-ENDDEFS
- $safeeval->reval($code);
-}
-
sub sett {
%t=();
map {
if ($f{$_}) {
- $t{$_}=$f{$_};
- $t{$_}=~s/\.+/\,/g;
- $t{$_}=~s/(^|[^\"\'])([A-Z]\d+)/$1\$v\{\'$2\'\}/g;
+ if ($_=~/^A/) {
+ unless ($f{$_}=~/^\!/) {
+ $t{$_}=$c{$_};
+ }
+ } else {
+ $t{$_}=$f{$_};
+ $t{$_}=~s/\.\.+/\,/g;
+ $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
+ }
}
} keys %f;
}
-sub calcv {
- my $safeeval=shift;
+sub calc {
%v=();
+ &sett();
my $notfinished=1;
my $depth=0;
while ($notfinished) {
$notfinished=0;
map {
my $old=$v{$_};
- $v{$_}=$safeeval->reval($t{$_});
+ $v{$_}=eval($t{$_});
if ($@) {
%v=();
return $@;
@@ -247,42 +283,394 @@ sub calcv {
return '';
}
+sub outrow {
+ my $n=shift;
+ my @cols=();
+ if ($n) {
+ $cols[0]=$rl{$f{'A'.$n}};
+ } else {
+ $cols[0]='Export';
+ }
+ map {
+ my $fm=$f{$_.$n};
+ $fm=~s/[\'\"]/\&\#34;/g;
+ $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n};
+ } ('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');
+ return @cols;
+}
+
+# ------------------------------------------- End of "Inside of the safe space"
+ENDDEFS
+ $safeeval->reval($code);
+ return $safeeval;
+}
+
+# ------------------------------------------------ Add or change formula values
+
+sub setformulas {
+ my ($safeeval,@f)=@_;
+ $safeeval->reval('%f='."('".join("','",@f)."');");
+}
+
+# ------------------------------------------------ Add or change formula values
+
+sub setconstants {
+ my ($safeeval,@c)=@_;
+ $safeeval->reval('%c='."('".join("','",@c)."');");
+}
+
+# ------------------------------------------------ Add or change formula values
+
+sub setrowlabels {
+ my ($safeeval,@rl)=@_;
+ $safeeval->reval('%rl='."('".join("','",@rl)."');");
+}
+
+# ------------------------------------------------------- Calculate spreadsheet
+
+sub calcsheet {
+ my $safeeval=shift;
+ $safeeval->reval('&calc();');
+}
+
+# ------------------------------------------------------------------ Get values
+
+sub getvalues {
+ my $safeeval=shift;
+ return $safeeval->reval('%v');
+}
+
+# ---------------------------------------------------------------- Get formulas
+
+sub getformulas {
+ my $safeeval=shift;
+ return $safeeval->reval('%f');
+}
+
+# -------------------------------------------------------------------- Set type
+
+sub settype {
+ my ($safeeval,$type)=@_;
+ $safeeval->reval('$sheettype='.$type.';');
+}
+
+# -------------------------------------------------------------------- Get type
+
+sub gettype {
+ my $safeeval=shift;
+ return $safeeval->reval('$sheettype');
+}
+# ------------------------------------------------------------------ Set maxrow
+
+sub setmaxrow {
+ my ($safeeval,$row)=@_;
+ $safeeval->reval('$maxrow='.$row.';');
+}
+
+# ------------------------------------------------------------------ Get maxrow
+
+sub getmaxrow {
+ my $safeeval=shift;
+ return $safeeval->reval('$maxrow');
+}
+
+# ---------------------------------------------------------------- Set filename
+
+sub setfilename {
+ my ($safeeval,$fn)=@_;
+ $safeeval->reval('$filename='.$fn.';');
+}
+
+# ---------------------------------------------------------------- Get filename
+
+sub getfilename {
+ my $safeeval=shift;
+ return $safeeval->reval('$filename');
+}
+
+# ========================================================== End of Spreadsheet
+# =============================================================================
+
+
+# --------------------------------------------- Produce output row n from sheet
+
+sub rown {
+ my ($safeeval,$n)=@_;
+ my $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
+ my $rowdata="\n
$n | ";
+ my $showf=0;
+ map {
+ my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
+ my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
+ if ($showf==0) { $vl=$_; }
+ if ($showf<=1) { $bgcolor='#FFDDDD'; }
+ if (($n==0) && ($showf<=26)) { $bgcolor='#CCCCFF'; }
+ if ($showf>1) {
+ if ($vl eq '') {
+ $vl='#';
+ }
+ $rowdata.=
+ ''.$vl.
+ ' | ';
+ } else {
+ $rowdata.=' '.$vl.' | ';
+ }
+ $showf++;
+ } $safeeval->reval('&outrow('.$n.')');
+ return $rowdata.'
';
+}
+
+# ------------------------------------------------------------- Print out sheet
+
+sub outsheet {
+ my $safeeval=shift;
+ my $tabledata=' | '.
+ 'A Import | ';
+ map {
+ $tabledata.="$_ | ";
+ } ('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');
+ $tabledata.='
';
+ my $row;
+ my $maxrow=&getmaxrow($safeeval);
+ for ($row=0;$row<=$maxrow;$row++) {
+ $tabledata.=&rown($safeeval,$row);
+ }
+ $tabledata.='
';
+}
+
+
+
+# --------------------------------------- Read spreadsheet formulas from a file
+
+sub readsheet {
+ my ($safeeval,$fn)=@_;
+ &setfilename($safeeval,$fn);
+ $fn=~/\.(\w+)/;
+ &settype($safeeval,$1);
+ my %f=();
+ my $content='';
+ {
+ my $fh;
+ if ($fh=Apache::File->new($fn)) {
+ $content=join('',<$fh>);
+ }
+ }
+ {
+ my $parser=HTML::TokeParser->new(\$content);
+ 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');
+ }
+ }
+ }
+ }
+ &setformulas($safeeval,%f);
+}
+
+# --------------------------------------------------------------- Read metadata
+
+sub readmeta {
+ my $fn=shift;
+ unless ($fn=~/\.meta$/) { $fn.='meta'; }
+ my $content;
+ my %returnhash=();
+ {
+ my $fh=Apache::File->new($fn);
+ $content=join('',<$fh>);
+ }
+ my $parser=HTML::TokeParser->new(\$content);
+ my $token;
+ while ($token=$parser->get_token) {
+ if ($token->[0] eq 'S') {
+ my $entry=$token->[1];
+ if (($entry eq 'stores') || ($entry eq 'parameter')) {
+ my $unikey=$entry;
+ $unikey.='_'.$token->[2]->{'part'};
+ $unikey.='_'.$token->[2]->{'name'};
+ $returnhash{$unikey}=$token->[2]->{'display'};
+ }
+ }
+ }
+ return %returnhash;
+}
+
+# ----------------------------------------------------------------- Update rows
+
+sub updaterows {
+ my $safeeval=shift;
+ my %bighash;
+# -------------------------------------------------------------------- Tie hash
+ if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
+ &GDBM_READER,0640)) {
+# --------------------------------------------------------- Get all assessments
+
+ my %allkeys=();
+ my %allassess=();
+
+ my $stype=&gettype($safeeval);
+
+ map {
+ 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};
+
+ if ($stype eq 'assesscalc') {
+ map {
+ if ($_=~/^stores\_(.*)/) {
+ my $key=$_;
+ my $display=
+ &Apache::lonnet::metadata($srcf,$key.'.display');
+ unless ($display) {
+ $display=
+ &Apache::lonnet::metadata($srcf,$key.'.name');
+ }
+
+
+ $allkeys{$key}=$display;
+ }
+ } split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
+ }
+ }
+ }
+ } keys %bighash;
+ untie(%bighash);
+
+#
+# %allkeys has a list of storage displays by unikey
+# %allassess has a list of all resource displays by symb
+#
+# -------------------- Find discrepancies between the course row table and this
+#
+ my %f=&getformulas($safeeval);
+ my $changed=0;
+
+ my %current=();
+ if ($stype eq 'assesscalc') {
+ %current=%allkeys;
+ } elsif ($stype eq 'studentcalc') {
+ %current=%allassess;
+ }
+
+ my $maxrow=0;
+ my %existing=();
+
+# ----------------------------------------------------------- Now obsolete rows
+ map {
+ if ($_=~/^A(\d+)/) {
+ $maxrow=($1>$maxrow)?$1:$maxrow;
+ $existing{$f{$_}}=1;
+ unless (defined($current{$f{$_}})) {
+ $f{$_}='!!! Obsolete';
+ $changed=1;
+ }
+ }
+ } keys %f;
+
+# -------------------------------------------------------- New and unknown keys
+
+ map {
+ unless ($existing{$_}) {
+ $changed=1;
+ $maxrow++;
+ $f{'A'.$maxrow}=$_;
+ }
+ } keys %current;
+
+ if ($changed) { &setformulas($safeeval,%f); }
+
+ &setmaxrow($safeeval,$maxrow);
+ &setrowlabels($safeeval,%current);
+
+ } else {
+ return 'Could not access course data';
+ }
+}
+
+# ------------------------------------------------ Load data for one assessment
+
+sub rowaassess {
+ my ($safeeval,$uname,$udom,$symb)=@_;
+ my $uhome=&Apache::lonnet::homeserver($uname,$udom);
+ my $namespace;
+ unless ($namespace=$ENV{'request.course.id'}) { return ''; }
+ my $answer=reply("restore:$udom:$uname:$namespace:$symb",$uhome);
+ my %returnhash=();
+ map {
+ my ($name,$value)=split(/\=/,$_);
+ $returnhash{&unescape($name)}=&unescape($value);
+ } split(/\&/,$answer);
+ my $version;
+ for ($version=1;$version<=$returnhash{'version'};$version++) {
+ map {
+ $returnhash{$_}=$returnhash{$version.':'.$_};
+ } split(/\:/,$returnhash{$version.':keys'});
+ }
+
+ my %c=();
+ my %f=&getformulas($safeeval);
+ map {
+ if ($_=~/^A/) {
+ unless ($f{$_}=~/^\!/) {
+ $c{$_}=$returnhash{$f{$_}};
+ }
+ }
+ } keys %f;
+ &setconstants($safeeval,%c);
+}
+
+
sub handler {
- %v=();
- %t=();
- %f=();
- my $safeeval = new Safe;
- 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');
- $safeeval->share('%v','%t','%f');
- &deffunc($safeeval);
- $f{'A3'}=5;
- $f{'A4'}=3;
- $f{'A5'}=8;
- $f{'E100'}=5;
- $f{'C3'}='A3+6';
- $f{'B4'}='8+int(C3/3)';
- $f{'C7'}='A3+B4';
- $f{'G8'}='MEAN("E*")';
- $f{'G5'}='A3+SUMMIN(2,"A*")';
- $f{'G6'}='A3+SUM("A*")';
- $f{'G7'}='STDDEV("A*")';
- $f{'G9'}='NUM("G*")';
- $f{'H10'}='MEAN("E*")';
- $f{'G10'}='BIN(3,5,"A*")';
- &sett();
- print &calcv($safeeval)."\n";
- print $v{'C7'}."\n";
- print $t{'G5'}.' - '.$v{'G5'}."\n";
- print $t{'G6'}.' - '.$v{'G6'}."\n";
- print $t{'G7'}.' - '.$v{'G7'}."\n";
- print $t{'G8'}.' - '.$v{'G8'}."\n";
- print $t{'G9'}.' - '.$v{'G9'}."\n";
- print $t{'G10'}.' - '.$v{'G10'}."\n";
+ my $r=shift;
+
+ if ($r->header_only) {
+ $r->content_type('text/html');
+ $r->send_http_header;
+ return OK;
+ }
+
+# ----------------------------------------------------- Needs to be in a course
+
+ if (($ENV{'request.course.fn'}) ||
+ ($ENV{'request.state'} eq 'construct')) {
+
+ $r->content_type('text/html');
+ $r->send_http_header;
+
+ $r->print('LON-CAPA Spreadsheet');
+ $r->print('');
+
+ my $sheetone=initsheet();
+ &readsheet($sheetone,$r->filename);
+ &updaterows($sheetone);
+ &calcsheet($sheetone);
+ $r->print(&outsheet($sheetone));
+
+ $r->print('');
+
+ } else {
+# ----------------------------- 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;
+ }
+ return OK;
}
1;