--- loncom/interface/Attic/lonspreadsheet.pm 2002/07/05 01:31:25 1.95
+++ loncom/interface/Attic/lonspreadsheet.pm 2002/08/28 19:50:29 1.102
@@ -1,5 +1,5 @@
#
-# $Id: lonspreadsheet.pm,v 1.95 2002/07/05 01:31:25 www Exp $
+# $Id: lonspreadsheet.pm,v 1.102 2002/08/28 19:50:29 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
#
@@ -112,6 +112,7 @@ my %parmhash;
my %starttimes;
my %usedtimes;
+my %numbertimes;
# Stuff that only the screen handler can know
@@ -129,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
@@ -144,7 +146,7 @@ undef %v;
undef %t;
undef %f;
undef %c;
-undef %rl;
+undef %rowlabel;
undef @os;
$maxrow=0;
@@ -766,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'";
}
@@ -781,6 +791,8 @@ sub sett {
} else {
$pattern='[A-Z]';
}
+
+# Deal with the template row
foreach (keys(%f)) {
if ($_=~/template\_(\w)/) {
my $col=$1;
@@ -807,6 +819,8 @@ sub sett {
}
}
}
+
+# Deal with the normal cells
foreach (keys(%f)) {
if (($f{$_}) && ($_!~/template\_/)) {
my $matches=($_=~/^$pattern(\d+)/);
@@ -822,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'};
@@ -834,26 +863,26 @@ sub calc {
undef %v;
&sett();
my $notfinished=1;
+ my $lastcalc='';
my $depth=0;
- my $errormsg;
while ($notfinished) {
$notfinished=0;
foreach (keys(%t)) {
my $old=$v{$_};
- $v{$_}=eval($t{$_});
+ $v{$_}=eval $t{$_};
if ($@) {
- $v{$_}='"error"';
- $errormsg.=$_.': '.$@."\n";
+ undef %v;
+ return $_.': '.$@;
}
- if ($v{$_} ne $old) { $notfinished=1; }
+ if ($v{$_} ne $old) { $notfinished=1; $lastcalc=$_; }
}
$depth++;
if ($depth>100) {
undef %v;
- return 'Maximum calculation depth exceeded';
+ return $lastcalc.': Maximum calculation depth exceeded';
}
}
- return $errormsg;
+ return '';
}
sub templaterow {
@@ -875,8 +904,8 @@ sub outrowassess {
my @cols=();
if ($n) {
my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n});
- if ($rl{$usy}) {
- $cols[0]=$rl{$usy}.'<br>'.
+ if ($rowlabel{$usy}) {
+ $cols[0]=$rowlabel{$usy}.'<br>'.
'<select name="sel_'.$n.'" onChange="changesheet('.$n.
')"><option name="default">Default</option>';
} else { $cols[0]=''; }
@@ -906,7 +935,7 @@ sub outrow {
my $n=shift;
my @cols=();
if ($n) {
- $cols[0]=$rl{$f{'A'.$n}};
+ $cols[0]=$rowlabel{$f{'A'.$n}};
} else {
$cols[0]='<b><font size=+1>Export</font></b>';
}
@@ -960,8 +989,8 @@ sub setothersheets {
# ------------------------------------------------ Add or change formula values
sub setrowlabels {
- my ($safeeval,%rl)=@_;
- %{$safeeval->varglob('rl')}=%rl;
+ my ($safeeval,%rowlabel)=@_;
+ %{$safeeval->varglob('rowlabel')}=%rowlabel;
}
# ------------------------------------------------------- Calculate spreadsheet
@@ -985,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 {
@@ -1123,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';
@@ -1136,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');
@@ -1194,20 +1231,20 @@ sub outsheet {
'><b><font size=+1>Import</font></b></td>'.
'<td colspan='.$maxyellow.
'><b><font size=+1>Calculations</font></b></td></tr><tr>';
- my $showf=0;
- foreach ('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',
- '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') {
- $showf++;
- if ($showf<=$maxred) {
- $tabledata.='<td bgcolor="#FFDDDD">';
- } else {
- $tabledata.='<td>';
- }
- $tabledata.="<b><font size=+1>$_</font></b></td>";
- }
- $tabledata.='</tr>'.&rown($safeeval,'-').&rown($safeeval,0);
+ my $showf=0;
+ foreach ('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',
+ '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') {
+ $showf++;
+ if ($showf<=$maxred) {
+ $tabledata.='<td bgcolor="#FFDDDD">';
+ } else {
+ $tabledata.='<td>';
+ }
+ $tabledata.="<b><font size=+1>$_</font></b></td>";
+ }
+ $tabledata.='</tr>'.&rown($safeeval,'-').&rown($safeeval,0);
} else { $tabledata='<pre>'; }
$r->print($tabledata);
@@ -1222,7 +1259,6 @@ sub outsheet {
$sortidx[$row-1]=$row-1;
}
@sortidx=sort { $sortby[$a] cmp $sortby[$b]; } @sortidx;
-
my $what='Student';
if (&gettype($safeeval) eq 'assesscalc') {
$what='Item';
@@ -1232,23 +1268,20 @@ sub outsheet {
my $n=0;
for ($row=0;$row<$maxrow;$row++) {
- my $thisrow=&rown($safeeval,$sortidx[$row]+1);
- if ($thisrow) {
- if (($n/25==int($n/25)) && (!$ENV{'form.showcsv'})) {
- $r->print("</table>\n<br>\n");
- $r->rflush();
- $r->print('<table border=2><tr><td> <td>'.$what.'</td>');
- foreach ('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',
- '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') {
- $r->print('<td>'.$_.'</td>');
+ my $thisrow=&rown($safeeval,$sortidx[$row]+1);
+ if ($thisrow) {
+ if (($n/25==int($n/25)) && (!$ENV{'form.showcsv'})) {
+ $r->print("</table>\n<br>\n");
+ $r->rflush();
+ $r->print('<table border=2><tr><td> <td>'.$what.'</td>');
+ $r->print('<td>'.join('</td><td>',
+ (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
+ 'abcdefghijklmnopqrstuvwxyz'))).
+ "</td></tr>\n");
+ }
+ $n++;
+ $r->print($thisrow);
}
- $r->print('</tr>');
- }
- $n++;
- $r->print($thisrow);
- }
}
$r->print($ENV{'form.showcsv'}?'</pre>':'</table>');
}
@@ -1610,98 +1643,101 @@ sub updateclasssheet {
my $cdom=&getcdom($safeeval);
my $cid=&getcid($safeeval);
my $chome=&getchome($safeeval);
-
-# ---------------------------------------------- Read class list and row labels
-
- my $classlst=&Apache::lonnet::reply
- ('dump:'.$cdom.':'.$cnum.':classlist',$chome);
+ #
+ # Read class list and row labels
+ my %classlist;
+ my @tmp = &Apache::lonnet::dump('classlist',$cdom,$cnum);
+ if ($tmp[0] !~ /^error/) {
+ %classlist = @tmp;
+ } else {
+ return 'Could not access course data';
+ }
+ undef @tmp;
+ #
my %currentlist=();
my $now=time;
- unless ($classlst=~/^error\:/) {
- foreach (split(/\&/,$classlst)) {
- my ($name,$value)=split(/\=/,$_);
- my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value));
- my $active=1;
- if (($end) && ($now>$end)) { $active=0; }
- 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='<font color=red>Data not available: '.$name.
- '</font>';
- } else {
- $rowlabel='ERROR","'.$name.
- '","Data not available","","","';
- }
+ foreach my $student (keys(%classlist)) {
+ my ($end,$start)=split(/\:/,$classlist{$student});
+ my $active=1;
+ $active = 0 if (($end) && ($now>$end));
+ $active = 1 if ($ENV{'form.Status'} eq 'Any');
+ $active = !$active if ($ENV{'form.Status'} eq 'Expired');
+ if ($active) {
+ my $rowlabel='';
+ my ($studentName,$studentDomain)=split(/\:/,$student);
+ my $studentSection=&Apache::lonnet::usection($studentDomain,
+ $studentName,$cid);
+ if ($studentSection==-1) {
+ unless ($ENV{'form.showcsv'}) {
+ $rowlabel='<font color=red>Data not available: '.
+ $studentName.'</font>';
} else {
- my %reply=&Apache::lonnet::idrget($sdom,$sname);
- my $reply=&Apache::lonnet::reply('get:'.$sdom.':'.$sname.
- ':environment:firstname&middlename&lastname&generation',
- &Apache::lonnet::homeserver($sname,$sdom));
- unless ($ENV{'form.showcsv'}) {
- $rowlabel='<a href="/adm/studentcalc?uname='.$sname.
- '&udom='.$sdom.'">'.
- $ssec.' '.$reply{$sname}.'<br>';
- foreach ( split(/\&/,$reply)) {
- $rowlabel.=&Apache::lonnet::unescape($_).' ';
+ $rowlabel='ERROR","'.$studentName.
+ '","Data not available","","","';
+ }
+ } else {
+ my %reply=&Apache::lonnet::idrget($studentDomain,$studentName);
+ my %studentInformation=&Apache::lonnet::get
+ ('environment',
+ ['lastname','generation','firstname','middlename','id'],
+ $studentDomain,$studentName);
+ if (! $ENV{'form.showcsv'}) {
+ $rowlabel='<a href="/adm/studentcalc?uname='.$studentName.
+ '&udom='.$studentDomain.'">'.
+ $studentSection.' ';
+ foreach ('id','firstname','middlename',
+ 'lastname','generation'){
+ $rowlabel.=$studentInformation{$_}." ";
}
$rowlabel.='</a>';
- } else {
- $rowlabel=$ssec.'","'.$reply{$sname}.'"';
- my $ncount=0;
- foreach (split(/\&/,$reply)) {
- $rowlabel.=',"'.&Apache::lonnet::unescape($_).'"';
- $ncount++;
- }
- unless ($ncount==4) { $rowlabel.=',""'; }
- $rowlabel=~s/\"$//;
- }
+ } else {
+ $rowlabel= '"'.join('","',
+ ($studentSection,
+ $studentInformation{'id'},
+ $studentInformation{'firstname'},
+ $studentInformation{'middlename'},
+ $studentInformation{'lastname'},
+ $studentInformation{'generation'})
+ ).'"';
}
- $currentlist{&Apache::lonnet::unescape($name)}=$rowlabel;
}
- } # end of foreach (split(/\&/,$classlst))
-#
-# -------------------- Find discrepancies between the course row table and this
-#
- my %f=&getformulas($safeeval);
- my $changed=0;
-
- my $maxrow=0;
- my %existing=();
-
-# ----------------------------------------------------------- Now obsolete rows
- foreach (keys(%f)) {
- if ($_=~/^A(\d+)/) {
- $maxrow=($1>$maxrow)?$1:$maxrow;
- $existing{$f{$_}}=1;
- unless ((defined($currentlist{$f{$_}})) || (!$1)) {
- $f{$_}='!!! Obsolete';
- $changed=1;
- }
+ $currentlist{$student}=$rowlabel;
+ } # end of if ($active)
+ } # end of foreach my $student (keys(%classlist))
+ #
+ # Find discrepancies between the course row table and this
+ #
+ my %f=&getformulas($safeeval);
+ my $changed=0;
+ #
+ my $maxrow=0;
+ my %existing=();
+ #
+ # Now obsolete rows
+ foreach (keys(%f)) {
+ if ($_=~/^A(\d+)/) {
+ $maxrow=($1>$maxrow)?$1:$maxrow;
+ $existing{$f{$_}}=1;
+ unless ((defined($currentlist{$f{$_}})) || (!$1) ||
+ ($f{$_}=~/^(\~\~\~|\-\-\-)/)) {
+ $f{$_}='!!! Obsolete';
+ $changed=1;
}
}
-
-# -------------------------------------------------------- New and unknown keys
-
- foreach (sort keys(%currentlist)) {
- unless ($existing{$_}) {
- $changed=1;
- $maxrow++;
- $f{'A'.$maxrow}=$_;
- }
+ }
+ #
+ # New and unknown keys
+ foreach (sort keys(%currentlist)) {
+ unless ($existing{$_}) {
+ $changed=1;
+ $maxrow++;
+ $f{'A'.$maxrow}=$_;
}
-
- if ($changed) { &setformulas($safeeval,%f); }
-
- &setmaxrow($safeeval,$maxrow);
- &setrowlabels($safeeval,%currentlist);
-
- } else {
- return 'Could not access course data';
}
+ if ($changed) { &setformulas($safeeval,%f); }
+ #
+ &setmaxrow($safeeval,$maxrow);
+ &setrowlabels($safeeval,%currentlist);
}
# ----------------------------------- Update rows for student and assess sheets
@@ -1714,7 +1750,7 @@ sub updatestudentassesssheet {
unless ($updatedata{$ENV{'request.course.fn'}.'_'.$stype}) {
# -------------------------------------------------------------------- Tie hash
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
- &GDBM_READER,0640)) {
+ &GDBM_READER(),0640)) {
# --------------------------------------------------------- Get all assessments
my %allkeys=('timestamp' =>
@@ -1816,8 +1852,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}
@@ -1852,26 +1889,22 @@ sub loadstudent {
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\:/) {
- foreach ( split(/\&/,$reply)) {
- my ($name,$value)=split(/\=/,$_);
- $cachedstores{&Apache::lonnet::unescape($name)}=
- &Apache::lonnet::unescape($value);
- }
- }
+ # Get ALL the student preformance data
+ my @tmp = &Apache::lonnet::dump(&getcid($safeeval),
+ &getudom($safeeval),
+ &getuname($safeeval),
+ undef);
+ if ($tmp[0] !~ /^error:/) {
+ %cachedstores = @tmp;
}
+ undef @tmp;
+ #
my @assessdata=();
foreach (keys(%f)) {
if ($_=~/^A(\d+)/) {
my $row=$1;
- unless (($f{$_}=~/^\!/) || ($row==0)) {
- my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_});
+ unless (($f{$_}=~/^[\!\~\-]/) || ($row==0)) {
+ my ($usy,$ufn)=split(/__&&&\__/,$f{$_});
@assessdata=&exportsheet(&getuname($safeeval),
&getudom($safeeval),
'assesscalc',$usy,$ufn);
@@ -1909,7 +1942,7 @@ sub loadcourse {
my $total=0;
foreach (keys(%f)) {
if ($_=~/^A(\d+)/) {
- unless ($f{$_}=~/^\!/) { $total++; }
+ unless ($f{$_}=~/^[\!\~\-]/) { $total++; }
}
}
my $now=0;
@@ -1929,7 +1962,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;
@@ -1940,18 +1973,18 @@ ENDPOP
$r->rflush();
my $index=0;
- foreach ('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') {
+ foreach ('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') {
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';
- }
+ 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++;
}
@@ -2089,11 +2122,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);
@@ -2488,9 +2521,7 @@ $tmpdir=$r->dir_config('lonDaemons').'/t
</script>
ENDSCRIPT
- $r->print('</head><body bgcolor="#FFFFFF">'.
- '<img align=right src=/adm/lonIcons/lonlogos.gif>'.
- '<h1>LON-CAPA Spreadsheet</h1>'.
+ $r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet').
'<form action="'.$r->uri.'" name=sheet method=post>'.
&hiddenfield('uname',$ENV{'form.uname'}).
&hiddenfield('udom',$ENV{'form.udom'}).
@@ -2554,12 +2585,6 @@ ENDSCRIPT
}
}
-# ---------------------------------------------------------------- Course title
-
- $r->print('<h1>'.
- $ENV{'course.'.$ENV{'request.course.id'}.'.description'}.
- '</h1><h3>'.localtime().'</h3>');
-
# ---------------------------------------------------- See if user can see this
if ((&gettype($asheet) eq 'classcalc') ||
@@ -2711,6 +2736,9 @@ ENDSCRIPT
}
# ------------------------------------------------------------------ Insertrows
+ $r->print(' Student Status: '.
+ &Apache::lonhtmlcommon::StatusOptions
+ ($ENV{'form.Status'},'sheet'));
$r->print(<<ENDINSERTBUTTONS);
<br>