--- loncom/interface/Attic/lonspreadsheet.pm 2001/01/01 20:52:10 1.26 +++ loncom/interface/Attic/lonspreadsheet.pm 2001/03/17 20:43:57 1.46 @@ -3,10 +3,11 @@ # # 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 Gerd Kortemeyer +# 01/01/01,02/01,03/01,19/01,20/01,22/01, +# 03/05,03/08,03/10,03/12,03/13,03/15,03/17 Gerd Kortemeyer package Apache::lonspreadsheet; - + use strict; use Safe; use Safe::Hole; @@ -17,10 +18,30 @@ use GDBM_File; use HTML::TokeParser; # +# Caches for previously calculated spreadsheets +# + +my %oldsheets; +my %loadedcaches; + +# +# Cache for stores of an individual user +# + +my $cachedassess; +my %cachedstores; + +# # These cache hashes need to be independent of user, resource and course -# (user and course are in the keys) +# (user and course can/should be in the keys) # -use vars qw(%spreadsheets %courserdatas %userrdatas); + +my %spreadsheets; +my %courserdatas; +my %userrdatas; +my %defaultsheets; +my %updatedata; + # # These global hashes are dependent on user, course and resource, # and need to be initialized every time when a sheet is calculated @@ -28,15 +49,17 @@ use vars qw(%spreadsheets %courserdatas my %courseopt; my %useropt; my %parmhash; -my $csec; -my $uname; -my $udom; + +# Stuff that only the screen handler can know + +my $includedir; +my $tmpdir; # ============================================================================= # ===================================== 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"); @@ -53,16 +76,37 @@ 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=''; + +# filename/reference of the sheet + $filename=''; +# user data +$uname=''; +$uhome=''; +$udom=''; + +# course data + +$csec=''; +$chome=''; +$cnum=''; +$cdom=''; +$cid=''; +$cfn=''; + +# symb + +$usymb=''; + sub mask { my ($lower,$upper)=@_; @@ -280,6 +324,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; @@ -288,7 +333,8 @@ sub sett { } keys %f; map { if (($f{$_}) && ($_!~/template\_/)) { - if ($_=~/^$pattern/) { + my $matches=($_=~/^$pattern(\d+)/); + if (($matches) && ($1)) { unless ($f{$_}=~/^\!/) { $t{$_}=$c{$_}; } @@ -296,12 +342,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 { @@ -382,13 +430,12 @@ sub outrow { } sub exportrowa { - my $rowa=''; + my @exportarray=(); map { - $rowa.=$v{$_.'0'}."___;___"; + $exportarray[$#exportarray+1]=$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; + return @exportarray; } # ------------------------------------------- End of "Inside of the safe space" @@ -400,22 +447,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 @@ -436,14 +483,7 @@ sub getvalues { sub getformulas { my $safeeval=shift; - return $safeeval->reval('%f'); -} - -# -------------------------------------------------------------------- Set type - -sub settype { - my ($safeeval,$type)=@_; - $safeeval->reval('$sheettype="'.$type.'";'); + return %{$safeeval->varglob('f')}; } # -------------------------------------------------------------------- Get type @@ -452,6 +492,7 @@ sub gettype { my $safeeval=shift; return $safeeval->reval('$sheettype'); } + # ------------------------------------------------------------------ Set maxrow sub setmaxrow { @@ -480,9 +521,79 @@ sub getfilename { return $safeeval->reval('$filename'); } +# --------------------------------------------------------------- Get course ID + +sub getcid { + my $safeeval=shift; + return $safeeval->reval('$cid'); +} + +# --------------------------------------------------------- Get course filename + +sub getcfn { + my $safeeval=shift; + return $safeeval->reval('$cfn'); +} + +# ----------------------------------------------------------- Get course number + +sub getcnum { + my $safeeval=shift; + return $safeeval->reval('$cnum'); +} + +# ------------------------------------------------------------- Get course home + +sub getchome { + my $safeeval=shift; + return $safeeval->reval('$chome'); +} + +# ----------------------------------------------------------- Get course domain + +sub getcdom { + my $safeeval=shift; + return $safeeval->reval('$cdom'); +} + +# ---------------------------------------------------------- Get course section + +sub getcsec { + my $safeeval=shift; + return $safeeval->reval('$csec'); +} + +# --------------------------------------------------------------- Get user name + +sub getuname { + my $safeeval=shift; + return $safeeval->reval('$uname'); +} + +# ------------------------------------------------------------- Get user domain + +sub getudom { + my $safeeval=shift; + return $safeeval->reval('$udom'); +} + +# --------------------------------------------------------------- Get user home + +sub getuhome { + my $safeeval=shift; + return $safeeval->reval('$uhome'); +} + +# -------------------------------------------------------------------- Get symb + +sub getusymb { + my $safeeval=shift; + return $safeeval->reval('$usymb'); +} + # ------------------------------------------------------------- Export of A-row -sub exportrow { +sub exportdata { my $safeeval=shift; return $safeeval->reval('&exportrowa()'); } @@ -490,7 +601,9 @@ sub exportrow { # ========================================================== End of Spreadsheet # ============================================================================= - +# +# Procedures for screen output +# # --------------------------------------------- Produce output row n from sheet sub rown { @@ -600,25 +713,57 @@ sub outsheet { $r->print(''); } +# +# -------------------------------------- Read spreadsheet formulas for a course +# +sub readsheet { + my ($safeeval,$fn)=@_; + my $stype=&gettype($safeeval); + my $cnum=&getcnum($safeeval); + my $cdom=&getcdom($safeeval); + my $chome=&getchome($safeeval); + +# --------- There is no filename. Look for defaults in course and global, cache + + unless($fn) { + unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) { + $fn=&Apache::lonnet::reply('get:'.$cdom.':'.$cnum. + ':environment:spreadsheet_default_'.$stype, + $chome); + unless (($fn) && ($fn!~/^error\:/)) { + $fn='default_'.$stype; + } + $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; + } + } -# ------------------------------------- Read spreadsheet formulas from a course +# ---------------------------------------------------------- fn now has a value -sub readsheet { - my ($safeeval,$fn,$r)=@_; - my %f=(); - if (($fn eq '') || ($fn=~/^default\_/)) { + &setfilename($safeeval,$fn); + +# ------------------------------------------------------ see if sheet is cached + my $fstring=''; + if ($fstring=$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}) { + &setformulas($safeeval,split(/\_\_\_\;\_\_\_/,$fstring)); + } else { + +# ---------------------------------------------------- Not cached, need to read + + my %f=(); + + if ($fn=~/^default\_/) { my $sheetxml=''; { my $fh; - if ($fh=Apache::File->new($r->dir_config('lonIncludes'). + if ($fh=Apache::File->new($includedir. '/default.'.&gettype($safeeval))) { $sheetxml=join('',<$fh>); } } - my $parser=HTML::TokeParser->new(\$sheetxml); - my $token; - while ($token=$parser->get_token) { + my $parser=HTML::TokeParser->new(\$sheetxml); + my $token; + while ($token=$parser->get_token) { if ($token->[0] eq 'S') { if ($token->[1] eq 'field') { $f{$token->[2]->{'col'}.$token->[2]->{'row'}}= @@ -629,56 +774,88 @@ sub readsheet { $parser->get_text('/template'); } } - } - &setfilename($safeeval,'default_'.&gettype($safeeval)); - } else { - &setfilename($safeeval,$fn); - unless ($spreadsheets{$fn}) { - $spreadsheets{$fn}=''; - my $reply=&Apache::lonnet::reply('dump:'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':'.$fn, - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); + } + } else { + my $sheet=''; + my $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'.$fn, + $chome); unless ($reply=~/^error\:/) { - $spreadsheets{$fn}=$reply; - } + $sheet=$reply; + } + map { + my ($name,$value)=split(/\=/,$_); + $f{&Apache::lonnet::unescape($name)}= + &Apache::lonnet::unescape($value); + } split(/\&/,$sheet); } - map { - my ($name,$value)=split(/\=/,$_); - $f{&Apache::lonnet::unescape($name)}= - &Apache::lonnet::unescape($value); - } split(/\&/,$spreadsheets{$fn}); +# --------------------------------------------------------------- Cache and set + $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); + &setformulas($safeeval,%f); } +} - &setformulas($safeeval,%f); +# -------------------------------------------------------- Make new spreadsheet + +sub makenewsheet { + my ($uname,$udom,$stype,$usymb)=@_; + my $safeeval=initsheet($stype); + $safeeval->reval( + '$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; } # ------------------------------------------------------------ Save spreadsheet sub writesheet { - my $safeeval=shift; - if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { + my ($safeeval,$makedef)=@_; + my $cid=&getcid($safeeval); + if (&Apache::lonnet::allowed('opa',$cid)) { my %f=&getformulas($safeeval); + my $stype=&gettype($safeeval); + my $cnum=&getcnum($safeeval); + my $cdom=&getcdom($safeeval); + my $chome=&getchome($safeeval); + my $fn=&getfilename($safeeval); + +# ------------------------------------------------------------- Cache new sheet + $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); +# ----------------------------------------------------------------- Write sheet my $sheetdata=''; map { $sheetdata.=&Apache::lonnet::escape($_).'='. &Apache::lonnet::escape($f{$_}).'&'; } keys %f; $sheetdata=~s/\&$//; - my $reply=&Apache::lonnet::reply('put:'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':'. - &getfilename($safeeval).':'. - $sheetdata, - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); + my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'. + $sheetdata,$chome); if ($reply eq 'ok') { - return &Apache::lonnet::reply('put:'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':'. - &gettype($safeeval).'_spreadsheets:'. - &Apache::lonnet::escape(&getfilename($safeeval)).'='. - $ENV{'user.name'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); + $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'. + $stype.'_spreadsheets:'. + &Apache::lonnet::escape($fn).'='.$ENV{'user.name'}, + $chome); + if ($reply eq 'ok') { + if ($makedef) { + return &Apache::lonnet::reply('put:'.$cdom.':'.$cnum. + ':environment:spreadsheet_default_'.$stype.'='. + &Apache::lonnet::escape($fn), + $chome); + } else { + return $reply; + } + } else { + return $reply; + } } else { return $reply; } @@ -687,10 +864,14 @@ sub writesheet { } # ----------------------------------------------- Make a temp copy of the sheet +# "Modified workcopy" - interactive only +# sub tmpwrite { - my ($safeeval,$tmpdir,$symb)=@_; - my $fn=$uname.'_'.$udom.'_spreadsheet_'.$symb.'_'.&getfilename($safeeval); + my $safeeval=shift; + my $fn=$ENV{'user.name'}.'_'. + $ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'. + &getfilename($safeeval); $fn=~s/\W/\_/g; $fn=$tmpdir.$fn.'.tmp'; my $fh; @@ -702,8 +883,10 @@ sub tmpwrite { # ---------------------------------------------------------- Read the temp copy sub tmpread { - my ($safeeval,$tmpdir,$symb,$nfield,$nform)=@_; - my $fn=$uname.'_'.$udom.'_spreadsheet_'.$symb.'_'.&getfilename($safeeval); + my ($safeeval,$nfield,$nform)=@_; + my $fn=$ENV{'user.name'}.'_'. + $ENV{'user.domain'}.'_spreadsheet_'.&getusymb($safeeval).'_'. + &getfilename($safeeval); $fn=~s/\W/\_/g; $fn=$tmpdir.$fn.'.tmp'; my $fh; @@ -721,38 +904,22 @@ sub tmpread { &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 +# +# 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,$symb)=@_; + my ($what,$safeeval)=@_; + my $cid=&getcid($safeeval); + my $csec=&getcsec($safeeval); + my $uname=&getuname($safeeval); + my $udom=&getudom($safeeval); + my $symb=&getusymb($safeeval); unless ($symb) { return ''; } my $result=''; @@ -765,23 +932,24 @@ sub parmval { my $symbparm=$symb.'.'.$what; my $mapparm=$mapname.'___(all).'.$what; + my $usercourseprefix=$uname.'_'.$udom.'_'.$cid; my $seclevel= - $ENV{'request.course.id'}.'.['. + $usercourseprefix.'.['. $csec.'].'.$what; my $seclevelr= - $ENV{'request.course.id'}.'.['. + $usercourseprefix.'.['. $csec.'].'.$symbparm; my $seclevelm= - $ENV{'request.course.id'}.'.['. + $usercourseprefix.'.['. $csec.'].'.$mapparm; my $courselevel= - $ENV{'request.course.id'}.'.'.$what; + $usercourseprefix.'.'.$what; my $courselevelr= - $ENV{'request.course.id'}.'.'.$symbparm; + $usercourseprefix.'.'.$symbparm; my $courselevelm= - $ENV{'request.course.id'}.'.'.$mapparm; + $usercourseprefix.'.'.$mapparm; # ---------------------------------------------------------- fourth, check user @@ -826,13 +994,17 @@ sub parmval { # ---------------------------------------------- Update rows for course listing -sub updatestudentrows { +sub updateclasssheet { my $safeeval=shift; - my $cid=$ENV{'request.course.id'}; + my $cnum=&getcnum($safeeval); + my $cdom=&getcdom($safeeval); + my $cid=&getcid($safeeval); + my $chome=&getchome($safeeval); + +# ---------------------------------------------- Read class list and row labels + my $classlst=&Apache::lonnet::reply - ('dump:'.$ENV{'course.'.$cid.'.domain'}.':'. - $ENV{'course.'.$cid.'.num'}.':classlist', - $ENV{'course.'.$cid.'.home'}); + ('dump:'.$cdom.':'.$cnum.':classlist',$chome); my %currentlist=(); my $now=time; unless ($classlst=~/^error\:/) { @@ -844,23 +1016,24 @@ sub updatestudentrows { if ($active) { my $rowlabel=''; $name=&Apache::lonnet::unescape($name); - my ($cname,$cdom)=split(/\:/,$name); - my $csec= - &Apache::lonnet::usection($cdom,$cname,$ENV{'request.course.id'}); - if ($csec==-1) { + my ($sname,$sdom)=split(/\:/,$name); + my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid); + if ($ssec==-1) { $rowlabel='Data not available: '.$name. ''; } else { - my %reply=&Apache::lonnet::idrget($cdom,$cname); - my $reply=&Apache::lonnet::reply('get:'.$cdom.':'.$cname. + my %reply=&Apache::lonnet::idrget($sdom,$sname); + my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname. ':environment:firstname&middlename&lastname&generation', - &Apache::lonnet::homeserver($cname,$cdom)); - $rowlabel=$csec.' '.$reply{$cname}.'
'; + &Apache::lonnet::homeserver($sname,$sdom)); + $rowlabel=''. + $ssec.' '.$reply{$sname}.'
'; map { $rowlabel.=&Apache::lonnet::unescape($_).' '; } split(/\&/,$reply); + $rowlabel.='
'; } - $currentlist{&Apache::lonnet::unescape($name)}=$rowlabel; } } split(/\&/,$classlst); @@ -904,11 +1077,15 @@ sub updatestudentrows { return 'Could not access course data'; } } -# ----------------------------------------------------------------- Update rows -sub updaterows { +# ----------------------------------- Update rows for student and assess sheets + +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)) { @@ -917,8 +1094,6 @@ sub updaterows { my %allkeys=(); my %allassess=(); - my $stype=&gettype($safeeval); - map { if ($_=~/^src\_(\d+)\.(\d+)$/) { my $mapid=$1; @@ -930,8 +1105,8 @@ sub updaterows { &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\_(.*)/)) { @@ -939,9 +1114,10 @@ sub updaterows { my $display= &Apache::lonnet::metadata($srcf,$key.'.display'); unless ($display) { - $display= + $display.= &Apache::lonnet::metadata($srcf,$key.'.name'); } + $display.='
'.$key; $allkeys{$key}=$display; } } split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); @@ -955,17 +1131,26 @@ sub updaterows { # %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=(); @@ -991,39 +1176,56 @@ sub updaterows { $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); + $cachedassess=&getuname($safeeval).':'.&getudom($safeeval); + %cachedstores=(); + { + my $reply=&Apache::lonnet::reply('dump:'.&getudom($safeeval).':'. + &getuname($safeeval).':'. + &getcid($safeeval), + &getuhome($safeeval)); + unless ($reply=~/^error\:/) { + map { + my ($name,$value)=split(/\=/,$_); + $cachedstores{&Apache::lonnet::unescape($name)}= + &Apache::lonnet::unescape($value); + } split(/\&/,$reply); + } + } + 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{$_}))); + unless (($f{$_}=~/^\!/) || ($row==0)) { + @assessdata=&exportsheet(&getuname($safeeval), + &getudom($safeeval), + 'assesscalc',$f{$_}); my $index=0; map { if ($assessdata[$index]) { - $c{$_.$row}=$assessdata[$index]; - unless ($_ eq 'A') { - $f{$_.$row}='import'; + my $col=$_; + if ($assessdata[$index]=~/\D/) { + $c{$col.$row}="'".$assessdata[$index]."'"; + } else { + $c{$col.$row}=$assessdata[$index]; + } + unless ($col eq 'A') { + $f{$col.$row}='import'; } } $index++; @@ -1032,32 +1234,62 @@ sub rowazstudent { } } } keys %f; + $cachedassess=''; + undef %cachedstores; &setformulas($safeeval,%f); &setconstants($safeeval,%c); } # --------------------------------------------------- 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(< + popwin=open('','popwin','width=400,height=100'); + popwin.document.writeln(''+ + '

