--- loncom/interface/Attic/lonspreadsheet.pm 2002/04/09 18:41:11 1.82 +++ loncom/interface/Attic/lonspreadsheet.pm 2002/05/07 18:10:55 1.89 @@ -1,5 +1,5 @@ # -# $Id: lonspreadsheet.pm,v 1.82 2002/04/09 18:41:11 matthew Exp $ +# $Id: lonspreadsheet.pm,v 1.89 2002/05/07 18:10:55 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -122,6 +122,8 @@ 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"); my $code=<<'ENDDEFS'; # ---------------------------------------------------- Inside of the safe space @@ -508,6 +510,15 @@ sub HASH { return $Values[-1]; } +#------------------------------------------------------- + +=item NUM(range) + +returns the number of items in the range. + +=cut + +#------------------------------------------------------- sub NUM { my $mask=mask(@_); my $num= $#{@{grep(/$mask/,keys(%v))}}+1; @@ -527,6 +538,15 @@ sub BIN { } +#------------------------------------------------------- + +=item SUM(range) + +returns the sum of items in the range. + +=cut + +#------------------------------------------------------- sub SUM { my $mask=mask(@_); my $sum=0; @@ -536,6 +556,15 @@ sub SUM { return $sum; } +#------------------------------------------------------- + +=item MEAN(range) + +compute the average of the items in the range. + +=cut + +#------------------------------------------------------- sub MEAN { my $mask=mask(@_); my $sum=0; my $num=0; @@ -550,6 +579,15 @@ sub MEAN { } } +#------------------------------------------------------- + +=item STDDEV(range) + +compute the standard deviation of the items in the range. + +=cut + +#------------------------------------------------------- sub STDDEV { my $mask=mask(@_); my $sum=0; my $num=0; @@ -566,6 +604,15 @@ sub STDDEV { return sqrt($sum/($num-1)); } +#------------------------------------------------------- + +=item PROD(range) + +compute the product of the items in the range. + +=cut + +#------------------------------------------------------- sub PROD { my $mask=mask(@_); my $prod=1; @@ -575,6 +622,15 @@ sub PROD { return $prod; } +#------------------------------------------------------- + +=item MAX(range) + +compute the maximum of the items in the range. + +=cut + +#------------------------------------------------------- sub MAX { my $mask=mask(@_); my $max='-'; @@ -585,6 +641,15 @@ sub MAX { return $max; } +#------------------------------------------------------- + +=item MIN(range) + +compute the minimum of the items in the range. + +=cut + +#------------------------------------------------------- sub MIN { my $mask=mask(@_); my $min='-'; @@ -595,12 +660,22 @@ sub MIN { return $min; } +#------------------------------------------------------- + +=item SUMMAX(num,lower,upper) + +compute the sum of the largest 'num' items in the range from +'lower' to 'upper' + +=cut + +#------------------------------------------------------- sub SUMMAX { my ($num,$lower,$upper)=@_; my $mask=mask($lower,$upper); my @inside=(); foreach (grep /$mask/,keys(%v)) { - $inside[$#inside+1]=$v{$_}; + push (@inside,$v{$_}); } @inside=sort(@inside); my $sum=0; my $i; @@ -610,6 +685,16 @@ sub SUMMAX { return $sum; } +#------------------------------------------------------- + +=item SUMMIN(num,lower,upper) + +compute the sum of the smallest 'num' items in the range from +'lower' to 'upper' + +=cut + +#------------------------------------------------------- sub SUMMIN { my ($num,$lower,$upper)=@_; my $mask=mask($lower,$upper); @@ -657,7 +742,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; } } @@ -677,11 +780,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; } } @@ -704,6 +813,8 @@ sub sett { } } } + # 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; @@ -774,7 +885,7 @@ sub outrowassess { 'n','o','p','q','r','s','t','u','v','w','x','y','z') { my $fm=$f{$_.$n}; $fm=~s/[\'\"]/\&\#34;/g; - $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n}; + push(@cols,"'$_$n','$fm'".'___eq___'.$v{$_.$n}); } return @cols; } @@ -1189,7 +1300,7 @@ sub readsheet { my $cdom=&getcdom($safeeval); my $chome=&getchome($safeeval); - if (! defined($fn) || $fn eq '') { + if (! defined($fn)) { # There is no filename. Look for defaults in course and global, cache unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) { my %tmphash = &Apache::lonnet::get('environment', @@ -1203,19 +1314,6 @@ sub readsheet { } $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; } - } else { - # We do have a filename, do a get on it. - my %tmphash = &Apache::lonnet::get('environment', - [$fn], - $cdom,$cnum); - my ($tmp) = keys(%tmphash); - if ($tmp =~ /^(con_lost|error|no_such_host)/i) { - # On error, grab the default filename - $fn = 'default_'.$stype; - } else { - $fn = $tmphash{$fn}; - } - $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; } # ---------------------------------------------------------- fn now has a value @@ -1242,26 +1340,15 @@ sub readsheet { } else { $sheetxml='"Error"'; } - %f=&parse_sheet(\$sheetxml); + %f=%{&parse_sheet(\$sheetxml)}; } elsif($fn=~/\/*\.spreadsheet$/) { - my $sheetxml=''; - my $fh; - my $dfn=$fn; - $dfn=~s/\_/\./g; - - if ($fn !~ /^$Apache::lonnet::perlvar{'lonDocRoot'}\/res/) { - $fn = $Apache::lonnet::perlvar{'lonDocRoot'}.'/res'.$fn; - } - if ($fn !~ /^$Apache::lonnet::perlvar{'lonDocRoot'}/) { - $fn = $Apache::lonnet::perlvar{'lonDocRoot'}.$fn; - } - if ($fh=Apache::File->new($fn)) { - $sheetxml=join('',<$fh>); - } else { + my $sheetxml=&Apache::lonnet::getfile + (&Apache::lonnet::filelocation('',$fn)); + if ($sheetxml == -1) { $sheetxml='"Error loading spreadsheet ' .$fn.'"'; } - %f=&parse_sheet(\$sheetxml); + %f=%{&parse_sheet(\$sheetxml)}; } else { my $sheet=''; my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum); @@ -2312,17 +2399,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; @@ -2360,8 +2438,8 @@ $tmpdir=$r->dir_config('lonDaemons').'/t function celledit(cn,cf) { var cnf=prompt(cn,cf); - if (cnf!=null) { - document.sheet.unewfield.value=cn; + if (cnf!=null) { + document.sheet.unewfield.value=cn; document.sheet.unewformula.value=cnf; document.sheet.submit(); } @@ -2589,6 +2667,7 @@ ENDSCRIPT } } $r->print('>'); + if (&gettype($asheet) eq 'classcalc') { $r->print( ' Output CSV format: