--- loncom/interface/Attic/lonspreadsheet.pm 2002/04/08 18:28:03 1.81
+++ loncom/interface/Attic/lonspreadsheet.pm 2002/07/04 17:51:32 1.93
@@ -1,5 +1,5 @@
#
-# $Id: lonspreadsheet.pm,v 1.81 2002/04/08 18:28:03 matthew Exp $
+# $Id: lonspreadsheet.pm,v 1.93 2002/07/04 17:51:32 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;
}
@@ -1149,6 +1260,35 @@ sub othersheets {
return @alternatives;
}
+
+#
+# -------------------------------------- Parse a spreadsheet
+#
+sub parse_sheet {
+ # $sheetxml is a scalar reference or a scalar
+ my ($sheetxml) = @_;
+ if (! ref($sheetxml)) {
+ my $tmp = $sheetxml;
+ $sheetxml = \$tmp;
+ }
+ my %f;
+ my $parser=HTML::TokeParser->new($sheetxml);
+ my $token;
+ while ($token=$parser->get_token) {
+ if ($token->[0] eq 'S') {
+ if ($token->[1] eq 'field') {
+ $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
+ $parser->get_text('/field');
+ }
+ if ($token->[1] eq 'template') {
+ $f{'template_'.$token->[2]->{'col'}}=
+ $parser->get_text('/template');
+ }
+ }
+ }
+ return \%f;
+}
+
#
# -------------------------------------- Read spreadsheet formulas for a course
#
@@ -1160,17 +1300,22 @@ sub readsheet {
my $cdom=&getcdom($safeeval);
my $chome=&getchome($safeeval);
-# --------- There is no filename. Look for defaults in course and global, cache
-
- unless($fn) {
+ if (! defined($fn)) {
+ # There is no filename. Look for defaults in course and global, cache
unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) {
- $fn=&Apache::lonnet::reply('get:'.$cdom.':'.$cnum.
- ':environment:spreadsheet_default_'.$stype,
- $chome);
- unless (($fn) && ($fn!~/^error\:/)) {
- $fn='default_'.$stype;
- }
- $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn;
+ my %tmphash = &Apache::lonnet::get('environment',
+ ['spreadsheet_default_'.$stype],
+ $cdom,$cnum);
+ my ($tmp) = keys(%tmphash);
+ if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
+ $fn = 'default_'.$stype;
+ } else {
+ $fn = $tmphash{'spreadsheet_default_'.$stype};
+ }
+ unless (($fn) && ($fn!~/^error\:/)) {
+ $fn='default_'.$stype;
+ }
+ $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn;
}
}
@@ -1189,41 +1334,34 @@ sub readsheet {
my %f=();
if ($fn=~/^default\_/) {
- my $sheetxml='';
- {
+ my $sheetxml='';
my $fh;
my $dfn=$fn;
$dfn=~s/\_/\./g;
if ($fh=Apache::File->new($includedir.'/'.$dfn)) {
- $sheetxml=join('',<$fh>);
- } else {
+ $sheetxml=join('',<$fh>);
+ } else {
$sheetxml='<field row="0" col="A">"Error"</field>';
- }
- }
- my $parser=HTML::TokeParser->new(\$sheetxml);
- my $token;
- while ($token=$parser->get_token) {
- if ($token->[0] eq 'S') {
- if ($token->[1] eq 'field') {
- $f{$token->[2]->{'col'}.$token->[2]->{'row'}}=
- $parser->get_text('/field');
- }
- if ($token->[1] eq 'template') {
- $f{'template_'.$token->[2]->{'col'}}=
- $parser->get_text('/template');
+ }
+ %f=%{&parse_sheet(\$sheetxml)};
+ } elsif($fn=~/\/*\.spreadsheet$/) {
+ 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)};
+ } else {
+ my $sheet='';
+ my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
+ my ($tmp) = keys(%tmphash);
+ unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
+ foreach (keys(%tmphash)) {
+ $f{$_}=$tmphash{$_};
}
- }
- }
- } else {
- my $sheet='';
- my %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
- my ($tmp) = keys(%tmphash);
- unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
- foreach (keys(%tmphash)) {
- $f{$_}=$tmphash{$_};
- }
- }
- }
+ }
+ }
# --------------------------------------------------------------- Cache and set
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
&setformulas($safeeval,%f);
@@ -1330,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>) {
@@ -1337,6 +1476,11 @@ sub tmpread {
my $value=<$fh>;
chomp($value);
$fo{$name}=$value;
+ if ($name=~/^A(\d+)$/) {
+ if ($1>$countrows) {
+ $countrows=$1;
+ }
+ }
}
}
if ($nform eq 'changesheet') {
@@ -1344,6 +1488,13 @@ sub tmpread {
unless ($ENV{'form.sel_'.$nfield} eq 'Default') {
$fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};
}
+ } elsif ($nfield eq 'insertrow') {
+ $countrows++;
+ if ($nform eq 'top') {
+ $fo{'A'.$countrows}='AAAAA_'.$countrows;
+ } else {
+ $fo{'A'.$countrows}='zzzzz_'.$countrows;
+ }
} else {
if ($nfield) { $fo{$nfield}=$nform; }
}
@@ -2264,17 +2415,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;
@@ -2312,8 +2454,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();
}
@@ -2325,6 +2467,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">'.
@@ -2541,12 +2689,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);