Spreadsheet Calculation Progress

'+ + '
'+ + '
'+ + ''); + popwin.document.close(); + +ENDPOP + $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))); + unless (($f{$_}=~/^\!/) || ($row==0)) { + my @studentdata=&exportsheet(split(/\:/,$f{$_}), + 'studentcalc'); + undef %userrdatas; + $now++; + $r->print(''); + $r->rflush(); + my $index=0; map { - if ($assessdata[$index]) { - $c{$_.$row}=$assessdata[$index]; - unless ($_ eq 'A') { - $f{$_.$row}='import'; + if ($studentdata[$index]) { + my $col=$_; + if ($studentdata[$index]=~/\D/) { + $c{$col.$row}="'".$studentdata[$index]."'"; + } else { + $c{$col.$row}=$studentdata[$index]; + } + unless ($col eq 'A') { + $f{$col.$row}='import'; } } $index++; @@ -1068,22 +1300,53 @@ sub rowazclass { } keys %f; &setformulas($safeeval,%f); &setconstants($safeeval,%c); + $r->print(''); + $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 %returnhash=(); + + if ($cachedassess eq $uname.':'.$udom) { +# +# get data out of the dumped stores +# + + my $version=$cachedstores{'version:'.$symb}; + my $scope; + for ($scope=1;$scope<=$version;$scope++) { + map { + $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_}; + } split(/\:/,$cachedstores{$scope.':keys:'.$symb}); + } + + } else { +# +# restore individual +# + 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)}= @@ -1095,33 +1358,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\:/) { @@ -1131,30 +1395,39 @@ 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/) { unless ($f{$_}=~/^\!/) { if ($f{$_}=~/^parameter/) { - $c{$_}=&parmval($f{$_},$symb); + my $val=&parmval($f{$_},$safeeval); + $c{$_}=$val; + $c{$f{$_}}=$val; } else { my $key=$f{$_}; + my $ckey=$key; $key=~s/^stores\_/resource\./; $key=~s/\_/\./; $c{$_}=$returnhash{$key}; + $c{$ckey}=$returnhash{$key}; } } } } keys %f; - - &setconstants($safeeval,%c); + untie(%parmhash); + } + &setconstants($safeeval,%c); } # --------------------------------------------------------- Various form fields @@ -1181,25 +1454,223 @@ sub selectbox { return $selout.''; } +# =============================================== Update information in a sheet +# +# Add new users or assessments, etc. +# + +sub updatesheet { + my $safeeval=shift; + my $stype=&gettype($safeeval); + if ($stype eq 'classcalc') { + return &updateclasssheet($safeeval); + } else { + return &updatestudentassesssheet($safeeval); + } +} + +# =================================================== Load the rows for a sheet +# +# Import the data for rows +# + +sub loadrows { + my ($safeeval,$r)=@_; + my $stype=&gettype($safeeval); + if ($stype eq 'classcalc') { + &loadcourse($safeeval,$r); + } elsif ($stype eq 'studentcalc') { + &loadstudent($safeeval); + } else { + &loadassessment($safeeval); + } +} + +# ============================================================== Export handler +# +# Non-interactive call from with program +# + +sub exportsheet { + my ($uname,$udom,$stype,$usymb,$fn)=@_; + my @exportarr=(); +# +# Check if cached +# + + my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; + my $found=''; + + if ($oldsheets{$key}) { + map { + my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); + if ($name eq $fn) { + $found=$value; + } + } split(/\_\_\_\&\_\_\_/,$oldsheets{$key}); + } + + unless ($found) { + &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom)); + if ($oldsheets{$key}) { + map { + my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); + if ($name eq $fn) { + $found=$value; + } + } split(/\_\_\_\&\_\_\_/,$oldsheets{$key}); + } + } + + if ($found) { +# +# Return what was cached +# + @exportarr=split(/\_\_\_\;\_\_\_/,$found); + + } else { +# +# Not cached +# + + my $thissheet=&makenewsheet($uname,$udom,$stype,$usymb); + &readsheet($thissheet,$fn); + &updatesheet($thissheet); + &loadrows($thissheet); + &calcsheet($thissheet); + @exportarr=&exportdata($thissheet); +# +# Store now +# + my $cid=$ENV{'request.course.id'}; + my $current=(); + if ($stype eq 'studentcalc') { + $current=&Apache::lonnet::reply('get:'. + $ENV{'course.'.$cid.'.domain'}.':'. + $ENV{'course.'.$cid.'.num'}. + ':nohist_calculatedsheets:'. + &Apache::lonnet::escape($key), + $ENV{'course.'.$cid.'.home'}); + } else { + $current=&Apache::lonnet::reply('get:'. + &getudom($thissheet).':'. + &getuname($thissheet). + ':nohist_calculatedsheets_'. + $ENV{'request.course.id'}.':'. + &Apache::lonnet::escape($key), + &getuhome($thissheet)); + + } + my %currentlystored=(); + unless ($current=~/^error\:/) { + map { + my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); + $currentlystored{$name}=$value; + } split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current)); + } + $currentlystored{$fn}=join('___;___',@exportarr); + + my $newstore=''; + map { + if ($newstore) { $newstore.='___&___'; } + $newstore.=$_.'___=___'.$currentlystored{$_}; + } keys %currentlystored; + if ($stype eq 'studentcalc') { + &Apache::lonnet::reply('put:'. + $ENV{'course.'.$cid.'.domain'}.':'. + $ENV{'course.'.$cid.'.num'}. + ':nohist_calculatedsheets:'. + &Apache::lonnet::escape($key).'='. + &Apache::lonnet::escape($newstore), + $ENV{'course.'.$cid.'.home'}); + } else { + &Apache::lonnet::reply('put:'. + &getudom($thissheet).':'. + &getuname($thissheet). + ':nohist_calculatedsheets_'. + $ENV{'request.course.id'}.':'. + &Apache::lonnet::escape($key).'='. + &Apache::lonnet::escape($newstore), + &getuhome($thissheet)); + } + } + return @exportarr; +} + +# ===================================================== Calculated sheets cache +# +# Load previously cached student spreadsheets for this course +# + +sub cachedcsheets { + my $cid=$ENV{'request.course.id'}; + my $reply=&Apache::lonnet::reply('dump:'. + $ENV{'course.'.$cid.'.domain'}.':'. + $ENV{'course.'.$cid.'.num'}. + ':nohist_calculatedsheets', + $ENV{'course.'.$cid.'.home'}); + unless ($reply=~/^error\:/) { + map { + my ($name,$value)=split(/\=/,$_); + $oldsheets{&Apache::lonnet::unescape($name)} + =&Apache::lonnet::unescape($value); + } split(/\&/,$reply); + } +} + +# ===================================================== Calculated sheets cache +# +# Load previously cached assessment spreadsheets for this student +# + +sub cachedssheets { + my ($sname,$sdom,$shome)=@_; + unless (($loadedcaches{$sname.'_'.$sdom}) || ($shome eq 'no_host')) { + my $cid=$ENV{'request.course.id'}; + my $reply=&Apache::lonnet::reply('dump:'.$sdom.':'.$sname. + ':nohist_calculatedsheets_'. + $ENV{'request.course.id'}, + $shome); + unless ($reply=~/^error\:/) { + map { + my ($name,$value)=split(/\=/,$_); + $oldsheets{&Apache::lonnet::unescape($name)} + =&Apache::lonnet::unescape($value); + } split(/\&/,$reply); + } + $loadedcaches{$sname.'_'.$sdom}=1; + } +} + +# ===================================================== Calculated sheets cache +# +# Load previously cached assessment spreadsheets for this student +# + # ================================================================ Main handler +# +# Interactive call to screen +# +# + sub handler { my $r=shift; - $uname=''; - $udom=''; - $csec=''; - - if ($r->header_only) { + if ($r->header_only) { $r->content_type('text/html'); $r->send_http_header; return OK; - } + } + +# ---------------------------------------------------- Global directory configs + +$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 @@ -1216,16 +1687,17 @@ sub handler { } (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 @@ -1236,7 +1708,6 @@ sub handler { # --------------------------------------------------------------- Screen output - unless ($reroute) { $r->print('LON-CAPA Spreadsheet'); $r->print(< @@ -1261,99 +1732,78 @@ ENDSCRIPT &hiddenfield('usymb',$ENV{'form.usymb'}). &hiddenfield('unewfield',''). &hiddenfield('unewformula','')); - } + +# ---------------------- Make sure that this gets out, even if user hits "stop" + $r->rflush(); + # ---------------------------------------- Read new sheet or modified worksheet - my $sheetone=initsheet(); $r->uri=~/\/(\w+)$/; - &settype($sheetone,$1); + + my $asheet=&makenewsheet($aname,$adom,$1,$ENV{'form.usymb'}); + +# ------------------------ If a new formula had been entered, go from work copy + if ($ENV{'form.unewfield'}) { $r->print('

