--- loncom/interface/Attic/lonspreadsheet.pm 2000/11/15 10:37:27 1.1 +++ loncom/interface/Attic/lonspreadsheet.pm 2000/12/09 19:14:20 1.10 @@ -1,39 +1,73 @@ # The LearningOnline Network with CAPA # Spreadsheet/Grades Display Handler # -# 11/11,11/15 Gerd Kortemeyer +# 11/11,11/15,11/27,12/04,12/05,12/06,12/07,12/08,12/09 Gerd Kortemeyer package Apache::lonspreadsheet; use strict; +use vars qw(%spreadsheets); 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 +89,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 +113,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 +242,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,41 +284,510 @@ 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
'. + ' | 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.='
$title:
".
+ '';
+}
+
+sub hiddenfield {
+ my ($name,$value)=@_;
+ return "\n".'';
+}
+
+sub selectbox {
+ my ($title,$name,$value,%options)=@_;
+ my $selout="\n
$title:
".'';
+}
+
+# ---------------------------------------------------------------- Main handler
+
sub handler {
- %v=();
- %t=();
- %f=();
- my $safeeval = new Safe;
- $safeeval->permit("entereval");
- $safeeval->permit(":base_math");
- $safeeval->permit("sort");
- $safeeval->deny(":base_io");
-# $safeeval->share_from('Apache::lonnet',['&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')) {
+
+# --------------------------- Get query string for limited number of parameters
+ map {
+ my ($name, $value) = split(/=/,$_);
+ $value =~ tr/+/ /;
+ $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
+ if (($name='uname') || ($name='udom') || ($name='usymb')) {
+ unless ($ENV{'form.'.$name}) {
+ $ENV{'form.'.$name}=$value;
+ }
+ }
+ } (split(/&/,$ENV{'QUERY_STRING'}));
+
+# ------------------------------------------- Nothing there? Must be login user
+
+ unless ($ENV{'form.uname'}) {
+ $ENV{'form.uname'}=$ENV{'user.name'};
+ $ENV{'form.udom'}=$ENV{'user.domain'};
+ }
+# ------------------------------------------------------------------- Open page
+
+ $r->content_type('text/html');
+ $r->send_http_header;
+
+ $r->print('