version 1.32, 2001/01/02 23:27:11
|
version 1.36, 2001/01/20 22:57:05
|
Line 3
|
Line 3
|
# |
# |
# 11/11,11/15,11/27,12/04,12/05,12/06,12/07, |
# 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,12/19,12/30, |
# 12/08,12/09,12/11,12/12,12/15,12/16,12/18,12/19,12/30, |
# 01/01/01,02/01 Gerd Kortemeyer |
# 01/01/01,02/01,03/01,19/01,20/01 Gerd Kortemeyer |
|
|
package Apache::lonspreadsheet; |
package Apache::lonspreadsheet; |
|
|
use strict; |
use strict; |
use Safe; |
use Safe; |
use Safe::Hole; |
use Safe::Hole; |
Line 20 use HTML::TokeParser;
|
Line 20 use HTML::TokeParser;
|
# These cache hashes need to be independent of user, resource and course |
# These cache hashes need to be independent of user, resource and course |
# (user and course can/should be in the keys) |
# (user and course can/should be in the keys) |
# |
# |
use vars qw(%spreadsheets %courserdatas %userrdatas %defaultsheets); |
|
|
my %spreadsheets; |
|
my %courserdatas; |
|
my %userrdatas; |
|
my %defaultsheets; |
|
my %updatedata; |
|
|
# |
# |
# These global hashes are dependent on user, course and resource, |
# These global hashes are dependent on user, course and resource, |
Line 35 my %parmhash;
|
Line 40 my %parmhash;
|
my $includedir; |
my $includedir; |
my $tmpdir; |
my $tmpdir; |
|
|
|
|
|
sub mdeb { |
|
my $msg=shift; |
|
my $mem=''; |
|
{ |
|
my $mfh=Apache::File->new('/proc/'.$$.'/status'); |
|
my $line; |
|
while ($line=<$mfh>) { |
|
my ($name,$value)=split(/\:/,$line); |
|
if ($name eq 'VmSize') { $mem=$value; } |
|
} |
|
$mfh->close(); |
|
} |
|
print $msg.$mem."<br>\n"; |
|
} |
|
|
|
|
|
|
|
|
# ============================================================================= |
# ============================================================================= |
# ===================================== Implements an instance of a spreadsheet |
# ===================================== Implements an instance of a spreadsheet |
|
|
sub initsheet { |
sub initsheet { |
my $safeeval = new Safe; |
my $safeeval = new Safe(shift); |
my $safehole = new Safe::Hole; |
my $safehole = new Safe::Hole; |
$safeeval->permit("entereval"); |
$safeeval->permit("entereval"); |
$safeeval->permit(":base_math"); |
$safeeval->permit(":base_math"); |
Line 56 sub initsheet {
|
Line 80 sub initsheet {
|
# c: preloaded constants (A-column) |
# c: preloaded constants (A-column) |
# rl: row label |
# rl: row label |
|
|
%v=(); |
undef %v; |
%t=(); |
undef %t; |
%f=(); |
undef %f; |
%c=(); |
undef %c; |
%rl=(); |
undef %rl; |
|
|
$maxrow=0; |
$maxrow=0; |
$sheettype=''; |
$sheettype=''; |
Line 423 ENDDEFS
|
Line 447 ENDDEFS
|
# ------------------------------------------------ Add or change formula values |
# ------------------------------------------------ Add or change formula values |
|
|
sub setformulas { |
sub setformulas { |
my ($safeeval,@f)=@_; |
my ($safeeval,%f)=@_; |
$safeeval->reval('%f='."('".join("','",@f)."');"); |
%{$safeeval->varglob('f')}=%f; |
} |
} |
|
|
# ------------------------------------------------ Add or change formula values |
# ------------------------------------------------ Add or change formula values |
|
|
sub setconstants { |
sub setconstants { |
my ($safeeval,@c)=@_; |
my ($safeeval,%c)=@_; |
$safeeval->reval('%c='."('".join("','",@c)."');"); |
%{$safeeval->varglob('c')}=%c; |
} |
} |
|
|
# ------------------------------------------------ Add or change formula values |
# ------------------------------------------------ Add or change formula values |
|
|
sub setrowlabels { |
sub setrowlabels { |
my ($safeeval,@rl)=@_; |
my ($safeeval,%rl)=@_; |
$safeeval->reval('%rl='."('".join("','",@rl)."');"); |
%{$safeeval->varglob('rl')}=%rl; |
} |
} |
|
|
# ------------------------------------------------------- Calculate spreadsheet |
# ------------------------------------------------------- Calculate spreadsheet |
Line 459 sub getvalues {
|
Line 483 sub getvalues {
|
|
|
sub getformulas { |
sub getformulas { |
my $safeeval=shift; |
my $safeeval=shift; |
return $safeeval->reval('%f'); |
return %{$safeeval->varglob('f')}; |
} |
} |
|
|
# -------------------------------------------------------------------- Get type |
# -------------------------------------------------------------------- Get type |
Line 774 sub readsheet {
|
Line 798 sub readsheet {
|
|
|
sub makenewsheet { |
sub makenewsheet { |
my ($uname,$udom,$stype,$usymb)=@_; |
my ($uname,$udom,$stype,$usymb)=@_; |
my $safeeval=initsheet(); |
my $safeeval=initsheet($stype); |
$safeeval->reval( |
$safeeval->reval( |
'$uname="'.$uname. |
'$uname="'.$uname. |
'";$udom="'.$udom. |
'";$udom="'.$udom. |
Line 1056 sub updateclasssheet {
|
Line 1080 sub updateclasssheet {
|
sub updatestudentassesssheet { |
sub updatestudentassesssheet { |
my $safeeval=shift; |
my $safeeval=shift; |
my %bighash; |
my %bighash; |
|
my $stype=&gettype($safeeval); |
|
my %current=(); |
|
unless ($updatedata{$ENV{'request.course.fn'}.'_'.$stype}) { |
# -------------------------------------------------------------------- Tie hash |
# -------------------------------------------------------------------- Tie hash |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', |
&GDBM_READER,0640)) { |
&GDBM_READER,0640)) { |
Line 1064 sub updatestudentassesssheet {
|
Line 1091 sub updatestudentassesssheet {
|
my %allkeys=(); |
my %allkeys=(); |
my %allassess=(); |
my %allassess=(); |
|
|
my $stype=&gettype($safeeval); |
|
|
|
map { |
map { |
if ($_=~/^src\_(\d+)\.(\d+)$/) { |
if ($_=~/^src\_(\d+)\.(\d+)$/) { |
my $mapid=$1; |
my $mapid=$1; |
Line 1102 sub updatestudentassesssheet {
|
Line 1127 sub updatestudentassesssheet {
|
# %allkeys has a list of storage and parameter displays by unikey |
# %allkeys has a list of storage and parameter displays by unikey |
# %allassess has a list of all resource displays by symb |
# %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') { |
if ($stype eq 'assesscalc') { |
%current=%allkeys; |
%current=%allkeys; |
} elsif ($stype eq 'studentcalc') { |
} elsif ($stype eq 'studentcalc') { |
%current=%allassess; |
%current=%allassess; |
} |
} |
|
$updatedata{$ENV{'request.course.fn'}.'_'.$stype}= |
|
join('___;___',%current); |
|
} else { |
|
return 'Could not access course data'; |
|
} |
|
# ------------------------------------------------------ Get current from cache |
|
} else { |
|
%current=split(/\_\_\_\;\_\_\_/, |
|
$updatedata{$ENV{'request.course.fn'}.'_'.$stype}); |
|
} |
|
# -------------------- Find discrepancies between the course row table and this |
|
# |
|
my %f=&getformulas($safeeval); |
|
my $changed=0; |
|
|
my $maxrow=0; |
my $maxrow=0; |
my %existing=(); |
my %existing=(); |
Line 1138 sub updatestudentassesssheet {
|
Line 1172 sub updatestudentassesssheet {
|
$f{'A'.$maxrow}=$_; |
$f{'A'.$maxrow}=$_; |
} |
} |
} keys %current; |
} keys %current; |
|
|
if ($changed) { &setformulas($safeeval,%f); } |
if ($changed) { &setformulas($safeeval,%f); } |
|
|
&setmaxrow($safeeval,$maxrow); |
&setmaxrow($safeeval,$maxrow); |
&setrowlabels($safeeval,%current); |
&setrowlabels($safeeval,%current); |
|
|
} else { |
undef %current; |
return 'Could not access course data'; |
undef %existing; |
} |
|
} |
} |
|
|
# ------------------------------------------------ Load data for one assessment |
# ------------------------------------------------ Load data for one assessment |
Line 1155 sub loadstudent {
|
Line 1188 sub loadstudent {
|
my $safeeval=shift; |
my $safeeval=shift; |
my %c=(); |
my %c=(); |
my %f=&getformulas($safeeval); |
my %f=&getformulas($safeeval); |
|
my @assessdata=(); |
map { |
map { |
if ($_=~/^A(\d+)/) { |
if ($_=~/^A(\d+)/) { |
my $row=$1; |
my $row=$1; |
unless ($f{$_}=~/^\!/) { |
unless ($f{$_}=~/^\!/) { |
my @assessdata=&exportsheet(&getuname($safeeval), |
@assessdata=&exportsheet(&getuname($safeeval), |
&getudom($safeeval), |
&getudom($safeeval), |
'assesscalc',$f{$_}); |
'assesscalc',$f{$_}); |
my $index=0; |
my $index=0; |
map { |
map { |
if ($assessdata[$index]) { |
if ($assessdata[$index]) { |
Line 1189 sub loadcourse {
|
Line 1223 sub loadcourse {
|
map { |
map { |
if ($_=~/^A(\d+)/) { |
if ($_=~/^A(\d+)/) { |
my $row=$1; |
my $row=$1; |
unless (($f{$_}=~/^\!/) |
unless ($f{$_}=~/^\!/) { |
|
|
|| ($row>200)) |
|
|
|
{ |
|
my @studentdata=&exportsheet(&getuname($safeeval), |
my @studentdata=&exportsheet(&getuname($safeeval), |
&getudom($safeeval), |
&getudom($safeeval), |
'studentcalc'); |
'studentcalc'); |
Line 1273 sub loadassessment {
|
Line 1303 sub loadassessment {
|
my ($name,$value)=split(/\=/,$_); |
my ($name,$value)=split(/\=/,$_); |
$courseopt{$userprefix.&Apache::lonnet::unescape($name)}= |
$courseopt{$userprefix.&Apache::lonnet::unescape($name)}= |
&Apache::lonnet::unescape($value); |
&Apache::lonnet::unescape($value); |
} split(/\&/,$courserdatas{$ENV{'request.course.id'}}); |
} split(/\&/,$courserdatas{$cid}); |
# --------------------------------------------------- Get userdata (if present) |
# --------------------------------------------------- Get userdata (if present) |
unless |
unless |
((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) { |
((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) { |
Line 1380 sub loadrows() {
|
Line 1410 sub loadrows() {
|
# |
# |
|
|
sub exportsheet { |
sub exportsheet { |
|
|
my ($uname,$udom,$stype,$usymb,$fn)=@_; |
my ($uname,$udom,$stype,$usymb,$fn)=@_; |
my $thissheet=&makenewsheet($uname,$udom,$stype,$usymb); |
my $thissheet=&makenewsheet($uname,$udom,$stype,$usymb); |
&readsheet($thissheet,$fn); |
&readsheet($thissheet,$fn); |
&updatesheet($thissheet); |
&updatesheet($thissheet); |
&loadrows($thissheet); |
&loadrows($thissheet); |
&calcsheet($thissheet); |
&calcsheet($thissheet); |
my @returnthis=&exportdata($thissheet); |
return &exportdata($thissheet); |
undef $thissheet; |
|
return @returnthis; |
|
} |
} |
|
|
# ================================================================ Main handler |
# ================================================================ Main handler |
Line 1562 ENDSCRIPT
|
Line 1591 ENDSCRIPT
|
|
|
# ----------------------------------------------------- Update sheet, load rows |
# ----------------------------------------------------- Update sheet, load rows |
|
|
|
$r->print("Loaded sheet, updating rows ...<br>\n"); |
|
$r->rflush(); |
|
|
&updatesheet($asheet); |
&updatesheet($asheet); |
|
|
|
$r->print("Updated rows, loading row data ...<br>\n"); |
|
$r->rflush(); |
|
|
&loadrows($asheet); |
&loadrows($asheet); |
|
|
|
$r->print("Loaded row data, calculating sheet ...<br>\n"); |
|
$r->rflush(); |
|
|
my $calcoutput=&calcsheet($asheet); |
my $calcoutput=&calcsheet($asheet); |
$r->print('<h3><font color=red>'.$calcoutput.'</h3></font>'); |
$r->print('<h3><font color=red>'.$calcoutput.'</h3></font>'); |
Line 1572 ENDSCRIPT
|
Line 1610 ENDSCRIPT
|
&outsheet($r,$asheet); |
&outsheet($r,$asheet); |
$r->print('</form></body></html>'); |
$r->print('</form></body></html>'); |
|
|
|
# --------------------------------- We know this leaks, so terminate this child |
|
|
|
$r->child_terminate(); |
|
|
# ------------------------------------------------------------------------ Done |
# ------------------------------------------------------------------------ Done |
} else { |
} else { |