Modified Workcopy

'); $ENV{'form.unewformula'}=~s/\'/\"/g; $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,$r->dir_config('lonDaemons').'/tmp/', - $ENV{'form.usymb'}); + + } elsif ($ENV{'form.saveas'}) { + &setfilename($asheet,$ENV{'form.ufn'}); + &tmpread($asheet); } else { - unless ($ENV{'form.ufn'}) { - my $reply=&Apache::lonnet::reply('get:'. - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}. - ':environment:spreadsheet_default_'. - &gettype($sheetone), - $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); - unless (($reply=~/^error\:/) || ($reply eq '')) { - $ENV{'form.ufn'}=$reply; - unless ($reroute) { - $r->print('

Using customized default spreadsheet

'); - } - } + &readsheet($asheet,$ENV{'form.ufn'}); + } + +# -------------------------------------------------- Print out user information + + unless (&gettype($asheet) eq 'classcalc') { + $r->print('

User: '.&getuname($asheet). + '
Domain: '.&getudom($asheet)); + if (&getcsec($asheet) eq '-1') { + $r->print('

'. + 'Not a student in this course

'); + } else { + $r->print('
Section/Group: '.&getcsec($asheet)); } - &readsheet($sheetone,$ENV{'form.ufn'},$r); - $ENV{'form.ufn'}=&getfilename($sheetone); } - 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 +# ---------------------------------------------------------------- Course title + + $r->print('

