--- loncom/interface/Attic/lonspreadsheet.pm 2002/04/09 18:41:11 1.82
+++ loncom/interface/Attic/lonspreadsheet.pm 2002/07/02 21:57:38 1.92
@@ -1,5 +1,5 @@
#
-# $Id: lonspreadsheet.pm,v 1.82 2002/04/09 18:41:11 matthew Exp $
+# $Id: lonspreadsheet.pm,v 1.92 2002/07/02 21:57:38 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -508,6 +508,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 +536,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 +554,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 +577,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 +602,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 +620,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 +639,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 +658,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 +683,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 +740,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 +778,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 +811,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;
@@ -754,9 +863,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 $_) {
@@ -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',
@@ -1201,21 +1312,11 @@ sub readsheet {
} else {
$fn = $tmphash{'spreadsheet_default_'.$stype};
}
+ unless (($fn) && ($fn!~/^error\:/)) {
+ $fn='default_'.$stype;
+ }
$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 +1343,15 @@ sub readsheet {
} else {
$sheetxml='<field row="0" col="A">"Error"</field>';
}
- %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='<field row="0" col="A">"Error loading spreadsheet '
.$fn.'"</field>';
}
- %f=&parse_sheet(\$sheetxml);
+ %f=%{&parse_sheet(\$sheetxml)};
} else {
my $sheet='';
my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
@@ -1378,6 +1468,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>) {
@@ -1385,6 +1476,7 @@ sub tmpread {
my $value=<$fh>;
chomp($value);
$fo{$name}=$value;
+ $countrows++;
}
}
if ($nform eq 'changesheet') {
@@ -1392,6 +1484,12 @@ sub tmpread {
unless ($ENV{'form.sel_'.$nfield} eq 'Default') {
$fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};
}
+ } elsif ($nfield eq 'insertrow') {
+ if ($nform eq 'top') {
+ $fo{'A'.$countrows}='AAAAA_'.$countrows;
+ } else {
+ $fo{'A'.$countrows}='zzzzz_'.$countrows;
+ }
} else {
if ($nfield) { $fo{$nfield}=$nform; }
}
@@ -2312,17 +2410,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 +2449,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();
}
@@ -2373,6 +2462,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">'.
@@ -2589,12 +2684,24 @@ 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(<<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);