# The LearningOnline Network with CAPA
# Spreadsheet/Grades Display Handler
#
# 11/11,11/15,11/27,12/04,12/05,12/06,12/07,
# 12/08,12/09,12/11,12/12,12/15,12/16,12/18 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;
#
# These cache hashes need to be independent of user, resource and course
# (user and course are in the keys)
#
use vars qw(%spreadsheets %courserdatas %userrdatas);
#
# 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;
my $csec;
my $uname;
my $udom;
# =============================================================================
# ===================================== 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=();
my $pattern='';
if ($sheettype eq 'assesscalc') {
$pattern='A';
} else {
$pattern='[A-Z]';
}
map {
if ($f{$_}) {
if ($_=~/^$pattern/) {
unless ($f{$_}=~/^\!/) {
$t{$_}=$c{$_};
}
} else {
$t{$_}=$f{$_};
$t{$_}=~s/\.\.+/\,/g;
$t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
}
}
} keys %f;
$t{'A0'}=$f{'A0'};
$t{'A0'}=~s/\.\.+/\,/g;
$t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
}
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 outrowassess {
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;
}
sub exportrowa {
my $rowa='';
map {
$rowa.=$v{$_.'0'}."','";
} ('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');
$rowa=~s/\'\,\'$//;
return $rowa;
}
# ------------------------------------------- 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');
}
# ------------------------------------------------------------- Export of A-row
sub exportrow {
my $safeeval=shift;
return $safeeval->reval('&exportrowa()');
}
# ========================================================== 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<tr><td><b><font size=+1>$n</font></b></td>";
my $showf=0;
my $proc;
if (&gettype($safeeval) eq 'assesscalc') {
$proc='&outrowassess';
} else {
$proc='&outrow';
}
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) || ((!$n) && ($showf>0))) {
if ($vl eq '') {
$vl='<font size=+2 color='.$bgcolor.'>#</font>';
}
$rowdata.=
'<td bgcolor='.$bgcolor.'><a href="javascript:celledit('.$fm.');">'.$vl.
'</a></td>';
} else {
$rowdata.='<td bgcolor='.$bgcolor.'> '.$vl.' </td>';
}
$showf++;
} $safeeval->reval($proc.'('.$n.')');
return $rowdata.'</tr>';
}
# ------------------------------------------------------------- Print out sheet
sub outsheet {
my $safeeval=shift;
my $tabledata='<table border=2><tr><td colspan=2> </td>'.
'<td bgcolor=#FFDDDD><b>A Import</b></td>';
map {
$tabledata.="<td><b><font size=+1>$_</font></b></td>";
} ('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)=@_;
&setfilename($safeeval,$fn);
$fn=~/\.(\w+)/;
&settype($safeeval,$1);
my %f=();
unless ($spreadsheets{$fn}) {
$spreadsheets{$fn}='';
{
my $fh;
if ($fh=Apache::File->new($fn)) {
$spreadsheets{$fn}=join('',<$fh>);
}
}
}
{
my $parser=HTML::TokeParser->new(\$spreadsheets{$fn});
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);
}
# ----------------------------------------------- Make a temp copy of the sheet
sub tmpwrite {
my ($safeeval,$tmpdir,$symb)=@_;
my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
$fn=~s/\W/\_/g;
$fn=$tmpdir.$fn.'.tmp';
my $fh;
if ($fh=Apache::File->new('>'.$fn)) {
print $fh join("\n",&getformulas($safeeval));
}
}
# ---------------------------------------------------------- Read the temp copy
sub tmpread {
my ($safeeval,$tmpdir,$symb,$nfield,$nform)=@_;
my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
$fn=~s/\W/\_/g;
$fn=$tmpdir.$fn.'.tmp';
my $fh;
my %fo=();
if ($fh=Apache::File->new($fn)) {
my $name;
while ($name=<$fh>) {
chomp($name);
my $value=<$fh>;
chomp($value);
$fo{$name}=$value;
}
}
$fo{$nfield}=$nform;
&setformulas($safeeval,%fo);
}
# --------------------------------------------------------------- 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;
}
# ================================================================== Parameters
# -------------------------------------------- Figure out a cascading parameter
sub parmval {
my ($what,$symb)=@_;
unless ($symb) { return ''; }
my $result='';
my ($mapname,$id,$fn)=split(/\_\_\_/,$symb);
# ----------------------------------------------------- Cascading lookup scheme
my $rwhat=$what;
$what=~s/^parameter\_//;
$what=~s/\_/\./;
my $symbparm=$symb.'.'.$what;
my $mapparm=$mapname.'___(all).'.$what;
my $seclevel=
$ENV{'request.course.id'}.'.['.
$csec.'].'.$what;
my $seclevelr=
$ENV{'request.course.id'}.'.['.
$csec.'].'.$symbparm;
my $seclevelm=
$ENV{'request.course.id'}.'.['.
$csec.'].'.$mapparm;
my $courselevel=
$ENV{'request.course.id'}.'.'.$what;
my $courselevelr=
$ENV{'request.course.id'}.'.'.$symbparm;
my $courselevelm=
$ENV{'request.course.id'}.'.'.$mapparm;
# ---------------------------------------------------------- fourth, check user
if ($uname) {
if ($useropt{$courselevelr}) { return $useropt{$courselevelr}; }
if ($useropt{$courselevelm}) { return $useropt{$courselevelm}; }
if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
}
# --------------------------------------------------------- third, check course
if ($csec) {
if ($courseopt{$seclevelr}) { return $courseopt{$seclevelr}; }
if ($courseopt{$seclevelm}) { return $courseopt{$seclevelm}; }
if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }
}
if ($courseopt{$courselevelr}) { return $courseopt{$courselevelr}; }
if ($courseopt{$courselevelm}) { return $courseopt{$courselevelm}; }
if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
# ----------------------------------------------------- second, check map parms
my $thisparm=$parmhash{$symbparm};
if ($thisparm) { return $thisparm; }
# -------------------------------------------------------- first, check default
return &Apache::lonnet::metadata($fn,$rwhat.'.default');
}
# ----------------------------------------------------------------- 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\_(.*)/) || ($_=~/^parameter\_(.*)/)) {
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 and parameter 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{$_}})) || (!$1)) {
$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 student
sub rowazstudent {
my $safeeval=shift;
my %c=();
my %f=&getformulas($safeeval);
map {
if ($_=~/^A(\d+)/) {
my $row=$1;
unless ($f{$_}=~/^\!/) {
my @assessdata=split(/\,/,
&Apache::lonnet::ssi(
'/res/msu/korte/junk.assesscalc',('utarget' => 'export',
'uname' => $uname,
'udom' => $udom,
'usymb' => $f{$_})));
my $index=0;
map {
$c{$_.$row}=$assessdata[$index];
print $_.':'.$c{$_.$row}.'<br>';
$index++;
} ('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');
}
}
} keys %f;
&setconstants($safeeval,%c);
}
# ------------------------------------------------ Load data for one assessment
sub rowaassess {
my ($safeeval,$symb)=@_;
my $uhome=&Apache::lonnet::homeserver($uname,$udom);
my $namespace;
unless ($namespace=$ENV{'request.course.id'}) { return ''; }
# ----------------------------------------------------------- Get stored values
my $answer=&Apache::lonnet::reply(
"restore:$udom:$uname:".
&Apache::lonnet::escape($namespace).":".
&Apache::lonnet::escape($symb),$uhome);
my %returnhash=();
map {
my ($name,$value)=split(/\=/,$_);
$returnhash{&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);
} split(/\&/,$answer);
my $version;
for ($version=1;$version<=$returnhash{'version'};$version++) {
map {
$returnhash{$_}=$returnhash{$version.':'.$_};
} split(/\:/,$returnhash{$version.':keys'});
}
# ----------------------------- returnhash now has all stores for this resource
# ---------------------------- initialize coursedata and userdata for this user
%courseopt=();
%useropt=();
my $uhome=&Apache::lonnet::homeserver($uname,$udom);
unless ($uhome eq 'no_host') {
# -------------------------------------------------------------- Get coursedata
unless
((time-$courserdatas{$ENV{'request.course.id'}.'.last_cache'})<120) {
my $reply=&Apache::lonnet::reply('dump:'.
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
$ENV{'course.'.$ENV{'request.course.id'}.'.home'});
if ($reply!~/^error\:/) {
$courserdatas{$ENV{'request.course.id'}}=$reply;
$courserdatas{$ENV{'request.course.id'}.'.last_cache'}=time;
}
}
map {
my ($name,$value)=split(/\=/,$_);
$courseopt{&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);
} split(/\&/,$courserdatas{$ENV{'request.course.id'}});
# --------------------------------------------------- Get userdata (if present)
unless
((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<120) {
my $reply=
&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
if ($reply!~/^error\:/) {
$userrdatas{$uname.'___'.$udom}=$reply;
$userrdatas{$uname.'___'.$udom.'.last_cache'}=time;
}
}
map {
my ($name,$value)=split(/\=/,$_);
$useropt{&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);
} split(/\&/,$userrdatas{$uname.'___'.$udom});
}
# -- now courseopt, useropt initialized for this user and course (used parmval)
my %c=();
my %f=&getformulas($safeeval);
map {
if ($_=~/^A/) {
unless ($f{$_}=~/^\!/) {
if ($f{$_}=~/^parameter/) {
$c{$_}=&parmval($f{$_},$symb);
} else {
my $key=$f{$_};
$key=~s/^stores\_/resource\./;
$key=~s/\_/\./;
$c{$_}=$returnhash{$key};
}
}
}
} keys %f;
&setconstants($safeeval,%c);
}
# --------------------------------------------------------- Various form fields
sub textfield {
my ($title,$name,$value)=@_;
return "\n<p><b>$title:</b><br>".
'<input type=text name="'.$name.'" size=80 value="'.$value.'">';
}
sub hiddenfield {
my ($name,$value)=@_;
return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
}
sub selectbox {
my ($title,$name,$value,%options)=@_;
my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
map {
$selout.='<option value="'.$_.'"';
if ($_ eq $value) { $selout.=' selected'; }
$selout.='>'.$options{$_}.'</option>';
} sort keys %options;
return $selout.'</select>';
}
# ================================================================ Main handler
sub handler {
my $r=shift;
$uname='';
$udom='';
$csec='';
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 eq 'uname') || ($name eq 'udom') || ($name eq 'usymb')) {
unless ($ENV{'form.'.$name}) {
$ENV{'form.'.$name}=$value;
}
}
} (split(/&/,$ENV{'QUERY_STRING'}));
# ------------------------------------------- Nothing there? Must be login user
unless ($ENV{'form.uname'}) {
$uname=$ENV{'user.name'};
$udom=$ENV{'user.domain'};
} else {
$uname=$ENV{'form.uname'};
$udom=$ENV{'form.udom'};
}
# ----------------------------------------------------------- Change of target?
my $reroute=($ENV{'form.utarget'} eq 'export');
# ------------------------------------------------------------------- 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
unless ($reroute) {
$r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
$r->print(<<ENDSCRIPT);
<script language="JavaScript">
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();
}
}
</script>
ENDSCRIPT
$r->print('</head><body bgcolor="#FFFFFF">'.
'<form action="'.$r->uri.'" name=sheet method=post>'.
&hiddenfield('uname',$ENV{'form.uname'}).
&hiddenfield('udom',$ENV{'form.udom'}).
&hiddenfield('usymb',$ENV{'form.usymb'}).
&hiddenfield('unewfield','').
&hiddenfield('unewformula',''));
}
# ---------------------------------------- Read new sheet or modified worksheet
my $sheetone=initsheet();
if ($ENV{'form.unewfield'}) {
$r->print('<h2>Modified Workcopy</h2>');
$ENV{'form.unewformula'}=~s/\'/\"/g;
$r->print('New formula: '.$ENV{'form.unewfield'}.'='.
$ENV{'form.unewformula'}.'<br>');
&setfilename($sheetone,$r->filename);
$r->filename=~/\.(\w+)/;
&settype($sheetone,$1);
&tmpread($sheetone,$r->dir_config('lonDaemons').'/tmp/',
$ENV{'form.usymb'},
$ENV{'form.unewfield'},$ENV{'form.unewformula'});
} else {
&readsheet($sheetone,$r->filename);
}
# --------------------------------------------- See if all import rows uptodate
if (tie(%parmhash,'GDBM_File',
$ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640)) {
$csec=&Apache::lonnet::usection($udom,$uname,$ENV{'request.course.id'});
if ($csec eq '-1') {
$r->print('<h3><font color=red>'.
"User '$uname' at domain '$udom' not a student in this course</font></h3>");
}
&updaterows($sheetone);
untie(%parmhash);
} else {
$r->print('<h3><font color=red>'.
'Could not initialize import fields (not in a course)</font></h3>');
}
# ------------------------------------------------ Write the modified worksheet
&tmpwrite($sheetone,$r->dir_config('lonDaemons').'/tmp/',
$ENV{'form.usymb'});
# ----------------------------------------------------- Print user, course, etc
unless ($reroute) {
$r->print("<b>User '$uname' at domain '$udom' for '".
$ENV{'course.'.$ENV{'request.course.id'}.'.description'}."'");
if ($csec) {
$r->print(", group/section '$csec'");
}
$r->print("</b>\n");
}
# -------------------------------------------------------- Import and calculate
if (&gettype($sheetone) eq 'assesscalc') {
&rowaassess($sheetone,$ENV{'form.usymb'});
} elsif (&gettype($sheetone) eq 'studentcalc') {
&rowazstudent($sheetone);
}
&calcsheet($sheetone);
# ------------------------------------------------------- Print or export sheet
unless ($reroute) {
$r->print(&outsheet($sheetone));
$r->print('</form></body></html>');
} else {
$r->print(&exportrow($sheetone));
}
# ------------------------------------------------------------------------ Done
} 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>