'. + $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.'

'); + - 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)

'); - } - } # ---------------------------------------------------- See if something to save + if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { my $fname=''; if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) { $fname=~s/\W/\_/g; if ($fname eq 'default') { $fname='course_default'; } - $fname.='_'.&gettype($sheetone); - &setfilename($sheetone,$fname); + $fname.='_'.&gettype($asheet); + &setfilename($asheet,$fname); $ENV{'form.ufn'}=$fname; - my $reply=&writesheet($sheetone); - unless ($reroute) { - $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/\_[^\_]+$//; @@ -1362,38 +1812,46 @@ ENDSCRIPT ' (make default: )

'); } - $r->print(&hiddenfield('ufn',$ENV{'form.ufn'})); - unless (&gettype($sheetone) eq 'classcalc') { - $r->print('
User: '.$uname.'
Domain: '.$udom); - } - $r->print('

'. - $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.'

'); - if ($csec) { - $r->print('

Group/Section: '.$csec.'

'); - } - } -# -------------------------------------------------------- Import and calculate - if (&gettype($sheetone) eq 'assesscalc') { - &rowaassess($sheetone,$ENV{'form.usymb'}); - } elsif (&gettype($sheetone) eq 'studentcalc') { - &rowazstudent($sheetone); - } else { - &rowazclass($sheetone); - } - my $calcoutput=&calcsheet($sheetone); - unless ($reroute) { - $r->print('

