--- loncom/interface/Attic/lonspreadsheet.pm 2001/01/02 16:03:14 1.28
+++ loncom/interface/Attic/lonspreadsheet.pm 2001/01/22 22:54:16 1.38
@@ -3,10 +3,10 @@
#
# 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,
-# 01/01/01,02/01 Gerd Kortemeyer
+# 01/01/01,02/01,03/01,19/01,20/01,22/01 Gerd Kortemeyer
package Apache::lonspreadsheet;
-
+
use strict;
use Safe;
use Safe::Hole;
@@ -20,7 +20,12 @@ use HTML::TokeParser;
# These cache hashes need to be independent of user, resource and course
# (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,
@@ -35,11 +40,30 @@ my %parmhash;
my $includedir;
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."
\n";
+}
+
+
+
+
# =============================================================================
# ===================================== Implements an instance of a spreadsheet
sub initsheet {
- my $safeeval = new Safe;
+ my $safeeval = new Safe(shift);
my $safehole = new Safe::Hole;
$safeeval->permit("entereval");
$safeeval->permit(":base_math");
@@ -56,11 +80,11 @@ sub initsheet {
# c: preloaded constants (A-column)
# rl: row label
-%v=();
-%t=();
-%f=();
-%c=();
-%rl=();
+undef %v;
+undef %t;
+undef %f;
+undef %c;
+undef %rl;
$maxrow=0;
$sheettype='';
@@ -81,6 +105,7 @@ $chome='';
$cnum='';
$cdom='';
$cid='';
+$cfn='';
# symb
@@ -303,6 +328,7 @@ sub sett {
$t{$lb}=~s/\#/$trow/g;
$t{$lb}=~s/\.\.+/\,/g;
$t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
+ $t{$lb}=~s/(^|[^\"\'])\[([\w\.]+)\]/$1\$c\{\'$2\'\}/g;
}
}
} keys %f;
@@ -319,12 +345,14 @@ sub sett {
$t{$_}=$f{$_};
$t{$_}=~s/\.\.+/\,/g;
$t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
+ $t{$_}=~s/(^|[^\"\'])\[([\w\.]+)\]/$1\$c\{\'$2\'\}/g;
}
}
} keys %f;
$t{'A0'}=$f{'A0'};
$t{'A0'}=~s/\.\.+/\,/g;
$t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
+ $t{'A0'}=~s/(^|[^\"\'])\[([\w\.]+)\]/$1\$c\{\'$2\'\}/g;
}
sub calc {
@@ -422,22 +450,22 @@ ENDDEFS
# ------------------------------------------------ Add or change formula values
sub setformulas {
- my ($safeeval,@f)=@_;
- $safeeval->reval('%f='."('".join("','",@f)."');");
+ my ($safeeval,%f)=@_;
+ %{$safeeval->varglob('f')}=%f;
}
# ------------------------------------------------ Add or change formula values
sub setconstants {
- my ($safeeval,@c)=@_;
- $safeeval->reval('%c='."('".join("','",@c)."');");
+ my ($safeeval,%c)=@_;
+ %{$safeeval->varglob('c')}=%c;
}
# ------------------------------------------------ Add or change formula values
sub setrowlabels {
- my ($safeeval,@rl)=@_;
- $safeeval->reval('%rl='."('".join("','",@rl)."');");
+ my ($safeeval,%rl)=@_;
+ %{$safeeval->varglob('rl')}=%rl;
}
# ------------------------------------------------------- Calculate spreadsheet
@@ -458,7 +486,7 @@ sub getvalues {
sub getformulas {
my $safeeval=shift;
- return $safeeval->reval('%f');
+ return %{$safeeval->varglob('f')};
}
# -------------------------------------------------------------------- Get type
@@ -495,6 +523,7 @@ sub getfilename {
my $safeeval=shift;
return $safeeval->reval('$filename');
}
+
# --------------------------------------------------------------- Get course ID
sub getcid {
@@ -502,6 +531,13 @@ sub getcid {
return $safeeval->reval('$cid');
}
+# --------------------------------------------------------- Get course filename
+
+sub getcfn {
+ my $safeeval=shift;
+ return $safeeval->reval('$cfn');
+}
+
# ----------------------------------------------------------- Get course number
sub getcnum {
@@ -765,16 +801,20 @@ sub readsheet {
sub makenewsheet {
my ($uname,$udom,$stype,$usymb)=@_;
- my $safeeval=initsheet();
+ my $safeeval=initsheet($stype);
$safeeval->reval(
- '$uname='.$uname.
- ';$udom='.$udom.
- ';$sheettype='.$stype.
- ';$usymb='.$usymb.
- ';$cid='.$ENV{'request.course.id'}.
- ';$cnum='.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
- ';$cdom='.$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
- ';$chome='.$ENV{'course.'.$ENV{'request.course.id'}.'.home'}.';');
+ '$uname="'.$uname.
+ '";$udom="'.$udom.
+ '";$uhome="'.&Apache::lonnet::homeserver($uname,$udom).
+ '";$sheettype="'.$stype.
+ '";$usymb="'.$usymb.
+ '";$csec="'.&Apache::lonnet::usection($udom,$uname,
+ $ENV{'request.course.id'}).
+ '";$cid="'.$ENV{'request.course.id'}.
+ '";$cfn="'.$ENV{'request.course.fn'}.
+ '";$cnum="'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
+ '";$cdom="'.$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
+ '";$chome="'.$ENV{'course.'.$ENV{'request.course.id'}.'.home'}.'";');
return $safeeval;
}
@@ -804,7 +844,7 @@ sub writesheet {
$sheetdata,$chome);
if ($reply eq 'ok') {
$reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.
- &stype.'_spreadsheets:'.
+ $stype.'_spreadsheets:'.
&Apache::lonnet::escape($fn).'='.$ENV{'user.name'},
$chome);
if ($reply eq 'ok') {
@@ -870,6 +910,11 @@ sub tmpread {
# ================================================================== Parameters
# -------------------------------------------- Figure out a cascading parameter
#
+# For this function to work
+#
+# * parmhash needs to be tied
+# * courseopt and useropt need to be initialized for this user and course
+#
sub parmval {
my ($what,$safeeval)=@_;
@@ -890,7 +935,7 @@ sub parmval {
my $symbparm=$symb.'.'.$what;
my $mapparm=$mapname.'___(all).'.$what;
- my $usercourseprefix=$cid.'_'.$uname.'_'.$udom;
+ my $usercourseprefix=$uname.'_'.$udom.'_'.$cid;
my $seclevel=
$usercourseprefix.'.['.
@@ -1038,6 +1083,9 @@ sub updateclasssheet {
sub updatestudentassesssheet {
my $safeeval=shift;
my %bighash;
+ my $stype=&gettype($safeeval);
+ my %current=();
+ unless ($updatedata{$ENV{'request.course.fn'}.'_'.$stype}) {
# -------------------------------------------------------------------- Tie hash
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
&GDBM_READER,0640)) {
@@ -1046,8 +1094,6 @@ sub updatestudentassesssheet {
my %allkeys=();
my %allassess=();
- my $stype=&gettype($safeeval);
-
map {
if ($_=~/^src\_(\d+)\.(\d+)$/) {
my $mapid=$1;
@@ -1059,8 +1105,8 @@ sub updatestudentassesssheet {
&Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
'___'.$resid.'___'.
&Apache::lonnet::declutter($srcf);
- $allassess{$symb}=$bighash{'title_'.$id};
-
+ $allassess{$symb}=
+ ''.$bighash{'title_'.$id}.'';
if ($stype eq 'assesscalc') {
map {
if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) {
@@ -1084,17 +1130,26 @@ sub updatestudentassesssheet {
# %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;
}
+ $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 %existing=();
@@ -1120,33 +1175,30 @@ sub updatestudentassesssheet {
$f{'A'.$maxrow}=$_;
}
} keys %current;
-
+
if ($changed) { &setformulas($safeeval,%f); }
&setmaxrow($safeeval,$maxrow);
&setrowlabels($safeeval,%current);
-
- } else {
- return 'Could not access course data';
- }
+
+ undef %current;
+ undef %existing;
}
# ------------------------------------------------ Load data for one assessment
-sub rowazstudent {
+sub loadstudent {
my $safeeval=shift;
my %c=();
my %f=&getformulas($safeeval);
+ my @assessdata=();
map {
if ($_=~/^A(\d+)/) {
my $row=$1;
unless ($f{$_}=~/^\!/) {
- my @assessdata=split(/\_\_\_\;\_\_\_/,
- &Apache::lonnet::ssi(
- '/adm/assesscalc',('utarget' => 'export',
- 'uname' => $uname,
- 'udom' => $udom,
- 'usymb' => $f{$_})));
+ @assessdata=&exportsheet(&getuname($safeeval),
+ &getudom($safeeval),
+ 'assesscalc',$f{$_});
my $index=0;
map {
if ($assessdata[$index]) {
@@ -1167,24 +1219,38 @@ sub rowazstudent {
# --------------------------------------------------- Load data for one student
-sub rowazclass {
- my $safeeval=shift;
+sub loadcourse {
+ my ($safeeval,$r)=@_;
my %c=();
my %f=&getformulas($safeeval);
+ my $total=0;
+ map {
+ if ($_=~/^A(\d+)/) {
+ unless ($f{$_}=~/^\!/) { $total++; }
+ }
+ } keys %f;
+ my $now=0;
+ my $since=time;
+ $r->print('
'.
+ "
\n");
+ $r->rflush();
map {
if ($_=~/^A(\d+)/) {
my $row=$1;
unless ($f{$_}=~/^\!/) {
- my ($tname,$tdom)=split(/\:/,$_);
- my @assessdata=split(/\_\_\_\;\_\_\_/,
- &Apache::lonnet::ssi(
- '/adm/studentcalc',('utarget' => 'export',
- 'uname' => $tname,
- 'udom' => $tdom)));
+ my @studentdata=&exportsheet(split(/\:/,$f{$_}),
+ 'studentcalc');
+ undef %userrdatas;
+ $now++;
+ $r->print(''."
\n");
+ $r->rflush();
+
my $index=0;
map {
- if ($assessdata[$index]) {
- $c{$_.$row}=$assessdata[$index];
+ if ($studentdata[$index]) {
+ $c{$_.$row}=$studentdata[$index];
unless ($_ eq 'A') {
$f{$_.$row}='import';
}
@@ -1197,21 +1263,34 @@ sub rowazclass {
} keys %f;
&setformulas($safeeval,%f);
&setconstants($safeeval,%c);
+ $r->print(''.
+ "
\n");
+ $r->rflush();
}
# ------------------------------------------------ Load data for one assessment
-sub rowaassess {
- my ($safeeval,$symb)=@_;
- my $uhome=&Apache::lonnet::homeserver($uname,$udom);
+sub loadassessment {
+ my $safeeval=shift;
+
+ my $uhome=&getuhome($safeeval);
+ my $uname=&getuname($safeeval);
+ my $udom=&getudom($safeeval);
+ my $symb=&getusymb($safeeval);
+ my $cid=&getcid($safeeval);
+ my $cnum=&getcnum($safeeval);
+ my $cdom=&getcdom($safeeval);
+ my $chome=&getchome($safeeval);
+
my $namespace;
- unless ($namespace=$ENV{'request.course.id'}) { return ''; }
+ unless ($namespace=$cid) { 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(/\=/,$_);
@@ -1224,33 +1303,34 @@ sub rowaassess {
$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);
+ undef %courseopt;
+ undef %useropt;
+
+ my $userprefix=$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'});
+ ((time-$courserdatas{$cid.'.last_cache'})<240) {
+ my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.
+ ':resourcedata',$chome);
if ($reply!~/^error\:/) {
- $courserdatas{$ENV{'request.course.id'}}=$reply;
- $courserdatas{$ENV{'request.course.id'}.'.last_cache'}=time;
+ $courserdatas{$cid}=$reply;
+ $courserdatas{$cid.'.last_cache'}=time;
}
}
map {
my ($name,$value)=split(/\=/,$_);
- $courseopt{&Apache::lonnet::unescape($name)}=
+ $courseopt{$userprefix.&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);
- } split(/\&/,$courserdatas{$ENV{'request.course.id'}});
+ } split(/\&/,$courserdatas{$cid});
# --------------------------------------------------- Get userdata (if present)
unless
- ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<120) {
+ ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) {
my $reply=
&Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
if ($reply!~/^error\:/) {
@@ -1260,13 +1340,17 @@ sub rowaassess {
}
map {
my ($name,$value)=split(/\=/,$_);
- $useropt{&Apache::lonnet::unescape($name)}=
+ $useropt{$userprefix.&Apache::lonnet::unescape($name)}=
&Apache::lonnet::unescape($value);
} split(/\&/,$userrdatas{$uname.'___'.$udom});
- }
-# -- now courseopt, useropt initialized for this user and course (used parmval)
+ }
+# ----------------- now courseopt, useropt initialized for this user and course
+# (used by parmval)
- my %c=();
+ my %c=();
+
+ if (tie(%parmhash,'GDBM_File',
+ &getcfn($safeeval).'_parms.db',&GDBM_READER,0640)) {
my %f=&getformulas($safeeval);
map {
if ($_=~/^A/) {
@@ -1278,12 +1362,14 @@ sub rowaassess {
$key=~s/^stores\_/resource\./;
$key=~s/\_/\./;
$c{$_}=$returnhash{$key};
+ $c{$key}=$returnhash{$key};
}
}
}
} keys %f;
-
- &setconstants($safeeval,%c);
+ untie(%parmhash);
+ }
+ &setconstants($safeeval,%c);
}
# --------------------------------------------------------- Various form fields
@@ -1330,15 +1416,15 @@ sub updatesheet {
# Import the data for rows
#
-sub loadrows() {
- my $safeeval=shift;
+sub loadrows {
+ my ($safeeval,$r)=@_;
my $stype=&gettype($safeeval);
if ($stype eq 'classcalc') {
- &loadcourse($thissheet);
+ &loadcourse($safeeval,$r);
} elsif ($stype eq 'studentcalc') {
- &loadstudent($thissheet);
+ &loadstudent($safeeval);
} else {
- &loadassessment($thissheet);
+ &loadassessment($safeeval);
}
}
@@ -1348,8 +1434,9 @@ sub loadrows() {
#
sub exportsheet {
+
my ($uname,$udom,$stype,$usymb,$fn)=@_;
- my $thissheet=($uname,$udom,$stype,$usymb);
+ my $thissheet=&makenewsheet($uname,$udom,$stype,$usymb);
&readsheet($thissheet,$fn);
&updatesheet($thissheet);
&loadrows($thissheet);
@@ -1375,13 +1462,12 @@ sub handler {
# ---------------------------------------------------- Global directory configs
-$includedir=r->dir_config('lonIncludes');
+$includedir=$r->dir_config('lonIncludes');
$tmpdir=$r->dir_config('lonDaemons').'/tmp/';
# ----------------------------------------------------- Needs to be in a course
- if (($ENV{'request.course.fn'}) ||
- ($ENV{'request.state'} eq 'construct')) {
+ if ($ENV{'request.course.fn'}) {
# --------------------------- Get query string for limited number of parameters
@@ -1398,16 +1484,17 @@ $tmpdir=$r->dir_config('lonDaemons').'/t
} (split(/&/,$ENV{'QUERY_STRING'}));
# ------------------------------------------- Nothing there? Must be login user
+
+ my $aname;
+ my $adom;
+
unless ($ENV{'form.uname'}) {
- $uname=$ENV{'user.name'};
- $udom=$ENV{'user.domain'};
+ $aname=$ENV{'user.name'};
+ $adom=$ENV{'user.domain'};
} else {
- $uname=$ENV{'form.uname'};
- $udom=$ENV{'form.udom'};
+ $aname=$ENV{'form.uname'};
+ $adom=$ENV{'form.udom'};
}
-# ----------------------------------------------------------- Change of target?
-
- my $reroute=($ENV{'form.utarget'} eq 'export');
# ------------------------------------------------------------------- Open page
@@ -1418,7 +1505,6 @@ $tmpdir=$r->dir_config('lonDaemons').'/t
# --------------------------------------------------------------- Screen output
- unless ($reroute) {
$r->print('
New formula: '.$ENV{'form.unewfield'}.'='. $ENV{'form.unewformula'}.'
'); - &setfilename($sheetone,$ENV{'form.ufn'}); - &tmpread($sheetone,$r->dir_config('lonDaemons').'/tmp/', - $ENV{'form.usymb'}, + &setfilename($asheet,$ENV{'form.ufn'}); + &tmpread($asheet, $ENV{'form.unewfield'},$ENV{'form.unewformula'}); - } elsif ($ENV{'form.saveas'}) { - &setfilename($sheetone,$ENV{'form.ufn'}); - &tmpread($sheetone,, - $ENV{'form.usymb'}); + + } elsif ($ENV{'form.saveas'}) { + &setfilename($asheet,$ENV{'form.ufn'}); + &tmpread($asheet); } else { - unless ($ENV{'form.ufn'}) { + &readsheet($asheet,$ENV{'form.ufn'}); } - if (&gettype($sheetone) eq 'classcalc') { -# ---------------------------------- For course view: get courselist and update - &updatestudentrows($sheetone); - } else { -# ----------------- For assessment and student: See if all import rows uptodate +# -------------------------------------------------- Print out user information + + unless (&gettype($asheet) eq 'classcalc') { + $r->print('
User: '.&getuname($asheet).
+ '
Domain: '.&getudom($asheet));
+ if (&getcsec($asheet) eq '-1') {
+ $r->print('
Saving spreadsheet: '.$reply.'
'); - } - if ($ENV{'form.makedefufn'}) { - my $reply=&Apache::lonnet::reply('put:'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}. - ':environment:spreadsheet_default_'. - &gettype($sheetone).'='. - &Apache::lonnet::escape($fname), - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); - unless ($reroute) { - $r->print('
Making default spreadsheet: '.$reply.'
'); - } - } - } + $r->print('
Saving spreadsheet: '. + &writesheet($asheet,$ENV{'form.makedefufn'}).'
'); + } } + # ------------------------------------------------ Write the modified worksheet - &tmpwrite($sheetone,$r->dir_config('lonDaemons').'/tmp/', - $ENV{'form.usymb'}); + $r->print('Current sheet: '.&getfilename($asheet).'
'); + + &tmpwrite($asheet); + +# ----------------------------------------------------------------- Save dialog + -# ----------------------------------------------------- Print user, course, etc - unless ($reroute) { if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { my $fname=$ENV{'form.ufn'}; $fname=~s/\_[^\_]+$//; @@ -1529,38 +1609,35 @@ ENDSCRIPT ' (make default: )
');
}
- $r->print(&hiddenfield('ufn',$ENV{'form.ufn'}));
- unless (&gettype($sheetone) eq 'classcalc') {
- $r->print('
User: '.$uname.'
Domain: '.$udom);
- }
- $r->print('