--- loncom/interface/Attic/lonspreadsheet.pm 2001/03/10 16:46:52 1.41 +++ loncom/interface/Attic/lonspreadsheet.pm 2001/09/11 00:05:13 1.60 @@ -4,7 +4,9 @@ # 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,03/01,19/01,20/01,22/01, -# 03/05,03/08,03/10 Gerd Kortemeyer +# 03/05,03/08,03/10,03/12,03/13,03/15,03/17, +# 03/19,03/20,03/21,03/27,04/05,04/09, +# 07/09,07/14,07/21,09/01,09/10 Gerd Kortemeyer package Apache::lonspreadsheet; @@ -18,6 +20,14 @@ use GDBM_File; use HTML::TokeParser; # +# Caches for previously calculated spreadsheets +# + +my %oldsheets; +my %loadedcaches; +my %expiredates; + +# # Cache for stores of an individual user # @@ -68,12 +78,14 @@ sub initsheet { # v: output values # c: preloaded constants (A-column) # rl: row label +# os: other spreadsheets (for student spreadsheet only) undef %v; undef %t; undef %f; undef %c; undef %rl; +undef @os; $maxrow=0; $sheettype=''; @@ -296,6 +308,42 @@ sub SUMMIN { return $sum; } +sub expandnamed { + my $expression=shift; + if ($expression=~/^\&/) { + my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/); + my @vars=split(/\W+/,$formula); + my %values=(); + undef %values; + map { + my $varname=$_; + if ($varname=~/\D/) { + $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge; + $varname=~s/$var/\(\\w\+\)/g; + map { + if ($_=~/$varname/) { + $values{$1}=1; + } + } keys %c; + } + } @vars; + if ($func eq 'EXPANDSUM') { + my $result=''; + map { + my $thissum=$formula; + $thissum=~s/$var/$_/g; + $result.=$thissum.'+'; + } keys %values; + $result=~s/\+$//; + return $result; + } else { + return 0; + } + } else { + return '$c{\''.$expression.'\'}'; + } +} + sub sett { %t=(); my $pattern=''; @@ -317,7 +365,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; + $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; } } } keys %f; @@ -326,7 +374,8 @@ sub sett { } keys %f; map { if (($f{$_}) && ($_!~/template\_/)) { - if ($_=~/^$pattern/) { + my $matches=($_=~/^$pattern(\d+)/); + if (($matches) && ($1)) { unless ($f{$_}=~/^\!/) { $t{$_}=$c{$_}; } @@ -334,14 +383,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; + $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; } } } 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; + $t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; } sub calc { @@ -387,7 +436,18 @@ sub outrowassess { my $n=shift; my @cols=(); if ($n) { - $cols[0]=$rl{$f{'A'.$n}}; + my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n}); + $cols[0]=$rl{$usy}.'
'. + ''; } else { $cols[0]='Export'; } @@ -450,6 +510,13 @@ sub setconstants { %{$safeeval->varglob('c')}=%c; } +# --------------------------------------------- Set names of other spreadsheets + +sub setothersheets { + my ($safeeval,@os)=@_; + @{$safeeval->varglob('os')}=@os; +} + # ------------------------------------------------ Add or change formula values sub setrowlabels { @@ -590,6 +657,7 @@ sub exportdata { return $safeeval->reval('&exportrowa()'); } + # ========================================================== End of Spreadsheet # ============================================================================= @@ -628,11 +696,15 @@ sub rown { my $showf=0; my $proc; my $maxred; - if (&gettype($safeeval) eq 'assesscalc') { + if (&gettype($safeeval) eq 'studentcalc') { $proc='&outrowassess'; - $maxred=1; + $maxred=26; } else { $proc='&outrow'; + } + if (&gettype($safeeval) eq 'assesscalc') { + $maxred=1; + } else { $maxred=26; } if ($n eq '-') { $proc='&templaterow'; $n=-1; } @@ -706,6 +778,29 @@ sub outsheet { } # +# ----------------------------------------------- Read list of available sheets +# + +sub othersheets { + my ($safeeval,$stype)=@_; + + my $cnum=&getcnum($safeeval); + my $cdom=&getcdom($safeeval); + my $chome=&getchome($safeeval); + + my @alternatives=(); + my $result=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'. + $stype.'_spreadsheets',$chome); + if ($result!~/^error\:/) { + map { + $alternatives[$#alternatives+1]= + &Apache::lonnet::unescape((split(/\=/,$_))[0]); + } split(/\&/,$result); + } + return @alternatives; +} + +# # -------------------------------------- Read spreadsheet formulas for a course # @@ -825,8 +920,10 @@ sub writesheet { # ----------------------------------------------------------------- Write sheet my $sheetdata=''; map { + unless ($f{$_} eq 'import') { $sheetdata.=&Apache::lonnet::escape($_).'='. &Apache::lonnet::escape($f{$_}).'&'; + } } keys %f; $sheetdata=~s/\&$//; my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'. @@ -834,7 +931,8 @@ sub writesheet { if ($reply eq 'ok') { $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'. $stype.'_spreadsheets:'. - &Apache::lonnet::escape($fn).'='.$ENV{'user.name'}, + &Apache::lonnet::escape($fn).'='.$ENV{'user.name'}.'@'. + $ENV{'user.domain'}, $chome); if ($reply eq 'ok') { if ($makedef) { @@ -892,7 +990,14 @@ sub tmpread { $fo{$name}=$value; } } - if ($nfield) { $fo{$nfield}=$nform; } + if ($nform eq 'changesheet') { + $fo{'A'.$nfield}=(split(/\_\_\&\&\&\_\_/,$fo{'A'.$nfield}))[0]; + unless ($ENV{'form.sel_'.$nfield} eq 'Default') { + $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield}; + } + } else { + if ($nfield) { $fo{$nfield}=$nform; } + } &setformulas($safeeval,%fo); } @@ -1018,10 +1123,13 @@ sub updateclasssheet { my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname. ':environment:firstname&middlename&lastname&generation', &Apache::lonnet::homeserver($sname,$sdom)); - $rowlabel=$ssec.' '.$reply{$sname}.'
'; + $rowlabel=''. + $ssec.' '.$reply{$sname}.'
'; map { $rowlabel.=&Apache::lonnet::unescape($_).' '; } split(/\&/,$reply); + $rowlabel.='
'; } $currentlist{&Apache::lonnet::unescape($name)}=$rowlabel; } @@ -1080,9 +1188,17 @@ sub updatestudentassesssheet { &GDBM_READER,0640)) { # --------------------------------------------------------- Get all assessments - my %allkeys=(); + my %allkeys=('timestamp' => + 'Timestamp of Last Transaction
timestamp'); my %allassess=(); + my $adduserstr=''; + if ((&getuname($safeeval) ne $ENV{'user.name'}) || + (&getudom($safeeval) ne $ENV{'user.domain'})) { + $adduserstr='&uname='.&getuname($safeeval). + '&udom='.&getudom($safeeval); + } + map { if ($_=~/^src\_(\d+)\.(\d+)$/) { my $mapid=$1; @@ -1095,7 +1211,8 @@ sub updatestudentassesssheet { '___'.$resid.'___'. &Apache::lonnet::declutter($srcf); $allassess{$symb}= - ''.$bighash{'title_'.$id}.''; + ''. + $bighash{'title_'.$id}.''; if ($stype eq 'assesscalc') { map { if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) { @@ -1148,10 +1265,14 @@ sub updatestudentassesssheet { map { if ($_=~/^A(\d+)/) { $maxrow=($1>$maxrow)?$1:$maxrow; - $existing{$f{$_}}=1; - unless ((defined($current{$f{$_}})) || (!$1)) { + my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_}); + $existing{$usy}=1; + unless ((defined($current{$usy})) || (!$1)) { $f{$_}='!!! Obsolete'; $changed=1; + } elsif ($ufn) { + $current{$usy} + =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/; } } } keys %f; @@ -1200,10 +1321,11 @@ sub loadstudent { map { if ($_=~/^A(\d+)/) { my $row=$1; - unless ($f{$_}=~/^\!/) { + unless (($f{$_}=~/^\!/) || ($row==0)) { + my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_}); @assessdata=&exportsheet(&getuname($safeeval), &getudom($safeeval), - 'assesscalc',$f{$_}); + 'assesscalc',$usy,$ufn); my $index=0; map { if ($assessdata[$index]) { @@ -1247,18 +1369,18 @@ sub loadcourse { ENDPOP $r->rflush(); map { if ($_=~/^A(\d+)/) { my $row=$1; - unless ($f{$_}=~/^\!/) { + unless (($f{$_}=~/^\!/) || ($row==0)) { my @studentdata=&exportsheet(split(/\:/,$f{$_}), 'studentcalc'); undef %userrdatas; @@ -1289,7 +1411,7 @@ ENDPOP } keys %f; &setformulas($safeeval,%f); &setconstants($safeeval,%c); - $r->print(''); + $r->print(''); $r->rflush(); } @@ -1391,6 +1513,18 @@ sub loadassessment { # ----------------- now courseopt, useropt initialized for this user and course # (used by parmval) +# +# Load keys for this assessment only +# + my %thisassess=(); + my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb); + + map { + $thisassess{$_}=1; + } split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); +# +# Load parameters +# my %c=(); if (tie(%parmhash,'GDBM_File', @@ -1400,9 +1534,11 @@ sub loadassessment { if ($_=~/^A/) { unless ($f{$_}=~/^\!/) { if ($f{$_}=~/^parameter/) { + if ($thisassess{$f{$_}}) { my $val=&parmval($f{$_},$safeeval); $c{$_}=$val; $c{$f{$_}}=$val; + } } else { my $key=$f{$_}; my $ckey=$key; @@ -1475,22 +1611,230 @@ sub loadrows { } } +# ======================================================= Forced recalculation? + +sub checkthis { + my ($keyname,$time)=@_; + return ($time<$expiredates{$keyname}); +} +sub forcedrecalc { + my ($uname,$udom,$stype,$usymb)=@_; + my $key=$uname.':'.$udom.':'.$stype.':'.$usymb; + my $time=$oldsheets{$key.'.time'}; + if ($ENV{'form.forcerecalc'}) { return 1; } + unless ($time) { return 1; } + if ($stype eq 'assesscalc') { + my $map=(split(/\_\_\_/,$usymb))[0]; + if (&checkthis('::assesscalc:',$time) || + &checkthis('::assesscalc:'.$map,$time) || + &checkthis('::assesscalc:'.$usymb,$time) || + &checkthis($uname.':'.$udom.':assesscalc:',$time) || + &checkthis($uname.':'.$udom.':assesscalc:'.$map,$time) || + &checkthis($uname.':'.$udom.':assesscalc:'.$usymb,$time)) { + return 1; + } + } else { + if (&checkthis('::studentcalc:',$time) || + &checkthis($uname.':'.$udom.':studentcalc:',$time)) { + return 1; + } + } + return 0; +} + # ============================================================== 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}); + } + } +# +# Check if still valid +# + if ($found) { + if (&forcedrecalc($uname,$udom,$stype,$usymb)) { + $found=''; + } + } - my ($uname,$udom,$stype,$usymb,$fn)=@_; + 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); - return &exportdata($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; + my $now=time; + 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).'&'. + &Apache::lonnet::escape($key).'.time='.$now, + $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).'&'. + &Apache::lonnet::escape($key).'.time='.$now, + &getuhome($thissheet)); + } + } + return @exportarr; +} +# ============================================================ Expiration Dates +# +# Load previously cached student spreadsheets for this course +# + +sub expirationdates { + undef %expiredates; + my $cid=$ENV{'request.course.id'}; + my $reply=&Apache::lonnet::reply('dump:'. + $ENV{'course.'.$cid.'.domain'}.':'. + $ENV{'course.'.$cid.'.num'}. + ':nohist_expirationdates', + $ENV{'course.'.$cid.'.home'}); + unless ($reply=~/^error\:/) { + map { + my ($name,$value)=split(/\=/,$_); + $expiredates{&Apache::lonnet::unescape($name)} + =&Apache::lonnet::unescape($value); + } split(/\&/,$reply); + } +} + +# ===================================================== 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 @@ -1530,6 +1874,10 @@ $tmpdir=$r->dir_config('lonDaemons').'/t } } (split(/&/,$ENV{'QUERY_STRING'})); +# -------------------------------------- Interactive loading of specific sheet? + if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) { + $ENV{'form.ufn'}=$ENV{'form.loadthissheet'}; + } # ------------------------------------------- Nothing there? Must be login user my $aname; @@ -1565,6 +1913,12 @@ $tmpdir=$r->dir_config('lonDaemons').'/t } } + function changesheet(cn) { + document.sheet.unewfield.value=cn; + document.sheet.unewformula.value='changesheet'; + document.sheet.submit(); + } + ENDSCRIPT $r->print(''. @@ -1581,6 +1935,18 @@ ENDSCRIPT $r->rflush(); +# ---------------------------------------------------------------- Full recalc? + + + if ($ENV{'form.forcerecalc'}) { + $r->print('

Completely Recalculating Sheet ...

'); + undef %spreadsheets; + undef %courserdatas; + undef %userrdatas; + undef %defaultsheets; + undef %updatedata; + } + # ---------------------------------------- Read new sheet or modified worksheet $r->uri=~/\/(\w+)$/; @@ -1623,27 +1989,37 @@ ENDSCRIPT $r->print('

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

'); +# ---------------------------------------------------- See if user can see this -# ---------------------------------------------------- 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($asheet); - &setfilename($asheet,$fname); - $ENV{'form.ufn'}=$fname; - $r->print('

Saving spreadsheet: '. - &writesheet($asheet,$ENV{'form.makedefufn'}).'

'); - } + if ((&gettype($asheet) eq 'classcalc') || + (&getuname($asheet) ne $ENV{'user.name'}) || + (&getudom($asheet) ne $ENV{'user.domain'})) { + unless (&Apache::lonnet::allowed('vgr',&getcid($asheet))) { + $r->print( + '

Access Permission Denied

'); + return OK; + } } -# ------------------------------------------------ Write the modified worksheet - - $r->print('Current sheet: '.&getfilename($asheet).'

'); +# ---------------------------------------------------------- Additional options - &tmpwrite($asheet); + $r->print( + '

' + ); + if (&gettype($asheet) eq 'assesscalc') { + $r->print ('

Level up: Student Sheet

'); + } + + if ((&gettype($asheet) eq 'studentcalc') && + (&Apache::lonnet::allowed('vgr',&getcid($asheet)))) { + $r->print ( + '

'. + 'Level up: Course Sheet

'); + } + # ----------------------------------------------------------------- Save dialog @@ -1659,10 +2035,45 @@ ENDSCRIPT $r->print(&hiddenfield('ufn',&getfilename($asheet))); +# ----------------------------------------------------------------- Load dialog + if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) { + $r->print('

'. + '

'); + if (&gettype($asheet) eq 'studentcalc') { + &setothersheets($asheet,&othersheets($asheet,'assesscalc')); + } + } + +# --------------------------------------------------------------- Cached sheets + + &expirationdates(); + + 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)); + } # ----------------------------------------------------- Update sheet, load rows - $r->print("Loaded sheet, updating rows ...
\n"); + $r->print("Loaded sheet(s), updating rows ...
\n"); $r->rflush(); &updatesheet($asheet); @@ -1678,6 +2089,29 @@ ENDSCRIPT my $calcoutput=&calcsheet($asheet); $r->print('

'.$calcoutput.'

'); +# ---------------------------------------------------- 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($asheet); + &setfilename($asheet,$fname); + $ENV{'form.ufn'}=$fname; + $r->print('

Saving spreadsheet: '. + &writesheet($asheet,$ENV{'form.makedefufn'}).'

'); + } + } + +# ------------------------------------------------ Write the modified worksheet + + $r->print('Current sheet: '.&getfilename($asheet).'

'); + + &tmpwrite($asheet); + +# ------------------------------------------------------------- Print out sheet + &outsheet($r,$asheet); $r->print(''); @@ -1694,19 +2128,3 @@ ENDSCRIPT 1; __END__ - - - - - - - - - - - - - - - -