--- loncom/interface/Attic/lonspreadsheet.pm 2000/12/09 19:14:20 1.10
+++ loncom/interface/Attic/lonspreadsheet.pm 2000/12/18 13:45:40 1.17
@@ -1,12 +1,12 @@
# 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 Gerd Kortemeyer
+# 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 vars qw(%spreadsheets);
use Safe;
use Safe::Hole;
use Opcode;
@@ -15,6 +15,22 @@ 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
@@ -244,9 +260,15 @@ sub SUMMIN {
sub sett {
%t=();
+ my $pattern='';
+ if ($sheettype eq 'assesscalc') {
+ $pattern='A';
+ } else {
+ $pattern='[A-Z]';
+ }
map {
if ($f{$_}) {
- if ($_=~/^A/) {
+ if ($_=~/^$pattern/) {
unless ($f{$_}=~/^\!/) {
$t{$_}=$c{$_};
}
@@ -257,6 +279,9 @@ sub sett {
}
}
} keys %f;
+ $t{'A0'}=$f{'A0'};
+ $t{'A0'}=~s/\.\.+/\,/g;
+ $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
}
sub calc {
@@ -284,7 +309,7 @@ sub calc {
return '';
}
-sub outrow {
+sub outrowassess {
my $n=shift;
my @cols=();
if ($n) {
@@ -303,6 +328,16 @@ sub outrow {
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);
@@ -355,7 +390,7 @@ sub getformulas {
sub settype {
my ($safeeval,$type)=@_;
- $safeeval->reval('$sheettype='.$type.';');
+ $safeeval->reval('$sheettype="'.$type.'";');
}
# -------------------------------------------------------------------- Get type
@@ -382,7 +417,7 @@ sub getmaxrow {
sub setfilename {
my ($safeeval,$fn)=@_;
- $safeeval->reval('$filename='.$fn.';');
+ $safeeval->reval('$filename="'.$fn.'";');
}
# ---------------------------------------------------------------- Get filename
@@ -391,7 +426,14 @@ 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
# =============================================================================
@@ -403,13 +445,19 @@ sub rown {
my $defaultbg=((($n-1)/5)==int(($n-1)/5))?'#E0E0':'#FFFF';
my $rowdata="\n
$n | ";
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) {
+ if (($showf>1) || ((!$n) && ($showf>0))) {
if ($vl eq '') {
$vl='#';
}
@@ -420,7 +468,7 @@ sub rown {
$rowdata.=' '.$vl.' | ';
}
$showf++;
- } $safeeval->reval('&outrow('.$n.')');
+ } $safeeval->reval($proc.'('.$n.')');
return $rowdata.'
';
}
@@ -482,7 +530,7 @@ sub readsheet {
# ----------------------------------------------- Make a temp copy of the sheet
sub tmpwrite {
- my ($safeeval,$tmpdir,$uname,$udom,$symb)=@_;
+ my ($safeeval,$tmpdir,$symb)=@_;
my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
$fn=~s/\W/\_/g;
$fn=$tmpdir.$fn.'.tmp';
@@ -495,7 +543,7 @@ sub tmpwrite {
# ---------------------------------------------------------- Read the temp copy
sub tmpread {
- my ($safeeval,$tmpdir,$uname,$udom,$symb,$nfield,$nform)=@_;
+ my ($safeeval,$tmpdir,$symb,$nfield,$nform)=@_;
my $fn=$uname.'_'.$udom.'_spreadsheet_'.&getfilename($safeeval);
$fn=~s/\W/\_/g;
$fn=$tmpdir.$fn.'.tmp';
@@ -541,6 +589,83 @@ sub readmeta {
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 {
@@ -571,7 +696,7 @@ sub updaterows {
if ($stype eq 'assesscalc') {
map {
- if ($_=~/^stores\_(.*)/) {
+ if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) {
my $key=$_;
my $display=
&Apache::lonnet::metadata($srcf,$key.'.display');
@@ -579,8 +704,6 @@ sub updaterows {
$display=
&Apache::lonnet::metadata($srcf,$key.'.name');
}
-
-
$allkeys{$key}=$display;
}
} split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
@@ -591,7 +714,7 @@ sub updaterows {
untie(%bighash);
#
-# %allkeys has a list of storage displays by unikey
+# %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
@@ -614,7 +737,7 @@ sub updaterows {
if ($_=~/^A(\d+)/) {
$maxrow=($1>$maxrow)?$1:$maxrow;
$existing{$f{$_}}=1;
- unless (defined($current{$f{$_}})) {
+ unless ((defined($current{$f{$_}})) || (!$1)) {
$f{$_}='!!! Obsolete';
$changed=1;
}
@@ -641,18 +764,55 @@ sub updaterows {
}
}
+# --------------------------------------------------- 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}.'
';
+ $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,$uname,$udom,$symb)=@_;
+ my ($safeeval,$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);
+
+# ----------------------------------------------------------- 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{&unescape($name)}=&unescape($value);
+ $returnhash{&Apache::lonnet::unescape($name)}=
+ &Apache::lonnet::unescape($value);
} split(/\&/,$answer);
my $version;
for ($version=1;$version<=$returnhash{'version'};$version++) {
@@ -660,16 +820,65 @@ 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);
+ 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{$_}=~/^\!/) {
- $c{$_}=$returnhash{$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);
}
@@ -697,11 +906,15 @@ sub selectbox {
return $selout.'';
}
-# ---------------------------------------------------------------- Main handler
+# ================================================================ Main handler
sub handler {
my $r=shift;
+ $uname='';
+ $udom='';
+ $csec='';
+
if ($r->header_only) {
$r->content_type('text/html');
$r->send_http_header;
@@ -714,11 +927,12 @@ sub handler {
($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')) {
+ if (($name eq 'uname') || ($name eq 'udom') || ($name eq 'usymb')) {
unless ($ENV{'form.'.$name}) {
$ENV{'form.'.$name}=$value;
}
@@ -728,14 +942,26 @@ sub handler {
# ------------------------------------------- Nothing there? Must be login user
unless ($ENV{'form.uname'}) {
- $ENV{'form.uname'}=$ENV{'user.name'};
- $ENV{'form.udom'}=$ENV{'user.domain'};
+ $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('LON-CAPA Spreadsheet');
$r->print(<
@@ -758,29 +984,74 @@ ENDSCRIPT
&hiddenfield('usymb',$ENV{'form.usymb'}).
&hiddenfield('unewfield','').
&hiddenfield('unewformula',''));
+ }
+
+# ---------------------------------------- Read new sheet or modified worksheet
+
my $sheetone=initsheet();
if ($ENV{'form.unewfield'}) {
$r->print('Modified Workcopy
');
$ENV{'form.unewformula'}=~s/\'/\"/g;
$r->print('New formula: '.$ENV{'form.unewfield'}.'='.
$ENV{'form.unewformula'}.'
');
- &tmpread($sheetone,$r->dir_config('lonDaemons').'/tmp/',
- $ENV{'form.uname'},$ENV{'form.udom'},$ENV{'form.usymb'},
- $ENV{'form.unewfield'},$ENV{'form.unewformula'});
&setfilename($sheetone,$r->filename);
$r->filename=~/\.(\w+)/;
&settype($sheetone,$1);
- } else {
+ &tmpread($sheetone,$r->dir_config('lonDaemons').'/tmp/',
+ $ENV{'form.usymb'},
+ $ENV{'form.unewfield'},$ENV{'form.unewformula'});
+ } else {
&readsheet($sheetone,$r->filename);
}
- &updaterows($sheetone);
- &tmpwrite($sheetone,$r->dir_config('lonDaemons').'/tmp/',
- $ENV{'form.uname'},$ENV{'form.udom'},$ENV{'form.usymb'});
+
+# --------------------------------------------- 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(''.
+ "User '$uname' at domain '$udom' not a student in this course
");
+ }
+ &updaterows($sheetone);
+ untie(%parmhash);
+ } else {
+ $r->print(''.
+ 'Could not initialize import fields (not in a course)
');
+ }
+
+# ------------------------------------------------ Write the modified worksheet
+
+ &tmpwrite($sheetone,$r->dir_config('lonDaemons').'/tmp/',
+ $ENV{'form.usymb'});
+
+# ----------------------------------------------------- Print user, course, etc
+ unless ($reroute) {
+ $r->print("User '$uname' at domain '$udom' for '".
+ $ENV{'course.'.$ENV{'request.course.id'}.'.description'}."'");
+ if ($csec) {
+ $r->print(", group/section '$csec'");
+ }
+ $r->print("\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('');
-
+ } else {
+ $r->print(&exportrow($sheetone));
+ }
+# ------------------------------------------------------------------------ Done
} else {
# ----------------------------- Not in a course, or not allowed to modify parms
$ENV{'user.error.msg'}=