--- 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>