--- loncom/interface/Attic/lonspreadsheet.pm 2002/07/04 17:51:32 1.93
+++ loncom/interface/Attic/lonspreadsheet.pm 2002/09/27 20:41:25 1.100.4.2
@@ -1,5 +1,5 @@
#
-# $Id: lonspreadsheet.pm,v 1.93 2002/07/04 17:51:32 www Exp $
+# $Id: lonspreadsheet.pm,v 1.100.4.2 2002/09/27 20:41:25 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -71,7 +71,7 @@ use Apache::lonnet;
use Apache::Constants qw(:common :http);
use GDBM_File;
use HTML::TokeParser;
-
+use Apache::lonhtmlcommon;
#
# Caches for previously calculated spreadsheets
#
@@ -106,6 +106,14 @@ my %courseopt;
my %useropt;
my %parmhash;
+#
+# Some hashes for stats on timing and performance
+#
+
+my %starttimes;
+my %usedtimes;
+my %numbertimes;
+
# Stuff that only the screen handler can know
my $includedir;
@@ -122,6 +130,7 @@ sub initsheet {
$safeeval->permit("sort");
$safeeval->deny(":base_io");
$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
+ $safeeval->share('$@');
my $code=<<'ENDDEFS';
# ---------------------------------------------------- Inside of the safe space
@@ -165,6 +174,10 @@ $cfn='';
$usymb='';
+# error messages
+
+$errormsg='';
+
sub mask {
my ($lower,$upper)=@_;
@@ -755,6 +768,14 @@ sub expandnamed {
}
if ($#matches == 0) {
$returnvalue = '$c{\''.$matches[0].'\'}';
+ } elsif ($#matches > 0) {
+ # more than one match. Look for a concise one
+ $returnvalue = "'non-unique parameter name : $expression'";
+ foreach (@matches) {
+ if (/^$expression$/) {
+ $returnvalue = '$c{\''.$_.'\'}';
+ }
+ }
} else {
$returnvalue = "'bad parameter name : $expression'";
}
@@ -770,6 +791,8 @@ sub sett {
} else {
$pattern='[A-Z]';
}
+
+# Deal with the template row
foreach (keys(%f)) {
if ($_=~/template\_(\w)/) {
my $col=$1;
@@ -796,8 +819,10 @@ sub sett {
}
}
}
+
+# Deal with the normal cells
foreach (keys(%f)) {
- if (($f{$_}) && ($_!~/template\_/)) {
+ if (exists($f{$_}) && ($_!~/template\_/)) {
my $matches=($_=~/^$pattern(\d+)/);
if (($matches) && ($1)) {
unless ($f{$_}=~/^\!/) {
@@ -811,6 +836,21 @@ sub sett {
}
}
}
+# For inserted lines, [B-Z] is also valid
+
+ unless ($sheettype eq 'assesscalc') {
+ foreach (keys(%f)) {
+ if ($_=~/[B-Z](\d+)/) {
+ if ($f{'A'.$1}=~/^[\~\-]/) {
+ $t{$_}=$f{$_};
+ $t{$_}=~s/\.\.+/\,/g;
+ $t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g;
+ $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge;
+ }
+ }
+ }
+ }
+
# For some reason 'A0' gets special treatment... This seems superfluous
# but I imagine it is here for a reason.
$t{'A0'}=$f{'A0'};
@@ -820,25 +860,26 @@ sub sett {
}
sub calc {
- %v=();
+ undef %v;
&sett();
my $notfinished=1;
+ my $lastcalc='';
my $depth=0;
while ($notfinished) {
$notfinished=0;
foreach (keys(%t)) {
my $old=$v{$_};
- $v{$_}=eval($t{$_});
+ $v{$_}=eval $t{$_};
if ($@) {
- %v=();
- return $@;
+ undef %v;
+ return $_.': '.$@;
}
- if ($v{$_} ne $old) { $notfinished=1; }
+ if ($v{$_} ne $old) { $notfinished=1; $lastcalc=$_; }
}
$depth++;
if ($depth>100) {
- %v=();
- return 'Maximum calculation depth exceeded';
+ undef %v;
+ return $lastcalc.': Maximum calculation depth exceeded';
}
}
return '';
@@ -956,7 +997,7 @@ sub setrowlabels {
sub calcsheet {
my $safeeval=shift;
- $safeeval->reval('&calc();');
+ return $safeeval->reval('&calc();');
}
# ------------------------------------------------------------------ Get values
@@ -973,6 +1014,13 @@ sub getformulas {
return %{$safeeval->varglob('f')};
}
+# ----------------------------------------------------- Get value of $f{'A'.$n}
+
+sub getfa {
+ my ($safeeval,$n)=@_;
+ return $safeeval->reval('$f{"A'.$n.'"}');
+}
+
# -------------------------------------------------------------------- Get type
sub gettype {
@@ -1111,7 +1159,7 @@ sub rown {
}
my $showf=0;
my $proc;
- my $maxred;
+ my $maxred=1;
my $sheettype=&gettype($safeeval);
if ($sheettype eq 'studentcalc') {
$proc='&outrowassess';
@@ -1124,6 +1172,7 @@ sub rown {
} else {
$maxred=26;
}
+ if (&getfa($safeeval,$n)=~/^[\~\-]/) { $maxred=1; }
if ($n eq '-') { $proc='&templaterow'; $n=-1; $dataflag=1; }
foreach ($safeeval->reval($proc.'('.$n.')')) {
my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD');
@@ -1138,9 +1187,14 @@ sub rown {
if ($vl eq '') {
$vl='#';
}
- $rowdata.=
- '
'.$vl.
- ' | ';
+ $rowdata.='';
+ if ($ENV{'request.role'} =~ /^st\./) {
+ $rowdata.=$vl;
+ } else {
+ $rowdata.=''.
+ $vl.'';
+ }
+ $rowdata.=' | ';
} else {
$rowdata.=' '.$vl.' | ';
}
@@ -1490,10 +1544,11 @@ sub tmpread {
}
} elsif ($nfield eq 'insertrow') {
$countrows++;
+ my $newrow=substr('000000'.$countrows,-7);
if ($nform eq 'top') {
- $fo{'A'.$countrows}='AAAAA_'.$countrows;
+ $fo{'A'.$countrows}='--- '.$newrow;
} else {
- $fo{'A'.$countrows}='zzzzz_'.$countrows;
+ $fo{'A'.$countrows}='~~~ '.$newrow;
}
} else {
if ($nfield) { $fo{$nfield}=$nform; }
@@ -1610,20 +1665,22 @@ sub updateclasssheet {
my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));
my $active=1;
if (($end) && ($now>$end)) { $active=0; }
+ $active = 1 if ($ENV{'form.Status'} eq 'Any');
+ $active = !$active if ($ENV{'form.Status'} eq 'Expired');
if ($active) {
my $rowlabel='';
$name=&Apache::lonnet::unescape($name);
my ($sname,$sdom)=split(/\:/,$name);
my $ssec=&Apache::lonnet::usection($sdom,$sname,$cid);
- if ($ssec==-1) {
- unless ($ENV{'form.showcsv'}) {
- $rowlabel='Data not available: '.$name.
- '';
- } else {
- $rowlabel='ERROR","'.$name.
- '","Data not available","","","';
- }
- } else {
+# if ($ssec==-1) {
+# unless ($ENV{'form.showcsv'}) {
+# $rowlabel='Data not available: '.$name.
+# '';
+# } else {
+# $rowlabel='ERROR","'.$name.
+# '","Data not available","","","';
+# }
+# } else {
my %reply=&Apache::lonnet::idrget($sdom,$sname);
my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.
':environment:firstname&middlename&lastname&generation',
@@ -1646,7 +1703,7 @@ sub updateclasssheet {
unless ($ncount==4) { $rowlabel.=',""'; }
$rowlabel=~s/\"$//;
}
- }
+# }
$currentlist{&Apache::lonnet::unescape($name)}=$rowlabel;
}
} # end of foreach (split(/\&/,$classlst))
@@ -1664,7 +1721,8 @@ sub updateclasssheet {
if ($_=~/^A(\d+)/) {
$maxrow=($1>$maxrow)?$1:$maxrow;
$existing{$f{$_}}=1;
- unless ((defined($currentlist{$f{$_}})) || (!$1)) {
+ unless ((defined($currentlist{$f{$_}})) || (!$1) ||
+ ($f{$_}=~/^(\~\~\~|\-\-\-)/)) {
$f{$_}='!!! Obsolete';
$changed=1;
}
@@ -1697,11 +1755,14 @@ sub updatestudentassesssheet {
my $safeeval=shift;
my %bighash;
my $stype=&gettype($safeeval);
+ my $uname=&getuname($safeeval);
+ my $udom =&getudom($safeeval);
my %current=();
- unless ($updatedata{$ENV{'request.course.fn'}.'_'.$stype}) {
+ unless ($updatedata{
+ $ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}) {
# -------------------------------------------------------------------- Tie hash
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
- &GDBM_READER,0640)) {
+ &GDBM_READER(),0640)) {
# --------------------------------------------------------- Get all assessments
my %allkeys=('timestamp' =>
@@ -1779,7 +1840,7 @@ sub updatestudentassesssheet {
} elsif ($stype eq 'studentcalc') {
%current=%allassess;
}
- $updatedata{$ENV{'request.course.fn'}.'_'.$stype}=
+ $updatedata{$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom}=
join('___;___',%current);
} else {
return 'Could not access course data';
@@ -1787,7 +1848,7 @@ sub updatestudentassesssheet {
# ------------------------------------------------------ Get current from cache
} else {
%current=split(/\_\_\_\;\_\_\_/,
- $updatedata{$ENV{'request.course.fn'}.'_'.$stype});
+ $updatedata{$ENV{'request.course.fn'}.'_'.$stype.'_'.$uname.'_'.$udom});
}
# -------------------- Find discrepancies between the course row table and this
#
@@ -1803,8 +1864,9 @@ sub updatestudentassesssheet {
$maxrow=($1>$maxrow)?$1:$maxrow;
my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});
$existing{$usy}=1;
- unless ((defined($current{$usy})) || (!$1)) {
- $f{$_}='!!! Obsolete';
+ unless ((defined($current{$usy})) || (!$1) ||
+ ($f{$_}=~/^(\~\~\~|\-\-\-)/)){
+ $f{$_}='!!! Obsolete';
$changed=1;
} elsif ($ufn) {
$current{$usy}
@@ -1857,7 +1919,7 @@ sub loadstudent {
foreach (keys(%f)) {
if ($_=~/^A(\d+)/) {
my $row=$1;
- unless (($f{$_}=~/^\!/) || ($row==0)) {
+ unless (($f{$_}=~/^[\!\~\-]/) || ($row==0)) {
my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});
@assessdata=&exportsheet(&getuname($safeeval),
&getudom($safeeval),
@@ -1896,7 +1958,7 @@ sub loadcourse {
my $total=0;
foreach (keys(%f)) {
if ($_=~/^A(\d+)/) {
- unless ($f{$_}=~/^\!/) { $total++; }
+ unless ($f{$_}=~/^[\!\~\-]/) { $total++; }
}
}
my $now=0;
@@ -1916,7 +1978,7 @@ ENDPOP
foreach (keys(%f)) {
if ($_=~/^A(\d+)/) {
my $row=$1;
- unless (($f{$_}=~/^\!/) || ($row==0)) {
+ unless (($f{$_}=~/^[\!\~\-]/) || ($row==0)) {
my @studentdata=&exportsheet(split(/\:/,$f{$_}),
'studentcalc');
undef %userrdatas;
@@ -2076,11 +2138,11 @@ sub loadassessment {
my %c=();
if (tie(%parmhash,'GDBM_File',
- &getcfn($safeeval).'_parms.db',&GDBM_READER,0640)) {
+ &getcfn($safeeval).'_parms.db',&GDBM_READER(),0640)) {
my %f=&getformulas($safeeval);
foreach (keys(%f)) {
if ($_=~/^A/) {
- unless ($f{$_}=~/^\!/) {
+ unless ($f{$_}=~/^[\!\~\-]/) {
if ($f{$_}=~/^parameter/) {
if ($thisassess{$f{$_}}) {
my $val=&parmval($f{$_},$safeeval);
@@ -2404,6 +2466,11 @@ sub handler {
return OK;
}
+ if ($ENV{'request.role'} =~ /^st\./) {
+ delete $ENV{'form.unewfield'} if (exists($ENV{'form.unewfield'}));
+ delete $ENV{'form.unewformula'} if (exists($ENV{'form.unewformula'}));
+ }
+
# ---------------------------------------------------- Global directory configs
$includedir=$r->dir_config('lonIncludes');
@@ -2449,7 +2516,8 @@ $tmpdir=$r->dir_config('lonDaemons').'/t
# --------------------------------------------------------------- Screen output
$r->print('LON-CAPA Spreadsheet');
- $r->print(<print(<
function celledit(cn,cf) {
@@ -2475,6 +2543,7 @@ $tmpdir=$r->dir_config('lonDaemons').'/t
ENDSCRIPT
+ }
$r->print(''.
'
'.
'LON-CAPA Spreadsheet
'.
@@ -2530,12 +2599,12 @@ ENDSCRIPT
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 {
+# if (&getcsec($asheet) eq '-1') {
+# $r->print(''.
+# 'Not a student in this course
');
+# } else {
$r->print('
Section/Group: '.&getcsec($asheet));
- }
+# }
if ($ENV{'form.usymb'}) {
$r->print('
Assessment: '.$ENV{'form.usymb'}.'');
}
@@ -2698,6 +2767,9 @@ ENDSCRIPT
}
# ------------------------------------------------------------------ Insertrows
+ $r->print(' Student Status: '.
+ &Apache::lonhtmlcommon::StatusOptions
+ ($ENV{'form.Status'},'sheet'));
$r->print(<