--- loncom/interface/Attic/lonspreadsheet.pm 2002/04/12 21:41:13 1.86
+++ loncom/interface/Attic/lonspreadsheet.pm 2002/07/30 21:23:44 1.98
@@ -1,5 +1,5 @@
#
-# $Id: lonspreadsheet.pm,v 1.86 2002/04/12 21:41:13 matthew Exp $
+# $Id: lonspreadsheet.pm,v 1.98 2002/07/30 21:23:44 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,25 @@ 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].'\'}';
+ } else {
+ $returnvalue = "'bad parameter name : $expression'";
+ }
+ return $returnvalue;
}
}
@@ -805,6 +783,8 @@ sub sett {
} else {
$pattern='[A-Z]';
}
+
+# Deal with the template row
foreach (keys(%f)) {
if ($_=~/template\_(\w)/) {
my $col=$1;
@@ -813,11 +793,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 +811,8 @@ sub sett {
}
}
}
+
+# Deal with the normal cells
foreach (keys(%f)) {
if (($f{$_}) && ($_!~/template\_/)) {
my $matches=($_=~/^$pattern(\d+)/);
@@ -840,6 +828,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 +852,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 +896,11 @@ sub outrowassess {
my @cols=();
if ($n) {
my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{'A'.$n});
+ if ($rl{$usy}) {
$cols[0]=$rl{$usy}.'<br>'.
'<select name="sel_'.$n.'" onChange="changesheet('.$n.
')"><option name="default">Default</option>';
+ } else { $cols[0]=''; }
foreach (@os) {
$cols[0].='<option name="'.$_.'"';
if ($ufn eq $_) {
@@ -981,7 +989,7 @@ sub setrowlabels {
sub calcsheet {
my $safeeval=shift;
- $safeeval->reval('&calc();');
+ return $safeeval->reval('&calc();');
}
# ------------------------------------------------------------------ Get values
@@ -998,6 +1006,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 {
@@ -1136,7 +1151,7 @@ sub rown {
}
my $showf=0;
my $proc;
- my $maxred;
+ my $maxred=1;
my $sheettype=&gettype($safeeval);
if ($sheettype eq 'studentcalc') {
$proc='&outrowassess';
@@ -1149,6 +1164,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');
@@ -1337,6 +1353,9 @@ sub readsheet {
} else {
$fn = $tmphash{'spreadsheet_default_'.$stype};
}
+ unless (($fn) && ($fn!~/^error\:/)) {
+ $fn='default_'.$stype;
+ }
$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn;
}
}
@@ -1490,6 +1509,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>) {
@@ -1497,6 +1517,11 @@ sub tmpread {
my $value=<$fh>;
chomp($value);
$fo{$name}=$value;
+ if ($name=~/^A(\d+)$/) {
+ if ($1>$countrows) {
+ $countrows=$1;
+ }
+ }
}
}
if ($nform eq 'changesheet') {
@@ -1504,6 +1529,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; }
}
@@ -1619,6 +1652,8 @@ 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);
@@ -1673,7 +1708,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;
}
@@ -1812,8 +1848,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}
@@ -1866,7 +1903,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),
@@ -1905,7 +1942,7 @@ sub loadcourse {
my $total=0;
foreach (keys(%f)) {
if ($_=~/^A(\d+)/) {
- unless ($f{$_}=~/^\!/) { $total++; }
+ unless ($f{$_}=~/^[\!\~\-]/) { $total++; }
}
}
my $now=0;
@@ -1925,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;
@@ -2089,7 +2126,7 @@ sub loadassessment {
my %f=&getformulas($safeeval);
foreach (keys(%f)) {
if ($_=~/^A/) {
- unless ($f{$_}=~/^\!/) {
+ unless ($f{$_}=~/^[\!\~\-]/) {
if ($f{$_}=~/^parameter/) {
if ($thisassess{$f{$_}}) {
my $val=&parmval($f{$_},$safeeval);
@@ -2424,17 +2461,8 @@ $tmpdir=$r->dir_config('lonDaemons').'/t
# --------------------------- Get query string for limited number of parameters
- foreach (split(/&/,$ENV{'QUERY_STRING'})) {
- my ($name, $value) = split(/=/,$_);
- $value =~ tr/+/ /;
- $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
- if (($name eq 'uname') || ($name eq 'udom') ||
- ($name eq 'usymb') || ($name eq 'ufn')) {
- unless ($ENV{'form.'.$name}) {
- $ENV{'form.'.$name}=$value;
- }
- }
- }
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ ['uname','udom','usymb','ufn']);
if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) {
$ENV{'form.ufn'}='default_'.$1;
@@ -2485,6 +2513,12 @@ $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();
+ }
+
</script>
ENDSCRIPT
$r->print('</head><body bgcolor="#FFFFFF">'.
@@ -2701,12 +2735,27 @@ ENDSCRIPT
}
}
$r->print('>');
+
if (&gettype($asheet) eq 'classcalc') {
$r->print(
' Output CSV format: <input type=checkbox name=showcsv onClick="submit()"');
if ($ENV{'form.showcsv'}) { $r->print(' checked'); }
$r->print('>');
}
+
+# ------------------------------------------------------------------ Insertrows
+ $r->print(' Student Status: '.
+ &Apache::lonhtmlcommon::StatusOptions
+ ($ENV{'form.Status'},'sheet'));
+
+ $r->print(<<ENDINSERTBUTTONS);
+<br>
+<input type='button' onClick='insertrow("top");'
+value='Insert Row Top'>
+<input type='button' onClick='insertrow("bottom");'
+value='Insert Row Bottom'><br>
+ENDINSERTBUTTONS
+
# ------------------------------------------------------------- Print out sheet
&outsheet($r,$asheet);