'.$calcoutput.'

'); + $r->print(&hiddenfield('ufn',&getfilename($asheet))); + +# --------------------------------------------------------------- Cached sheets + + undef %oldsheets; + undef %loadedcaches; + + if (&gettype($asheet) eq 'classcalc') { + $r->print("Loading previously calculated student sheets ...
\n"); + $r->rflush(); + &cachedcsheets(); + } elsif (&gettype($asheet) eq 'studentcalc') { + $r->print("Loading previously calculated assessment sheets ...
\n"); + $r->rflush(); + &cachedssheets(&getuname($asheet),&getudom($asheet), + &getuhome($asheet)); } -# ------------------------------------------------------- Print or export sheet - unless ($reroute) { - &outsheet($r,$sheetone); +# ----------------------------------------------------- Update sheet, load rows + $r->print("Loaded sheet(s), updating rows ...
\n"); + $r->rflush(); + + &updatesheet($asheet); + + $r->print("Updated rows, loading row data ...
\n"); + $r->rflush(); + + &loadrows($asheet,$r); + + $r->print("Loaded row data, calculating sheet ...
\n"); + $r->rflush(); + + my $calcoutput=&calcsheet($asheet); + $r->print('

'.$calcoutput.'

'); + + &outsheet($r,$asheet); $r->print(''); - } else { - $r->print(&exportrow($sheetone)); - } + # ------------------------------------------------------------------------ Done } else { # ----------------------------- Not in a course, or not allowed to modify parms @@ -1402,23 +1860,8 @@ ENDSCRIPT return HTTP_NOT_ACCEPTABLE; } return OK; + } 1; __END__ - - - - - - - - - - - - - - - - 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.