--- loncom/interface/Attic/lonspreadsheet.pm 2002/05/07 18:10:55 1.89 +++ loncom/interface/Attic/lonspreadsheet.pm 2002/08/29 15:35:01 1.103 @@ -1,5 +1,5 @@ # -# $Id: lonspreadsheet.pm,v 1.89 2002/05/07 18:10:55 matthew Exp $ +# $Id: lonspreadsheet.pm,v 1.103 2002/08/29 15:35:01 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,8 +130,7 @@ sub initsheet { $safeeval->permit("sort"); $safeeval->deny(":base_io"); $safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT'); - $safehole->wrap(\&send_msg, $safeeval,"&send_msg"); - $safehole->wrap(\&send_crit_msg,$safeeval,"&send_crit_msg"); + $safeeval->share('$@'); my $code=<<'ENDDEFS'; # ---------------------------------------------------- Inside of the safe space @@ -139,7 +146,7 @@ undef %v; undef %t; undef %f; undef %c; -undef %rl; +undef %rowlabel; undef @os; $maxrow=0; @@ -167,6 +174,10 @@ $cfn=''; $usymb=''; +# error messages + +$errormsg=''; + sub mask { my ($lower,$upper)=@_; @@ -710,6 +721,53 @@ sub SUMMIN { return $sum; } +#------------------------------------------------------- + +=item MINPARM(parametername) + +Returns the minimum value of the parameters matching the parametername. +parametername should be a string such as 'duedate'. + +=cut + +#------------------------------------------------------- +sub MINPARM { + my ($expression) = @_; + my $min = undef; + study($expression); + foreach $parameter (keys(%c)) { + next if ($parameter !~ /$expression/); + if ((! defined($min)) || ($min > $c{$parameter})) { + $min = $c{$parameter} + } + } + return $min; +} + +#------------------------------------------------------- + +=item MAXPARM(parametername) + +Returns the maximum value of the parameters matching the input parameter name. +parametername should be a string such as 'duedate'. + +=cut + +#------------------------------------------------------- +sub MAXPARM { + my ($expression) = @_; + my $max = undef; + study($expression); + foreach $parameter (keys(%c)) { + next if ($parameter !~ /$expression/); + if ((! defined($min)) || ($max < $c{$parameter})) { + $max = $c{$parameter} + } + } + return $max; +} + +#-------------------------------------------------------- sub expandnamed { my $expression=shift; if ($expression=~/^\&/) { @@ -757,6 +815,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'"; } @@ -772,6 +838,8 @@ sub sett { } else { $pattern='[A-Z]'; } + +# Deal with the template row foreach (keys(%f)) { if ($_=~/template\_(\w)/) { my $col=$1; @@ -798,6 +866,8 @@ sub sett { } } } + +# Deal with the normal cells foreach (keys(%f)) { if (($f{$_}) && ($_!~/template\_/)) { my $matches=($_=~/^$pattern(\d+)/); @@ -813,6 +883,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'}; @@ -822,25 +907,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 ''; @@ -865,9 +951,11 @@ sub outrowassess { my @cols=(); if ($n) { my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n}); - $cols[0]=$rl{$usy}.''. + if ($rowlabel{$usy}) { + $cols[0]=$rowlabel{$usy}.''. 'Default'; + } else { $cols[0]=''; } foreach (@os) { $cols[0].='Export'; } @@ -948,15 +1036,15 @@ 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 sub calcsheet { my $safeeval=shift; - $safeeval->reval('&calc();'); + return $safeeval->reval('&calc();'); } # ------------------------------------------------------------------ Get values @@ -973,6 +1061,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 +1206,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 +1219,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'); @@ -1182,20 +1278,20 @@ sub outsheet { '>Import'. 'Calculations'; - 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.=''; - } else { - $tabledata.=''; - } - $tabledata.="$_"; - } - $tabledata.=''.&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.=''; + } else { + $tabledata.=''; + } + $tabledata.="$_"; + } + $tabledata.=''.&rown($safeeval,'-').&rown($safeeval,0); } else { $tabledata=''; } $r->print($tabledata); @@ -1210,7 +1306,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'; @@ -1220,23 +1315,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("\n\n"); - $r->rflush(); - $r->print(' '.$what.''); - 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(''.$_.''); + my $thisrow=&rown($safeeval,$sortidx[$row]+1); + if ($thisrow) { + if (($n/25==int($n/25)) && (!$ENV{'form.showcsv'})) { + $r->print("\n\n"); + $r->rflush(); + $r->print(' '.$what.''); + $r->print(''.join('', + (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'. + 'abcdefghijklmnopqrstuvwxyz'))). + "\n"); + } + $n++; + $r->print($thisrow); } - $r->print(''); - } - $n++; - $r->print($thisrow); - } } $r->print($ENV{'form.showcsv'}?'':''); } @@ -1312,6 +1404,9 @@ sub readsheet { } else { $fn = $tmphash{'spreadsheet_default_'.$stype}; } + unless (($fn) && ($fn!~/^error\:/)) { + $fn='default_'.$stype; + } $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; } } @@ -1465,6 +1560,7 @@ sub tmpread { $fn=$tmpdir.$fn.'.tmp'; my $fh; my %fo=(); + my $countrows=0; if ($fh=Apache::File->new($fn)) { my $name; while ($name=<$fh>) { @@ -1472,6 +1568,11 @@ sub tmpread { my $value=<$fh>; chomp($value); $fo{$name}=$value; + if ($name=~/^A(\d+)$/) { + if ($1>$countrows) { + $countrows=$1; + } + } } } if ($nform eq 'changesheet') { @@ -1479,6 +1580,14 @@ sub tmpread { unless ($ENV{'form.sel_'.$nfield} eq 'Default') { $fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield}; } + } elsif ($nfield eq 'insertrow') { + $countrows++; + my $newrow=substr('000000'.$countrows,-7); + if ($nform eq 'top') { + $fo{'A'.$countrows}='--- '.$newrow; + } else { + $fo{'A'.$countrows}='~~~ '.$newrow; + } } else { if ($nfield) { $fo{$nfield}=$nform; } } @@ -1581,98 +1690,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='Data not available: '.$name. - ''; - } 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='Data not available: '. + $studentName.''; } 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=''. - $ssec.' '.$reply{$sname}.''; - 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=''. + $studentSection.' '; + foreach ('id','firstname','middlename', + 'lastname','generation'){ + $rowlabel.=$studentInformation{$_}." "; } $rowlabel.=''; - } 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 @@ -1685,7 +1797,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' => @@ -1787,8 +1899,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} @@ -1823,26 +1936,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); @@ -1880,7 +1989,7 @@ sub loadcourse { my $total=0; foreach (keys(%f)) { if ($_=~/^A(\d+)/) { - unless ($f{$_}=~/^\!/) { $total++; } + unless ($f{$_}=~/^[\!\~\-]/) { $total++; } } } my $now=0; @@ -1900,7 +2009,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; @@ -1911,18 +2020,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++; } @@ -2060,11 +2169,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); @@ -2451,11 +2560,15 @@ $tmpdir=$r->dir_config('lonDaemons').'/t document.sheet.submit(); } + function insertrow(cn) { + document.sheet.unewfield.value='insertrow'; + document.sheet.unewformula.value=cn; + document.sheet.submit(); + } + ENDSCRIPT - $r->print(''. - ''. - 'LON-CAPA Spreadsheet'. + $r->print(''.&Apache::loncommon::bodytag('Grades Spreadsheet'). ''. &hiddenfield('uname',$ENV{'form.uname'}). &hiddenfield('udom',$ENV{'form.udom'}). @@ -2519,12 +2632,6 @@ ENDSCRIPT } } -# ---------------------------------------------------------------- Course title - - $r->print(''. - $ENV{'course.'.$ENV{'request.course.id'}.'.description'}. - ''.localtime().''); - # ---------------------------------------------------- See if user can see this if ((&gettype($asheet) eq 'classcalc') || @@ -2674,6 +2781,20 @@ ENDSCRIPT if ($ENV{'form.showcsv'}) { $r->print(' checked'); } $r->print('>'); } + +# ------------------------------------------------------------------ Insertrows + $r->print(' Student Status: '. + &Apache::lonhtmlcommon::StatusOptions + ($ENV{'form.Status'},'sheet')); + + $r->print(< + + +ENDINSERTBUTTONS + # ------------------------------------------------------------- Print out sheet &outsheet($r,$asheet);
'; } $r->print($tabledata); @@ -1210,7 +1306,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'; @@ -1220,23 +1315,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("\n\n"); - $r->rflush(); - $r->print('