# The LearningOnline Network with CAPA
# Spreadsheet/Grades Display Handler
#
# 11/11,11/15,11/27,12/04,12/05,12/06 Gerd Kortemeyer
package Apache::lonspreadsheet;
use strict;
use Safe;
use Safe::Hole;
use Opcode;
use Apache::lonnet;
use Apache::Constants qw(:common :http);
use HTML::TokeParser;
use GDBM_File;
# =============================================================================
# ===================================== 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-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.='(';
map {
$num.='['.$_.'-9]';
} ($ld=~m/\d/g);
if (length($ud)-length($ld)>1) {
$num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
}
$num.='|';
map {
$num.='[0-'.$_.']';
} ($ud=~m/\d/g);
$num.=')';
} else {
my @lda=($ld=~m/\d/g);
my @uda=($ud=~m/\d/g);
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) {
$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 NUM {
my $mask=mask(@_);
my $num=0;
map {
$num++;
} grep /$mask/,keys %v;
return $num;
}
sub BIN {
my ($low,$high,$lower,$upper)=@_;
my $mask=mask($lower,$upper);
my $num=0;
map {
if (($v{$_}>=$low) && ($v{$_}<=$high)) {
$num++;
}
} grep /$mask/,keys %v;
return $num;
}
sub SUM {
my $mask=mask(@_);
my $sum=0;
map {
$sum+=$v{$_};
} grep /$mask/,keys %v;
return $sum;
}
sub MEAN {
my $mask=mask(@_);
my $sum=0; my $num=0;
map {
$sum+=$v{$_};
$num++;
} grep /$mask/,keys %v;
if ($num) {
return $sum/$num;
} else {
return undef;
}
}
sub STDDEV {
my $mask=mask(@_);
my $sum=0; my $num=0;
map {
$sum+=$v{$_};
$num++;
} grep /$mask/,keys %v;
unless ($num>1) { return undef; }
my $mean=$sum/$num;
$sum=0;
map {
$sum+=($v{$_}-$mean)**2;
} grep /$mask/,keys %v;
return sqrt($sum/($num-1));
}
sub PROD {
my $mask=mask(@_);
my $prod=1;
map {
$prod*=$v{$_};
} grep /$mask/,keys %v;
return $prod;
}
sub MAX {
my $mask=mask(@_);
my $max='-';
map {
unless ($max) { $max=$v{$_}; }
if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; }
} grep /$mask/,keys %v;
return $max;
}
sub MIN {
my $mask=mask(@_);
my $min='-';
map {
unless ($max) { $max=$v{$_}; }
if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; }
} grep /$mask/,keys %v;
return $min;
}
sub SUMMAX {
my ($num,$lower,$upper)=@_;
my $mask=mask($lower,$upper);
my @inside=();
map {
$inside[$#inside+1]=$v{$_};
} grep /$mask/,keys %v;
@inside=sort(@inside);
my $sum=0; my $i;
for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {
$sum+=$inside[$i];
}
return $sum;
}
sub SUMMIN {
my ($num,$lower,$upper)=@_;
my $mask=mask($lower,$upper);
my @inside=();
map {
$inside[$#inside+1]=$v{$_};
} grep /$mask/,keys %v;
@inside=sort(@inside);
my $sum=0; my $i;
for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
$sum+=$inside[$i];
}
return $sum;
}
sub sett {
%t=();
map {
if ($f{$_}) {
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 calc {
%v=();
&sett();
my $notfinished=1;
my $depth=0;
while ($notfinished) {
$notfinished=0;
map {
my $old=$v{$_};
$v{$_}=eval($t{$_});
if ($@) {
%v=();
return $@;
}
if ($v{$_} ne $old) { $notfinished=1; }
} keys %t;
$depth++;
if ($depth>100) {
%v=();
return 'Maximum calculation depth exceeded';
}
}
return '';
}
sub outrow {
my $n=shift;
my @cols=();
if ($n) {
$cols[0]=$rl{$f{'A'.$n}};
} else {
$cols[0]='<b><font size=+1>Export</font></b>';
}
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 $rowdata="\n<tr><td><b><font size=+1>$n</font></b></td>";
my $showf=0;
map {
my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_);
if ($showf==0) { $vl=$_; }
if ($showf>1) {
if ($vl eq '') {
$vl='<font size=+2 color=white>#</font>';
}
$rowdata.=
'<td><a href="javascript:prompt('.$fm.');">'.$vl.
'</a></td>';
} else {
$rowdata.='<td> '.$vl.' </td>';
}
$showf++;
} $safeeval->reval('&outrow('.$n.')');
return $rowdata.'</tr>';
}
# ------------------------------------------------------------- Print out sheet
sub outsheet {
my $safeeval=shift;
my $tabledata='<table border=2><tr><td colspan=2> </td>';
map {
$tabledata.="<td><b><font size=+1>$_</font></b></td>";
} ('A<br>Import','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.='</tr>';
my $row;
my $maxrow=&getmaxrow($safeeval);
for ($row=0;$row<=$maxrow;$row++) {
$tabledata.=&rown($safeeval,$row);
}
$tabledata.='</table>';
}
# --------------------------------------- Read spreadsheet formulas from a file
sub readsheet {
my ($safeeval,$fn)=shift;
&setfilename($safeeval,$fn);
$fn=~/\.(\w+)/;
&settype($safeeval,$1);
my %f=();
my $content;
{
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') {
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 {
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('<html><head><title>LON-CAPA Spreadsheet</title></head>');
$r->print('<body bgcolor="#FFFFFF">');
my $sheetone=initsheet();
&setformulas($sheetone,
'B3' => 5, 'C4' => 6, 'C6' => 'B3+C4', 'C2' => 'C6+B5', 'B5'=>'&SUM("A*")',
'A1' => 'da1', 'A2'=>'da2', 'A3'=>'da3','A4'=>'da4','A5'=>'da5','A6'=>'da6',
'a1' => '28.7', 'a2' => 'C4+a1','G1'=>'&SUM("*25")');
&setrowlabels($sheetone,
'da1'=>'A Points','da2'=>'B Points','da3'=>'C Points',
'da4'=>'Percentage Correct','da5'=>'Bonus Points','da6'=>'Points Awarded');
&setconstants($sheetone,
'A1' => '3', 'A2'=>'4', 'A3'=>'0','A4'=>'76','A5'=>'1.5','A6'=>'6');
&setmaxrow($sheetone,6);
&calcsheet($sheetone);
$r->print(&outsheet($sheetone));
$r->print('</body></html>');
} 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;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>