--- loncom/interface/Attic/lonspreadsheet.pm 2002/04/12 21:41:13 1.86 +++ loncom/interface/Attic/lonspreadsheet.pm 2002/09/27 18:43:10 1.100.4.1 @@ -1,5 +1,5 @@ # -# $Id: lonspreadsheet.pm,v 1.86 2002/04/12 21:41:13 matthew Exp $ +# $Id: lonspreadsheet.pm,v 1.100.4.1 2002/09/27 18:43:10 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,28 +106,19 @@ 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; my $tmpdir; -# ------------------------------------------------ Send critical message -sub send_crit_msg { - my ($uname,$udom,$subject,$message,$sendback) = @_; - my $result = &Apache::lonmsg::user_crit_msg($uname,$udom,$subject, - $message,$sendback); - return ($result eq 'ok' ? 1 : 0); -} - -# ------------------------------------------------ Send noncritical message -sub send_msg { - my ($uname,$udom,$subject,$message) = @_; - my $result = &Apache::lonmsg::user_normal_msg($uname,$udom, - $subject,$message); - return ($result eq 'ok' ? 1 : 0); -} - - # ============================================================================= # ===================================== Implements an instance of a spreadsheet @@ -139,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 @@ -184,6 +174,10 @@ $cfn=''; $usymb=''; +# error messages + +$errormsg=''; + sub mask { my ($lower,$upper)=@_; @@ -727,40 +721,6 @@ sub SUMMIN { return $sum; } -#------------------------------------------------------- - -=item SEND_CRIT_MSG(subject,message) - -Send a critical message to a student. - -=cut - -#------------------------------------------------------- -sub SEND_CRIT_MSG { - my ($subject,$message) = @_; - my $name = $uname; - my $dom = $udom; - return (&send_crit_msg($name,$dom,$subject,$message) ? 'Message Sent.' - : 'Error sending message'); -} - -#------------------------------------------------------- - -=item SEND_MSG(subject,message) - -Send a message to a student. - -=cut - -#------------------------------------------------------- -sub SEND_MSG { - my ($subject,$message) = @_; - my $name = $uname; - my $dom = $udom; - return (&send_msg($name,$dom,$subject,$message) ? 'Message Sent.' - : 'Error sending message'); -} - sub expandnamed { my $expression=shift; if ($expression=~/^\&/) { @@ -793,7 +753,33 @@ sub expandnamed { return 0; } } else { - return '$c{\''.$expression.'\'}'; + # it is not a function, so it is a parameter name + # We should do the following: + # 1. Take the list of parameter names + # 2. look through the list for ones that match the parameter we want + # 3. If there are no collisions, return the one that matches + # 4. If there is a collision, return 'bad parameter name error' + my $returnvalue = ''; + my @matches = (); + $#matches = -1; + study $expression; + foreach $parameter (keys(%c)) { + push @matches,$parameter if ($parameter =~ /$expression/); + } + 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'"; + } + return $returnvalue; } } @@ -805,6 +791,8 @@ sub sett { } else { $pattern='[A-Z]'; } + +# Deal with the template row foreach (keys(%f)) { if ($_=~/template\_(\w)/) { my $col=$1; @@ -813,11 +801,17 @@ sub sett { if ($_=~/A(\d+)/) { my $trow=$1; if ($trow) { + # Get the name of this cell my $lb=$col.$trow; + # Grab the template declaration $t{$lb}=$f{'template_'.$col}; + # Replace '#' with the row number $t{$lb}=~s/\#/$trow/g; + # Replace '....' with ',' $t{$lb}=~s/\.\.+/\,/g; + # Replace 'A0' with the value from 'A0' $t{$lb}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g; + # Replace parameters $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; } } @@ -825,6 +819,8 @@ sub sett { } } } + +# Deal with the normal cells foreach (keys(%f)) { if (($f{$_}) && ($_!~/template\_/)) { my $matches=($_=~/^$pattern(\d+)/); @@ -840,6 +836,23 @@ 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'}; $t{'A0'}=~s/\.\.+/\,/g; $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g; @@ -847,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 ''; @@ -890,9 +904,11 @@ sub outrowassess { my @cols=(); if ($n) { my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n}); + if ($rl{$usy}) { $cols[0]=$rl{$usy}.'
'. '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);