|
version 1.77, 2001/12/27 19:37:46
|
version 1.83, 2002/04/10 15:30:13
|
|
Line 1
|
Line 1
|
| |
# |
| |
# $Id$ |
| |
# |
| |
# Copyright Michigan State University Board of Trustees |
| |
# |
| |
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
| |
# |
| |
# LON-CAPA is free software; you can redistribute it and/or modify |
| |
# it under the terms of the GNU General Public License as published by |
| |
# the Free Software Foundation; either version 2 of the License, or |
| |
# (at your option) any later version. |
| |
# |
| |
# LON-CAPA is distributed in the hope that it will be useful, |
| |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
| |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| |
# GNU General Public License for more details. |
| |
# |
| |
# You should have received a copy of the GNU General Public License |
| |
# along with LON-CAPA; if not, write to the Free Software |
| |
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
| |
# |
| |
# /home/httpd/html/adm/gpl.txt |
| |
# |
| |
# http://www.lon-capa.org/ |
| |
# |
| # The LearningOnline Network with CAPA |
# The LearningOnline Network with CAPA |
| # Spreadsheet/Grades Display Handler |
# Spreadsheet/Grades Display Handler |
| # |
# |
|
Line 8
|
Line 33
|
| # 03/19,03/20,03/21,03/27,04/05,04/09, |
# 03/19,03/20,03/21,03/27,04/05,04/09, |
| # 07/09,07/14,07/21,09/01,09/10,9/11,9/12,9/13,9/14,9/17, |
# 07/09,07/14,07/21,09/01,09/10,9/11,9/12,9/13,9/14,9/17, |
| # 10/16,10/17,10/20,11/05,11/28,12/27 Gerd Kortemeyer |
# 10/16,10/17,10/20,11/05,11/28,12/27 Gerd Kortemeyer |
| |
# 01/14/02 Matthew |
| |
# 02/04/02 Matthew |
| |
|
| |
# POD required stuff: |
| |
|
| |
=head1 NAME |
| |
|
| |
lonspreadsheet |
| |
|
| |
=head1 SYNOPSIS |
| |
|
| |
Spreadsheet interface to internal LON-CAPA data |
| |
|
| |
=head1 DESCRIPTION |
| |
|
| |
Lonspreadsheet provides course coordinators the ability to manage their |
| |
students grades online. The students are able to view their own grades, but |
| |
not the grades of their peers. The spreadsheet is highly customizable, |
| |
offering the ability to use Perl code to manipulate data, as well as many |
| |
built-in functions. |
| |
|
| |
|
| |
=head2 Functions available to user of lonspreadsheet |
| |
|
| |
=over 4 |
| |
|
| |
=cut |
| |
|
| package Apache::lonspreadsheet; |
package Apache::lonspreadsheet; |
| |
|
|
Line 142 sub mask {
|
Line 194 sub mask {
|
| } else { |
} else { |
| if (length($ld)!=length($ud)) { |
if (length($ld)!=length($ud)) { |
| $num.='('; |
$num.='('; |
| map { |
foreach ($ld=~m/\d/g) { |
| $num.='['.$_.'-9]'; |
$num.='['.$_.'-9]'; |
| } ($ld=~m/\d/g); |
} |
| if (length($ud)-length($ld)>1) { |
if (length($ud)-length($ld)>1) { |
| $num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}'; |
$num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}'; |
| } |
} |
| $num.='|'; |
$num.='|'; |
| map { |
foreach ($ud=~m/\d/g) { |
| $num.='[0-'.$_.']'; |
$num.='[0-'.$_.']'; |
| } ($ud=~m/\d/g); |
} |
| $num.=')'; |
$num.=')'; |
| } else { |
} else { |
| my @lda=($ld=~m/\d/g); |
my @lda=($ld=~m/\d/g); |
|
Line 189 sub mask {
|
Line 241 sub mask {
|
| return '^'.$alpha.$num."\$"; |
return '^'.$alpha.$num."\$"; |
| } |
} |
| |
|
| |
#------------------------------------------------------- |
| |
|
| |
=item UWCALC(hashname,modules,units,date) |
| |
|
| |
returns the proportion of the module |
| |
weights not previously completed by the student. |
| |
|
| |
=over 4 |
| |
|
| |
=item hashname |
| |
|
| |
name of the hash the module dates have been inserted into |
| |
|
| |
=item modules |
| |
|
| |
reference to a cell which contains a comma deliminated list of modules |
| |
covered by the assignment. |
| |
|
| |
=item units |
| |
|
| |
reference to a cell which contains a comma deliminated list of module |
| |
weights with respect to the assignment |
| |
|
| |
=item date |
| |
|
| |
reference to a cell which contains the date the assignment was completed. |
| |
|
| |
=back |
| |
|
| |
=cut |
| |
|
| |
#------------------------------------------------------- |
| |
sub UWCALC { |
| |
my ($hashname,$modules,$units,$date) = @_; |
| |
my @Modules = split(/,/,$modules); |
| |
my @Units = split(/,/,$units); |
| |
my $total_weight; |
| |
foreach (@Units) { |
| |
$total_weight += $_; |
| |
} |
| |
my $usum=0; |
| |
for (my $i=0; $i<=$#Modules; $i++) { |
| |
if (&HASH($hashname,$Modules[$i]) eq $date) { |
| |
$usum += $Units[$i]; |
| |
} |
| |
} |
| |
return $usum/$total_weight; |
| |
} |
| |
|
| |
#------------------------------------------------------- |
| |
|
| |
=item CDLSUM(list) |
| |
|
| |
returns the sum of the elements in a cell which contains |
| |
a Comma Deliminate List of numerical values. |
| |
'list' is a reference to a cell which contains a comma deliminated list. |
| |
|
| |
=cut |
| |
|
| |
#------------------------------------------------------- |
| |
sub CDLSUM { |
| |
my ($list)=@_; |
| |
my $sum; |
| |
foreach (split/,/,$list) { |
| |
$sum += $_; |
| |
} |
| |
return $sum; |
| |
} |
| |
|
| |
#------------------------------------------------------- |
| |
|
| |
=item CDLITEM(list,index) |
| |
|
| |
returns the item at 'index' in a Comma Deliminated List. |
| |
|
| |
=over 4 |
| |
|
| |
=item list |
| |
|
| |
reference to a cell which contains a comma deliminated list. |
| |
|
| |
=item index |
| |
|
| |
the Perl index of the item requested (first element in list has |
| |
an index of 0) |
| |
|
| |
=back |
| |
|
| |
=cut |
| |
|
| |
#------------------------------------------------------- |
| |
sub CDLITEM { |
| |
my ($list,$index)=@_; |
| |
my @Temp = split/,/,$list; |
| |
return $Temp[$index]; |
| |
} |
| |
|
| |
#------------------------------------------------------- |
| |
|
| |
=item CDLHASH(name,key,value) |
| |
|
| |
loads a comma deliminated list of keys into |
| |
the hash 'name', all with a value of 'value'. |
| |
|
| |
=over 4 |
| |
|
| |
=item name |
| |
|
| |
name of the hash. |
| |
|
| |
=item key |
| |
|
| |
(a pointer to) a comma deliminated list of keys. |
| |
|
| |
=item value |
| |
|
| |
a single value to be entered for each key. |
| |
|
| |
=back |
| |
|
| |
=cut |
| |
|
| |
#------------------------------------------------------- |
| |
sub CDLHASH { |
| |
my ($name,$key,$value)=@_; |
| |
my @Keys; |
| |
my @Values; |
| |
# Check to see if we have multiple $key values |
| |
if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { |
| |
my $keymask = &mask($key); |
| |
# Assume the keys are addresses |
| |
my @Temp = grep /$keymask/,keys(%v); |
| |
@Keys = $v{@Temp}; |
| |
} else { |
| |
$Keys[0]= $key; |
| |
} |
| |
my @Temp; |
| |
foreach $key (@Keys) { |
| |
@Temp = (@Temp, split/,/,$key); |
| |
} |
| |
@Keys = @Temp; |
| |
if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { |
| |
my $valmask = &mask($value); |
| |
my @Temp = grep /$valmask/,keys(%v); |
| |
@Values =$v{@Temp}; |
| |
} else { |
| |
$Values[0]= $value; |
| |
} |
| |
$value = $Values[0]; |
| |
# Add values to hash |
| |
for (my $i = 0; $i<=$#Keys; $i++) { |
| |
my $key = $Keys[$i]; |
| |
if (! exists ($hashes{$name}->{$key})) { |
| |
$hashes{$name}->{$key}->[0]=$value; |
| |
} else { |
| |
my @Temp = sort(@{$hashes{$name}->{$key}},$value); |
| |
$hashes{$name}->{$key} = \@Temp; |
| |
} |
| |
} |
| |
return "hash '$name' updated"; |
| |
} |
| |
|
| |
#------------------------------------------------------- |
| |
|
| |
=item GETHASH(name,key,index) |
| |
|
| |
returns the element in hash 'name' |
| |
reference by the key 'key', at index 'index' in the values list. |
| |
|
| |
=cut |
| |
|
| |
#------------------------------------------------------- |
| |
sub GETHASH { |
| |
my ($name,$key,$index)=@_; |
| |
if (! defined($index)) { |
| |
$index = 0; |
| |
} |
| |
if ($key =~ /^[A-z]\d+$/) { |
| |
$key = $v{$key}; |
| |
} |
| |
return $hashes{$name}->{$key}->[$index]; |
| |
} |
| |
|
| |
#------------------------------------------------------- |
| |
|
| |
=item CLEARHASH(name) |
| |
|
| |
clears all the values from the hash 'name' |
| |
|
| |
=item CLEARHASH(name,key) |
| |
|
| |
clears all the values from the hash 'name' associated with the given key. |
| |
|
| |
=cut |
| |
|
| |
#------------------------------------------------------- |
| |
sub CLEARHASH { |
| |
my ($name,$key)=@_; |
| |
if (defined($key)) { |
| |
if (exists($hashes{$name}->{$key})) { |
| |
$hashes{$name}->{$key}=undef; |
| |
return "hash '$name' key '$key' cleared"; |
| |
} |
| |
} else { |
| |
if (exists($hashes{$name})) { |
| |
$hashes{$name}=undef; |
| |
return "hash '$name' cleared"; |
| |
} |
| |
} |
| |
return "Error in clearing hash"; |
| |
} |
| |
|
| |
#------------------------------------------------------- |
| |
|
| |
=item HASH(name,key,value) |
| |
|
| |
loads values into an internal hash. If a key |
| |
already has a value associated with it, the values are sorted numerically. |
| |
|
| |
=item HASH(name,key) |
| |
|
| |
returns the 0th value in the hash 'name' associated with 'key'. |
| |
|
| |
=cut |
| |
|
| |
#------------------------------------------------------- |
| |
sub HASH { |
| |
my ($name,$key,$value)=@_; |
| |
my @Keys; |
| |
undef @Keys; |
| |
my @Values; |
| |
# Check to see if we have multiple $key values |
| |
if ($key =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { |
| |
my $keymask = &mask($key); |
| |
# Assume the keys are addresses |
| |
my @Temp = grep /$keymask/,keys(%v); |
| |
@Keys = $v{@Temp}; |
| |
} else { |
| |
$Keys[0]= $key; |
| |
} |
| |
# If $value is empty, return the first value associated |
| |
# with the first key. |
| |
if (! $value) { |
| |
return $hashes{$name}->{$Keys[0]}->[0]; |
| |
} |
| |
# Check to see if we have multiple $value(s) |
| |
if ($value =~ /[A-z](\-[A-z])?\d+(\-\d+)?/) { |
| |
my $valmask = &mask($value); |
| |
my @Temp = grep /$valmask/,keys(%v); |
| |
@Values =$v{@Temp}; |
| |
} else { |
| |
$Values[0]= $value; |
| |
} |
| |
# Add values to hash |
| |
for (my $i = 0; $i<=$#Keys; $i++) { |
| |
my $key = $Keys[$i]; |
| |
my $value = ($i<=$#Values ? $Values[$i] : $Values[0]); |
| |
if (! exists ($hashes{$name}->{$key})) { |
| |
$hashes{$name}->{$key}->[0]=$value; |
| |
} else { |
| |
my @Temp = sort(@{$hashes{$name}->{$key}},$value); |
| |
$hashes{$name}->{$key} = \@Temp; |
| |
} |
| |
} |
| |
return $Values[-1]; |
| |
} |
| |
|
| sub NUM { |
sub NUM { |
| my $mask=mask(@_); |
my $mask=mask(@_); |
| my $num=0; |
my $num= $#{@{grep(/$mask/,keys(%v))}}+1; |
| map { |
|
| $num++; |
|
| } grep /$mask/,keys %v; |
|
| return $num; |
return $num; |
| } |
} |
| |
|
|
Line 202 sub BIN {
|
Line 518 sub BIN {
|
| my ($low,$high,$lower,$upper)=@_; |
my ($low,$high,$lower,$upper)=@_; |
| my $mask=mask($lower,$upper); |
my $mask=mask($lower,$upper); |
| my $num=0; |
my $num=0; |
| map { |
foreach (grep /$mask/,keys(%v)) { |
| if (($v{$_}>=$low) && ($v{$_}<=$high)) { |
if (($v{$_}>=$low) && ($v{$_}<=$high)) { |
| $num++; |
$num++; |
| } |
} |
| } grep /$mask/,keys %v; |
} |
| return $num; |
return $num; |
| } |
} |
| |
|
|
Line 214 sub BIN {
|
Line 530 sub BIN {
|
| sub SUM { |
sub SUM { |
| my $mask=mask(@_); |
my $mask=mask(@_); |
| my $sum=0; |
my $sum=0; |
| map { |
foreach (grep /$mask/,keys(%v)) { |
| $sum+=$v{$_}; |
$sum+=$v{$_}; |
| } grep /$mask/,keys %v; |
} |
| return $sum; |
return $sum; |
| } |
} |
| |
|
| sub MEAN { |
sub MEAN { |
| my $mask=mask(@_); |
my $mask=mask(@_); |
| my $sum=0; my $num=0; |
my $sum=0; my $num=0; |
| map { |
foreach (grep /$mask/,keys(%v)) { |
| $sum+=$v{$_}; |
$sum+=$v{$_}; |
| $num++; |
$num++; |
| } grep /$mask/,keys %v; |
} |
| if ($num) { |
if ($num) { |
| return $sum/$num; |
return $sum/$num; |
| } else { |
} else { |
|
Line 237 sub MEAN {
|
Line 553 sub MEAN {
|
| sub STDDEV { |
sub STDDEV { |
| my $mask=mask(@_); |
my $mask=mask(@_); |
| my $sum=0; my $num=0; |
my $sum=0; my $num=0; |
| map { |
foreach (grep /$mask/,keys(%v)) { |
| $sum+=$v{$_}; |
$sum+=$v{$_}; |
| $num++; |
$num++; |
| } grep /$mask/,keys %v; |
} |
| unless ($num>1) { return undef; } |
unless ($num>1) { return undef; } |
| my $mean=$sum/$num; |
my $mean=$sum/$num; |
| $sum=0; |
$sum=0; |
| map { |
foreach (grep /$mask/,keys(%v)) { |
| $sum+=($v{$_}-$mean)**2; |
$sum+=($v{$_}-$mean)**2; |
| } grep /$mask/,keys %v; |
} |
| return sqrt($sum/($num-1)); |
return sqrt($sum/($num-1)); |
| } |
} |
| |
|
| sub PROD { |
sub PROD { |
| my $mask=mask(@_); |
my $mask=mask(@_); |
| my $prod=1; |
my $prod=1; |
| map { |
foreach (grep /$mask/,keys(%v)) { |
| $prod*=$v{$_}; |
$prod*=$v{$_}; |
| } grep /$mask/,keys %v; |
} |
| return $prod; |
return $prod; |
| } |
} |
| |
|
| sub MAX { |
sub MAX { |
| my $mask=mask(@_); |
my $mask=mask(@_); |
| my $max='-'; |
my $max='-'; |
| map { |
foreach (grep /$mask/,keys(%v)) { |
| unless ($max) { $max=$v{$_}; } |
unless ($max) { $max=$v{$_}; } |
| if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; } |
if (($v{$_}>$max) || ($max eq '-')) { $max=$v{$_}; } |
| } grep /$mask/,keys %v; |
} |
| return $max; |
return $max; |
| } |
} |
| |
|
| sub MIN { |
sub MIN { |
| my $mask=mask(@_); |
my $mask=mask(@_); |
| my $min='-'; |
my $min='-'; |
| map { |
foreach (grep /$mask/,keys(%v)) { |
| unless ($max) { $max=$v{$_}; } |
unless ($max) { $max=$v{$_}; } |
| if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; } |
if (($v{$_}<$min) || ($min eq '-')) { $min=$v{$_}; } |
| } grep /$mask/,keys %v; |
} |
| return $min; |
return $min; |
| } |
} |
| |
|
|
Line 283 sub SUMMAX {
|
Line 599 sub SUMMAX {
|
| my ($num,$lower,$upper)=@_; |
my ($num,$lower,$upper)=@_; |
| my $mask=mask($lower,$upper); |
my $mask=mask($lower,$upper); |
| my @inside=(); |
my @inside=(); |
| map { |
foreach (grep /$mask/,keys(%v)) { |
| $inside[$#inside+1]=$v{$_}; |
$inside[$#inside+1]=$v{$_}; |
| } grep /$mask/,keys %v; |
} |
| @inside=sort(@inside); |
@inside=sort(@inside); |
| my $sum=0; my $i; |
my $sum=0; my $i; |
| for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { |
for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) { |
|
Line 298 sub SUMMIN {
|
Line 614 sub SUMMIN {
|
| my ($num,$lower,$upper)=@_; |
my ($num,$lower,$upper)=@_; |
| my $mask=mask($lower,$upper); |
my $mask=mask($lower,$upper); |
| my @inside=(); |
my @inside=(); |
| map { |
foreach (grep /$mask/,keys(%v)) { |
| $inside[$#inside+1]=$v{$_}; |
$inside[$#inside+1]=$v{$_}; |
| } grep /$mask/,keys %v; |
} |
| @inside=sort(@inside); |
@inside=sort(@inside); |
| my $sum=0; my $i; |
my $sum=0; my $i; |
| for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { |
for ($i=0;(($i<$num) && ($i<=$#inside));$i++) { |
|
Line 316 sub expandnamed {
|
Line 632 sub expandnamed {
|
| my @vars=split(/\W+/,$formula); |
my @vars=split(/\W+/,$formula); |
| my %values=(); |
my %values=(); |
| undef %values; |
undef %values; |
| map { |
foreach ( @vars ) { |
| my $varname=$_; |
my $varname=$_; |
| if ($varname=~/\D/) { |
if ($varname=~/\D/) { |
| $formula=~s/$varname/'$c{\''.$varname.'\'}'/ge; |
$formula=~s/$varname/'$c{\''.$varname.'\'}'/ge; |
| $varname=~s/$var/\(\\w\+\)/g; |
$varname=~s/$var/\(\\w\+\)/g; |
| map { |
foreach (keys(%c)) { |
| if ($_=~/$varname/) { |
if ($_=~/$varname/) { |
| $values{$1}=1; |
$values{$1}=1; |
| } |
} |
| } keys %c; |
} |
| } |
} |
| } @vars; |
} |
| if ($func eq 'EXPANDSUM') { |
if ($func eq 'EXPANDSUM') { |
| my $result=''; |
my $result=''; |
| map { |
foreach (keys(%values)) { |
| my $thissum=$formula; |
my $thissum=$formula; |
| $thissum=~s/$var/$_/g; |
$thissum=~s/$var/$_/g; |
| $result.=$thissum.'+'; |
$result.=$thissum.'+'; |
| } keys %values; |
} |
| $result=~s/\+$//; |
$result=~s/\+$//; |
| return $result; |
return $result; |
| } else { |
} else { |
|
Line 353 sub sett {
|
Line 669 sub sett {
|
| } else { |
} else { |
| $pattern='[A-Z]'; |
$pattern='[A-Z]'; |
| } |
} |
| map { |
foreach (keys(%f)) { |
| if ($_=~/template\_(\w)/) { |
if ($_=~/template\_(\w)/) { |
| my $col=$1; |
my $col=$1; |
| unless ($col=~/^$pattern/) { |
unless ($col=~/^$pattern/) { |
| map { |
foreach (keys(%f)) { |
| if ($_=~/A(\d+)/) { |
if ($_=~/A(\d+)/) { |
| my $trow=$1; |
my $trow=$1; |
| if ($trow) { |
if ($trow) { |
|
Line 369 sub sett {
|
Line 685 sub sett {
|
| $t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; |
$t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; |
| } |
} |
| } |
} |
| } keys %f; |
} |
| } |
} |
| } |
} |
| } keys %f; |
} |
| map { |
foreach (keys(%f)) { |
| if (($f{$_}) && ($_!~/template\_/)) { |
if (($f{$_}) && ($_!~/template\_/)) { |
| my $matches=($_=~/^$pattern(\d+)/); |
my $matches=($_=~/^$pattern(\d+)/); |
| if (($matches) && ($1)) { |
if (($matches) && ($1)) { |
|
Line 387 sub sett {
|
Line 703 sub sett {
|
| $t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; |
$t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.&expandnamed($2)/ge; |
| } |
} |
| } |
} |
| } keys %f; |
} |
| $t{'A0'}=$f{'A0'}; |
$t{'A0'}=$f{'A0'}; |
| $t{'A0'}=~s/\.\.+/\,/g; |
$t{'A0'}=~s/\.\.+/\,/g; |
| $t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g; |
$t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$v\{\'$2\'\}/g; |
|
Line 401 sub calc {
|
Line 717 sub calc {
|
| my $depth=0; |
my $depth=0; |
| while ($notfinished) { |
while ($notfinished) { |
| $notfinished=0; |
$notfinished=0; |
| map { |
foreach (keys(%t)) { |
| my $old=$v{$_}; |
my $old=$v{$_}; |
| $v{$_}=eval($t{$_}); |
$v{$_}=eval($t{$_}); |
| if ($@) { |
if ($@) { |
|
Line 409 sub calc {
|
Line 725 sub calc {
|
| return $@; |
return $@; |
| } |
} |
| if ($v{$_} ne $old) { $notfinished=1; } |
if ($v{$_} ne $old) { $notfinished=1; } |
| } keys %t; |
} |
| $depth++; |
$depth++; |
| if ($depth>100) { |
if ($depth>100) { |
| %v=(); |
%v=(); |
|
Line 422 sub calc {
|
Line 738 sub calc {
|
| sub templaterow { |
sub templaterow { |
| my @cols=(); |
my @cols=(); |
| $cols[0]='<b><font size=+1>Template</font></b>'; |
$cols[0]='<b><font size=+1>Template</font></b>'; |
| map { |
foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
| |
'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', |
| |
'a','b','c','d','e','f','g','h','i','j','k','l','m', |
| |
'n','o','p','q','r','s','t','u','v','w','x','y','z') { |
| my $fm=$f{'template_'.$_}; |
my $fm=$f{'template_'.$_}; |
| $fm=~s/[\'\"]/\&\#34;/g; |
$fm=~s/[\'\"]/\&\#34;/g; |
| $cols[$#cols+1]="'template_$_','$fm'".'___eq___'.$fm; |
$cols[$#cols+1]="'template_$_','$fm'".'___eq___'.$fm; |
| } ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
} |
| 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', |
|
| 'a','b','c','d','e','f','g','h','i','j','k','l','m', |
|
| 'n','o','p','q','r','s','t','u','v','w','x','y','z'); |
|
| return @cols; |
return @cols; |
| } |
} |
| |
|
|
Line 441 sub outrowassess {
|
Line 757 sub outrowassess {
|
| $cols[0]=$rl{$usy}.'<br>'. |
$cols[0]=$rl{$usy}.'<br>'. |
| '<select name="sel_'.$n.'" onChange="changesheet('.$n. |
'<select name="sel_'.$n.'" onChange="changesheet('.$n. |
| ')"><option name="default">Default</option>'; |
')"><option name="default">Default</option>'; |
| map { |
foreach (@os) { |
| $cols[0].='<option name="'.$_.'"'; |
$cols[0].='<option name="'.$_.'"'; |
| if ($ufn eq $_) { |
if ($ufn eq $_) { |
| $cols[0].=' selected'; |
$cols[0].=' selected'; |
| } |
} |
| $cols[0].='>'.$_.'</option>'; |
$cols[0].='>'.$_.'</option>'; |
| } @os; |
} |
| $cols[0].='</select>'; |
$cols[0].='</select>'; |
| } else { |
} else { |
| $cols[0]='<b><font size=+1>Export</font></b>'; |
$cols[0]='<b><font size=+1>Export</font></b>'; |
| } |
} |
| map { |
foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
| |
'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', |
| |
'a','b','c','d','e','f','g','h','i','j','k','l','m', |
| |
'n','o','p','q','r','s','t','u','v','w','x','y','z') { |
| my $fm=$f{$_.$n}; |
my $fm=$f{$_.$n}; |
| $fm=~s/[\'\"]/\&\#34;/g; |
$fm=~s/[\'\"]/\&\#34;/g; |
| $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n}; |
push(@cols,"'$_$n','$fm'".'___eq___'.$v{$_.$n}); |
| } ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
} |
| 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', |
|
| 'a','b','c','d','e','f','g','h','i','j','k','l','m', |
|
| 'n','o','p','q','r','s','t','u','v','w','x','y','z'); |
|
| return @cols; |
return @cols; |
| } |
} |
| |
|
|
Line 471 sub outrow {
|
Line 787 sub outrow {
|
| } else { |
} else { |
| $cols[0]='<b><font size=+1>Export</font></b>'; |
$cols[0]='<b><font size=+1>Export</font></b>'; |
| } |
} |
| map { |
foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
| |
'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', |
| |
'a','b','c','d','e','f','g','h','i','j','k','l','m', |
| |
'n','o','p','q','r','s','t','u','v','w','x','y','z') { |
| my $fm=$f{$_.$n}; |
my $fm=$f{$_.$n}; |
| $fm=~s/[\'\"]/\&\#34;/g; |
$fm=~s/[\'\"]/\&\#34;/g; |
| $cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n}; |
$cols[$#cols+1]="'$_$n','$fm'".'___eq___'.$v{$_.$n}; |
| } ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
} |
| 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', |
|
| 'a','b','c','d','e','f','g','h','i','j','k','l','m', |
|
| 'n','o','p','q','r','s','t','u','v','w','x','y','z'); |
|
| return @cols; |
return @cols; |
| } |
} |
| |
|
| sub exportrowa { |
sub exportrowa { |
| my @exportarray=(); |
my @exportarray=(); |
| map { |
foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
| |
'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { |
| $exportarray[$#exportarray+1]=$v{$_.'0'}; |
$exportarray[$#exportarray+1]=$v{$_.'0'}; |
| } ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
} |
| 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'); |
|
| return @exportarray; |
return @exportarray; |
| } |
} |
| |
|
|
Line 698 sub rown {
|
Line 1014 sub rown {
|
| $maxred=26; |
$maxred=26; |
| } |
} |
| if ($n eq '-') { $proc='&templaterow'; $n=-1; $dataflag=1; } |
if ($n eq '-') { $proc='&templaterow'; $n=-1; $dataflag=1; } |
| map { |
foreach ($safeeval->reval($proc.'('.$n.')')) { |
| my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD'); |
my $bgcolor=$defaultbg.((($showf-1)/5==int(($showf-1)/5))?'99':'DD'); |
| my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_); |
my ($fm,$vl)=split(/\_\_\_eq\_\_\_/,$_); |
| if ((($vl ne '') || ($vl eq '0')) && |
if ((($vl ne '') || ($vl eq '0')) && |
|
Line 721 sub rown {
|
Line 1037 sub rown {
|
| $rowdata.=',"'.$vl.'"'; |
$rowdata.=',"'.$vl.'"'; |
| } |
} |
| $showf++; |
$showf++; |
| } $safeeval->reval($proc.'('.$n.')'); |
} # End of foreach($safeval...) |
| if ($ENV{'form.showall'} || ($dataflag)) { |
if ($ENV{'form.showall'} || ($dataflag)) { |
| return $rowdata.($ENV{'form.showcsv'}?'':'</tr>'); |
return $rowdata.($ENV{'form.showcsv'}?'':'</tr>'); |
| } else { |
} else { |
|
Line 756 sub outsheet {
|
Line 1072 sub outsheet {
|
| '<td colspan='.$maxyellow. |
'<td colspan='.$maxyellow. |
| '><b><font size=+1>Calculations</font></b></td></tr><tr>'; |
'><b><font size=+1>Calculations</font></b></td></tr><tr>'; |
| my $showf=0; |
my $showf=0; |
| map { |
foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
| |
'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', |
| |
'a','b','c','d','e','f','g','h','i','j','k','l','m', |
| |
'n','o','p','q','r','s','t','u','v','w','x','y','z') { |
| $showf++; |
$showf++; |
| if ($showf<=$maxred) { |
if ($showf<=$maxred) { |
| $tabledata.='<td bgcolor="#FFDDDD">'; |
$tabledata.='<td bgcolor="#FFDDDD">'; |
|
Line 764 sub outsheet {
|
Line 1083 sub outsheet {
|
| $tabledata.='<td>'; |
$tabledata.='<td>'; |
| } |
} |
| $tabledata.="<b><font size=+1>$_</font></b></td>"; |
$tabledata.="<b><font size=+1>$_</font></b></td>"; |
| } ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
} |
| 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', |
|
| 'a','b','c','d','e','f','g','h','i','j','k','l','m', |
|
| 'n','o','p','q','r','s','t','u','v','w','x','y','z'); |
|
| $tabledata.='</tr>'.&rown($safeeval,'-').&rown($safeeval,0); |
$tabledata.='</tr>'.&rown($safeeval,'-').&rown($safeeval,0); |
| } else { $tabledata='<pre>'; } |
} else { $tabledata='<pre>'; } |
| |
|
|
Line 799 sub outsheet {
|
Line 1115 sub outsheet {
|
| $r->print("</table>\n<br>\n"); |
$r->print("</table>\n<br>\n"); |
| $r->rflush(); |
$r->rflush(); |
| $r->print('<table border=2><tr><td> <td>'.$what.'</td>'); |
$r->print('<table border=2><tr><td> <td>'.$what.'</td>'); |
| map { |
foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
| |
'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', |
| |
'a','b','c','d','e','f','g','h','i','j','k','l','m', |
| |
'n','o','p','q','r','s','t','u','v','w','x','y','z') { |
| $r->print('<td>'.$_.'</td>'); |
$r->print('<td>'.$_.'</td>'); |
| } ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
} |
| 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z', |
|
| 'a','b','c','d','e','f','g','h','i','j','k','l','m', |
|
| 'n','o','p','q','r','s','t','u','v','w','x','y','z'); |
|
| $r->print('</tr>'); |
$r->print('</tr>'); |
| } |
} |
| $n++; |
$n++; |
|
Line 817 sub outsheet {
|
Line 1133 sub outsheet {
|
| # |
# |
| # ----------------------------------------------- Read list of available sheets |
# ----------------------------------------------- Read list of available sheets |
| # |
# |
| |
|
| sub othersheets { |
sub othersheets { |
| my ($safeeval,$stype)=@_; |
my ($safeeval,$stype)=@_; |
| |
# |
| my $cnum=&getcnum($safeeval); |
my $cnum=&getcnum($safeeval); |
| my $cdom=&getcdom($safeeval); |
my $cdom=&getcdom($safeeval); |
| my $chome=&getchome($safeeval); |
my $chome=&getchome($safeeval); |
| |
# |
| my @alternatives=(); |
my @alternatives=(); |
| my $result=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'. |
my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum); |
| $stype.'_spreadsheets',$chome); |
my ($tmp) = keys(%results); |
| if ($result!~/^error\:/) { |
unless ($tmp =~ /^(con_lost|error|no_such_host)/i) { |
| map { |
@alternatives = sort (keys(%results)); |
| $alternatives[$#alternatives+1]= |
} |
| &Apache::lonnet::unescape((split(/\=/,$_))[0]); |
|
| } split(/\&/,$result); |
|
| } |
|
| return @alternatives; |
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 |
# -------------------------------------- Read spreadsheet formulas for a course |
| # |
# |
|
Line 848 sub readsheet {
|
Line 1189 sub readsheet {
|
| my $cdom=&getcdom($safeeval); |
my $cdom=&getcdom($safeeval); |
| my $chome=&getchome($safeeval); |
my $chome=&getchome($safeeval); |
| |
|
| # --------- There is no filename. Look for defaults in course and global, cache |
if (! defined($fn)) { |
| |
# There is no filename. Look for defaults in course and global, cache |
| unless($fn) { |
|
| unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) { |
unless ($fn=$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}) { |
| $fn=&Apache::lonnet::reply('get:'.$cdom.':'.$cnum. |
my %tmphash = &Apache::lonnet::get('environment', |
| ':environment:spreadsheet_default_'.$stype, |
['spreadsheet_default_'.$stype], |
| $chome); |
$cdom,$cnum); |
| unless (($fn) && ($fn!~/^error\:/)) { |
my ($tmp) = keys(%tmphash); |
| $fn='default_'.$stype; |
if ($tmp =~ /^(con_lost|error|no_such_host)/i) { |
| } |
$fn = 'default_'.$stype; |
| $defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; |
} else { |
| |
$fn = $tmphash{'spreadsheet_default_'.$stype}; |
| |
} |
| |
$defaultsheets{$cnum.'_'.$cdom.'_'.$stype}=$fn; |
| } |
} |
| } |
} |
| |
|
|
Line 877 sub readsheet {
|
Line 1220 sub readsheet {
|
| my %f=(); |
my %f=(); |
| |
|
| if ($fn=~/^default\_/) { |
if ($fn=~/^default\_/) { |
| my $sheetxml=''; |
my $sheetxml=''; |
| { |
|
| my $fh; |
my $fh; |
| my $dfn=$fn; |
my $dfn=$fn; |
| $dfn=~s/\_/\./g; |
$dfn=~s/\_/\./g; |
| if ($fh=Apache::File->new($includedir.'/'.$dfn)) { |
if ($fh=Apache::File->new($includedir.'/'.$dfn)) { |
| $sheetxml=join('',<$fh>); |
$sheetxml=join('',<$fh>); |
| } else { |
} else { |
| $sheetxml='<field row="0" col="A">"Error"</field>'; |
$sheetxml='<field row="0" col="A">"Error"</field>'; |
| } |
} |
| } |
%f=%{&parse_sheet(\$sheetxml)}; |
| my $parser=HTML::TokeParser->new(\$sheetxml); |
} elsif($fn=~/\/*\.spreadsheet$/) { |
| my $token; |
my $sheetxml=&Apache::lonnet::getfile |
| while ($token=$parser->get_token) { |
(&Apache::lonnet::filelocation('',$fn)); |
| if ($token->[0] eq 'S') { |
print "<pre>$sheetxml</pre>"; |
| if ($token->[1] eq 'field') { |
if ($sheetxml == -1) { |
| $f{$token->[2]->{'col'}.$token->[2]->{'row'}}= |
$sheetxml='<field row="0" col="A">"Error loading spreadsheet ' |
| $parser->get_text('/field'); |
.$fn.'"</field>'; |
| } |
} |
| if ($token->[1] eq 'template') { |
%f=%{&parse_sheet(\$sheetxml)}; |
| $f{'template_'.$token->[2]->{'col'}}= |
print "<pre>"; |
| $parser->get_text('/template'); |
foreach (sort( keys(%f))) { |
| |
print "$_ = $f{$_}\n"; |
| |
} |
| |
print "</pre>"; |
| |
} 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 $reply=&Apache::lonnet::reply('dump:'.$cdom.':'.$cnum.':'.$fn, |
|
| $chome); |
|
| unless ($reply=~/^error\:/) { |
|
| $sheet=$reply; |
|
| } |
|
| map { |
|
| my ($name,$value)=split(/\=/,$_); |
|
| $f{&Apache::lonnet::unescape($name)}= |
|
| &Apache::lonnet::unescape($value); |
|
| } split(/\&/,$sheet); |
|
| } |
|
| # --------------------------------------------------------------- Cache and set |
# --------------------------------------------------------------- Cache and set |
| $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); |
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); |
| &setformulas($safeeval,%f); |
&setformulas($safeeval,%f); |
|
Line 959 sub writesheet {
|
Line 1298 sub writesheet {
|
| $spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); |
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f); |
| # ----------------------------------------------------------------- Write sheet |
# ----------------------------------------------------------------- Write sheet |
| my $sheetdata=''; |
my $sheetdata=''; |
| map { |
foreach (keys(%f)) { |
| unless ($f{$_} eq 'import') { |
unless ($f{$_} eq 'import') { |
| $sheetdata.=&Apache::lonnet::escape($_).'='. |
$sheetdata.=&Apache::lonnet::escape($_).'='. |
| &Apache::lonnet::escape($f{$_}).'&'; |
&Apache::lonnet::escape($f{$_}).'&'; |
| } |
} |
| } keys %f; |
} |
| $sheetdata=~s/\&$//; |
$sheetdata=~s/\&$//; |
| my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'. |
my $reply=&Apache::lonnet::reply('put:'.$cdom.':'.$cnum.':'.$fn.':'. |
| $sheetdata,$chome); |
$sheetdata,$chome); |
|
Line 1145 sub updateclasssheet {
|
Line 1484 sub updateclasssheet {
|
| my %currentlist=(); |
my %currentlist=(); |
| my $now=time; |
my $now=time; |
| unless ($classlst=~/^error\:/) { |
unless ($classlst=~/^error\:/) { |
| map { |
foreach (split(/\&/,$classlst)) { |
| my ($name,$value)=split(/\=/,$_); |
my ($name,$value)=split(/\=/,$_); |
| my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value)); |
my ($end,$start)=split(/\:/,&Apache::lonnet::unescape($value)); |
| my $active=1; |
my $active=1; |
|
Line 1172 sub updateclasssheet {
|
Line 1511 sub updateclasssheet {
|
| $rowlabel='<a href="/adm/studentcalc?uname='.$sname. |
$rowlabel='<a href="/adm/studentcalc?uname='.$sname. |
| '&udom='.$sdom.'">'. |
'&udom='.$sdom.'">'. |
| $ssec.' '.$reply{$sname}.'<br>'; |
$ssec.' '.$reply{$sname}.'<br>'; |
| map { |
foreach ( split(/\&/,$reply)) { |
| $rowlabel.=&Apache::lonnet::unescape($_).' '; |
$rowlabel.=&Apache::lonnet::unescape($_).' '; |
| } split(/\&/,$reply); |
} |
| $rowlabel.='</a>'; |
$rowlabel.='</a>'; |
| } else { |
} else { |
| $rowlabel=$ssec.'","'.$reply{$sname}.'"'; |
$rowlabel=$ssec.'","'.$reply{$sname}.'"'; |
| my $ncount=0; |
my $ncount=0; |
| map { |
foreach (split(/\&/,$reply)) { |
| $rowlabel.=',"'.&Apache::lonnet::unescape($_).'"'; |
$rowlabel.=',"'.&Apache::lonnet::unescape($_).'"'; |
| $ncount++; |
$ncount++; |
| } split(/\&/,$reply); |
} |
| unless ($ncount==4) { $rowlabel.=',""'; } |
unless ($ncount==4) { $rowlabel.=',""'; } |
| $rowlabel=~s/\"$//; |
$rowlabel=~s/\"$//; |
| } |
} |
| } |
} |
| $currentlist{&Apache::lonnet::unescape($name)}=$rowlabel; |
$currentlist{&Apache::lonnet::unescape($name)}=$rowlabel; |
| } |
} |
| } split(/\&/,$classlst); |
} # end of foreach (split(/\&/,$classlst)) |
| # |
# |
| # -------------------- Find discrepancies between the course row table and this |
# -------------------- Find discrepancies between the course row table and this |
| # |
# |
|
Line 1200 sub updateclasssheet {
|
Line 1539 sub updateclasssheet {
|
| my %existing=(); |
my %existing=(); |
| |
|
| # ----------------------------------------------------------- Now obsolete rows |
# ----------------------------------------------------------- Now obsolete rows |
| map { |
foreach (keys(%f)) { |
| if ($_=~/^A(\d+)/) { |
if ($_=~/^A(\d+)/) { |
| $maxrow=($1>$maxrow)?$1:$maxrow; |
$maxrow=($1>$maxrow)?$1:$maxrow; |
| $existing{$f{$_}}=1; |
$existing{$f{$_}}=1; |
|
Line 1209 sub updateclasssheet {
|
Line 1548 sub updateclasssheet {
|
| $changed=1; |
$changed=1; |
| } |
} |
| } |
} |
| } keys %f; |
} |
| |
|
| # -------------------------------------------------------- New and unknown keys |
# -------------------------------------------------------- New and unknown keys |
| |
|
| map { |
foreach (sort keys(%currentlist)) { |
| unless ($existing{$_}) { |
unless ($existing{$_}) { |
| $changed=1; |
$changed=1; |
| $maxrow++; |
$maxrow++; |
| $f{'A'.$maxrow}=$_; |
$f{'A'.$maxrow}=$_; |
| } |
} |
| } sort keys %currentlist; |
} |
| |
|
| if ($changed) { &setformulas($safeeval,%f); } |
if ($changed) { &setformulas($safeeval,%f); } |
| |
|
|
Line 1274 sub updatestudentassesssheet {
|
Line 1613 sub updatestudentassesssheet {
|
| '">Discussion</a>' |
'">Discussion</a>' |
| ); |
); |
| |
|
| map { |
foreach (keys(%bighash)) { |
| if ($_=~/^src\_(\d+)\.(\d+)$/) { |
if ($_=~/^src\_(\d+)\.(\d+)$/) { |
| my $mapid=$1; |
my $mapid=$1; |
| my $resid=$2; |
my $resid=$2; |
|
Line 1289 sub updatestudentassesssheet {
|
Line 1628 sub updatestudentassesssheet {
|
| '<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'. |
'<a href="/adm/assesscalc?usymb='.$symb.$adduserstr.'">'. |
| $bighash{'title_'.$id}.'</a>'; |
$bighash{'title_'.$id}.'</a>'; |
| if ($stype eq 'assesscalc') { |
if ($stype eq 'assesscalc') { |
| map { |
foreach (split(/\,/, |
| |
&Apache::lonnet::metadata($srcf,'keys'))) { |
| if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) { |
if (($_=~/^stores\_(.*)/) || ($_=~/^parameter\_(.*)/)) { |
| my $key=$_; |
my $key=$_; |
| my $display= |
my $display= |
|
Line 1301 sub updatestudentassesssheet {
|
Line 1641 sub updatestudentassesssheet {
|
| $display.='<br>'.$key; |
$display.='<br>'.$key; |
| $allkeys{$key}=$display; |
$allkeys{$key}=$display; |
| } |
} |
| } split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); |
} # end of foreach |
| } |
} |
| } |
} |
| } |
} |
| } keys %bighash; |
} # end of foreach (keys(%bighash)) |
| untie(%bighash); |
untie(%bighash); |
| |
|
| # |
# |
|
Line 1337 sub updatestudentassesssheet {
|
Line 1677 sub updatestudentassesssheet {
|
| my %existing=(); |
my %existing=(); |
| |
|
| # ----------------------------------------------------------- Now obsolete rows |
# ----------------------------------------------------------- Now obsolete rows |
| map { |
foreach (keys(%f)) { |
| if ($_=~/^A(\d+)/) { |
if ($_=~/^A(\d+)/) { |
| $maxrow=($1>$maxrow)?$1:$maxrow; |
$maxrow=($1>$maxrow)?$1:$maxrow; |
| my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_}); |
my ($usy,$ufn)=split(/\_\_\&\&\&\_\_/,$f{$_}); |
|
Line 1350 sub updatestudentassesssheet {
|
Line 1690 sub updatestudentassesssheet {
|
| =~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/; |
=~s/assesscalc\?usymb\=/assesscalc\?ufn\=$ufn\&usymb\=/; |
| } |
} |
| } |
} |
| } keys %f; |
} |
| |
|
| # -------------------------------------------------------- New and unknown keys |
# -------------------------------------------------------- New and unknown keys |
| |
|
| map { |
foreach (keys(%current)) { |
| unless ($existing{$_}) { |
unless ($existing{$_}) { |
| $changed=1; |
$changed=1; |
| $maxrow++; |
$maxrow++; |
| $f{'A'.$maxrow}=$_; |
$f{'A'.$maxrow}=$_; |
| } |
} |
| } keys %current; |
} |
| |
|
| if ($changed) { &setformulas($safeeval,%f); } |
if ($changed) { &setformulas($safeeval,%f); } |
| |
|
|
Line 1385 sub loadstudent {
|
Line 1725 sub loadstudent {
|
| &getcid($safeeval), |
&getcid($safeeval), |
| &getuhome($safeeval)); |
&getuhome($safeeval)); |
| unless ($reply=~/^error\:/) { |
unless ($reply=~/^error\:/) { |
| map { |
foreach ( split(/\&/,$reply)) { |
| my ($name,$value)=split(/\=/,$_); |
my ($name,$value)=split(/\=/,$_); |
| $cachedstores{&Apache::lonnet::unescape($name)}= |
$cachedstores{&Apache::lonnet::unescape($name)}= |
| &Apache::lonnet::unescape($value); |
&Apache::lonnet::unescape($value); |
| } split(/\&/,$reply); |
} |
| } |
} |
| } |
} |
| my @assessdata=(); |
my @assessdata=(); |
| map { |
foreach (keys(%f)) { |
| if ($_=~/^A(\d+)/) { |
if ($_=~/^A(\d+)/) { |
| my $row=$1; |
my $row=$1; |
| unless (($f{$_}=~/^\!/) || ($row==0)) { |
unless (($f{$_}=~/^\!/) || ($row==0)) { |
|
Line 1402 sub loadstudent {
|
Line 1742 sub loadstudent {
|
| &getudom($safeeval), |
&getudom($safeeval), |
| 'assesscalc',$usy,$ufn); |
'assesscalc',$usy,$ufn); |
| my $index=0; |
my $index=0; |
| map { |
foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
| |
'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { |
| if ($assessdata[$index]) { |
if ($assessdata[$index]) { |
| my $col=$_; |
my $col=$_; |
| if ($assessdata[$index]=~/\D/) { |
if ($assessdata[$index]=~/\D/) { |
|
Line 1415 sub loadstudent {
|
Line 1756 sub loadstudent {
|
| } |
} |
| } |
} |
| $index++; |
$index++; |
| } ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
} |
| 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'); |
|
| } |
} |
| } |
} |
| } keys %f; |
} |
| $cachedassess=''; |
$cachedassess=''; |
| undef %cachedstores; |
undef %cachedstores; |
| &setformulas($safeeval,%f); |
&setformulas($safeeval,%f); |
|
Line 1433 sub loadcourse {
|
Line 1773 sub loadcourse {
|
| my %c=(); |
my %c=(); |
| my %f=&getformulas($safeeval); |
my %f=&getformulas($safeeval); |
| my $total=0; |
my $total=0; |
| map { |
foreach (keys(%f)) { |
| if ($_=~/^A(\d+)/) { |
if ($_=~/^A(\d+)/) { |
| unless ($f{$_}=~/^\!/) { $total++; } |
unless ($f{$_}=~/^\!/) { $total++; } |
| } |
} |
| } keys %f; |
} |
| my $now=0; |
my $now=0; |
| my $since=time; |
my $since=time; |
| $r->print(<<ENDPOP); |
$r->print(<<ENDPOP); |
|
Line 1452 sub loadcourse {
|
Line 1792 sub loadcourse {
|
| </script> |
</script> |
| ENDPOP |
ENDPOP |
| $r->rflush(); |
$r->rflush(); |
| map { |
foreach (keys(%f)) { |
| if ($_=~/^A(\d+)/) { |
if ($_=~/^A(\d+)/) { |
| my $row=$1; |
my $row=$1; |
| unless (($f{$_}=~/^\!/) || ($row==0)) { |
unless (($f{$_}=~/^\!/) || ($row==0)) { |
|
Line 1466 ENDPOP
|
Line 1806 ENDPOP
|
| $r->rflush(); |
$r->rflush(); |
| |
|
| my $index=0; |
my $index=0; |
| map { |
foreach ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
| |
'N','O','P','Q','R','S','T','U','V','W','X','Y','Z') { |
| if ($studentdata[$index]) { |
if ($studentdata[$index]) { |
| my $col=$_; |
my $col=$_; |
| if ($studentdata[$index]=~/\D/) { |
if ($studentdata[$index]=~/\D/) { |
|
Line 1479 ENDPOP
|
Line 1820 ENDPOP
|
| } |
} |
| } |
} |
| $index++; |
$index++; |
| } ('A','B','C','D','E','F','G','H','I','J','K','L','M', |
} |
| 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'); |
|
| } |
} |
| } |
} |
| } keys %f; |
} |
| &setformulas($safeeval,%f); |
&setformulas($safeeval,%f); |
| &setconstants($safeeval,%c); |
&setconstants($safeeval,%c); |
| $r->print('<script>popwin.close()</script>'); |
$r->print('<script>popwin.close()</script>'); |
|
Line 1519 sub loadassessment {
|
Line 1859 sub loadassessment {
|
| my $version=$cachedstores{'version:'.$symb}; |
my $version=$cachedstores{'version:'.$symb}; |
| my $scope; |
my $scope; |
| for ($scope=1;$scope<=$version;$scope++) { |
for ($scope=1;$scope<=$version;$scope++) { |
| map { |
foreach (split(/\:/,$cachedstores{$scope.':keys:'.$symb})) { |
| $returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_}; |
$returnhash{$_}=$cachedstores{$scope.':'.$symb.':'.$_}; |
| } split(/\:/,$cachedstores{$scope.':keys:'.$symb}); |
} |
| } |
} |
| |
|
| } else { |
} else { |
|
Line 1533 sub loadassessment {
|
Line 1873 sub loadassessment {
|
| "restore:$udom:$uname:". |
"restore:$udom:$uname:". |
| &Apache::lonnet::escape($namespace).":". |
&Apache::lonnet::escape($namespace).":". |
| &Apache::lonnet::escape($symb),$uhome); |
&Apache::lonnet::escape($symb),$uhome); |
| map { |
foreach (split(/\&/,$answer)) { |
| my ($name,$value)=split(/\=/,$_); |
my ($name,$value)=split(/\=/,$_); |
| $returnhash{&Apache::lonnet::unescape($name)}= |
$returnhash{&Apache::lonnet::unescape($name)}= |
| &Apache::lonnet::unescape($value); |
&Apache::lonnet::unescape($value); |
| } split(/\&/,$answer); |
} |
| my $version; |
my $version; |
| for ($version=1;$version<=$returnhash{'version'};$version++) { |
for ($version=1;$version<=$returnhash{'version'};$version++) { |
| map { |
foreach (split(/\:/,$returnhash{$version.':keys'})) { |
| $returnhash{$_}=$returnhash{$version.':'.$_}; |
$returnhash{$_}=$returnhash{$version.':'.$_}; |
| } split(/\:/,$returnhash{$version.':keys'}); |
} |
| } |
} |
| } |
} |
| # ----------------------------- returnhash now has all stores for this resource |
# ----------------------------- returnhash now has all stores for this resource |
|
Line 1551 sub loadassessment {
|
Line 1891 sub loadassessment {
|
| |
|
| my @oldkeys=keys %returnhash; |
my @oldkeys=keys %returnhash; |
| |
|
| map { |
foreach (@oldkeys) { |
| my $name=$_; |
my $name=$_; |
| my $value=$returnhash{$_}; |
my $value=$returnhash{$_}; |
| delete $returnhash{$_}; |
delete $returnhash{$_}; |
| $name=~s/\_/\./g; |
$name=~s/\_/\./g; |
| $returnhash{$name}=$value; |
$returnhash{$name}=$value; |
| } @oldkeys; |
} |
| |
|
| # ---------------------------- initialize coursedata and userdata for this user |
# ---------------------------- initialize coursedata and userdata for this user |
| undef %courseopt; |
undef %courseopt; |
|
Line 1576 sub loadassessment {
|
Line 1916 sub loadassessment {
|
| $courserdatas{$cid.'.last_cache'}=time; |
$courserdatas{$cid.'.last_cache'}=time; |
| } |
} |
| } |
} |
| map { |
foreach (split(/\&/,$courserdatas{$cid})) { |
| my ($name,$value)=split(/\=/,$_); |
my ($name,$value)=split(/\=/,$_); |
| $courseopt{$userprefix.&Apache::lonnet::unescape($name)}= |
$courseopt{$userprefix.&Apache::lonnet::unescape($name)}= |
| &Apache::lonnet::unescape($value); |
&Apache::lonnet::unescape($value); |
| } split(/\&/,$courserdatas{$cid}); |
} |
| # --------------------------------------------------- Get userdata (if present) |
# --------------------------------------------------- Get userdata (if present) |
| unless |
unless |
| ((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) { |
((time-$userrdatas{$uname.'___'.$udom.'.last_cache'})<240) { |
|
Line 1591 sub loadassessment {
|
Line 1931 sub loadassessment {
|
| $userrdatas{$uname.'___'.$udom.'.last_cache'}=time; |
$userrdatas{$uname.'___'.$udom.'.last_cache'}=time; |
| } |
} |
| } |
} |
| map { |
foreach (split(/\&/,$userrdatas{$uname.'___'.$udom})) { |
| my ($name,$value)=split(/\=/,$_); |
my ($name,$value)=split(/\=/,$_); |
| $useropt{$userprefix.&Apache::lonnet::unescape($name)}= |
$useropt{$userprefix.&Apache::lonnet::unescape($name)}= |
| &Apache::lonnet::unescape($value); |
&Apache::lonnet::unescape($value); |
| } split(/\&/,$userrdatas{$uname.'___'.$udom}); |
} |
| } |
} |
| # ----------------- now courseopt, useropt initialized for this user and course |
# ----------------- now courseopt, useropt initialized for this user and course |
| # (used by parmval) |
# (used by parmval) |
|
Line 1606 sub loadassessment {
|
Line 1946 sub loadassessment {
|
| my %thisassess=(); |
my %thisassess=(); |
| my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb); |
my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb); |
| |
|
| map { |
foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) { |
| $thisassess{$_}=1; |
$thisassess{$_}=1; |
| } split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); |
} |
| # |
# |
| # Load parameters |
# Load parameters |
| # |
# |
|
Line 1617 sub loadassessment {
|
Line 1957 sub loadassessment {
|
| if (tie(%parmhash,'GDBM_File', |
if (tie(%parmhash,'GDBM_File', |
| &getcfn($safeeval).'_parms.db',&GDBM_READER,0640)) { |
&getcfn($safeeval).'_parms.db',&GDBM_READER,0640)) { |
| my %f=&getformulas($safeeval); |
my %f=&getformulas($safeeval); |
| map { |
foreach (keys(%f)) { |
| if ($_=~/^A/) { |
if ($_=~/^A/) { |
| unless ($f{$_}=~/^\!/) { |
unless ($f{$_}=~/^\!/) { |
| if ($f{$_}=~/^parameter/) { |
if ($f{$_}=~/^parameter/) { |
|
Line 1636 sub loadassessment {
|
Line 1976 sub loadassessment {
|
| } |
} |
| } |
} |
| } |
} |
| } keys %f; |
} |
| untie(%parmhash); |
untie(%parmhash); |
| } |
} |
| &setconstants($safeeval,%c); |
&setconstants($safeeval,%c); |
|
Line 1658 sub hiddenfield {
|
Line 1998 sub hiddenfield {
|
| sub selectbox { |
sub selectbox { |
| my ($title,$name,$value,%options)=@_; |
my ($title,$name,$value,%options)=@_; |
| my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">'; |
my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">'; |
| map { |
foreach (sort keys(%options)) { |
| $selout.='<option value="'.$_.'"'; |
$selout.='<option value="'.$_.'"'; |
| if ($_ eq $value) { $selout.=' selected'; } |
if ($_ eq $value) { $selout.=' selected'; } |
| $selout.='>'.$options{$_}.'</option>'; |
$selout.='>'.$options{$_}.'</option>'; |
| } sort keys %options; |
} |
| return $selout.'</select>'; |
return $selout.'</select>'; |
| } |
} |
| |
|
|
Line 1750 sub exportsheet {
|
Line 2090 sub exportsheet {
|
| my $found=''; |
my $found=''; |
| |
|
| if ($oldsheets{$key}) { |
if ($oldsheets{$key}) { |
| map { |
foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) { |
| my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); |
my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); |
| if ($name eq $fn) { |
if ($name eq $fn) { |
| $found=$value; |
$found=$value; |
| } |
} |
| } split(/\_\_\_\&\_\_\_/,$oldsheets{$key}); |
} |
| } |
} |
| |
|
| unless ($found) { |
unless ($found) { |
| &cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom)); |
&cachedssheets($uname,$udom,&Apache::lonnet::homeserver($uname,$udom)); |
| if ($oldsheets{$key}) { |
if ($oldsheets{$key}) { |
| map { |
foreach (split(/\_\_\_\&\_\_\_/,$oldsheets{$key})) { |
| my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); |
my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); |
| if ($name eq $fn) { |
if ($name eq $fn) { |
| $found=$value; |
$found=$value; |
| } |
} |
| } split(/\_\_\_\&\_\_\_/,$oldsheets{$key}); |
} |
| } |
} |
| } |
} |
| # |
# |
|
Line 1819 sub exportsheet {
|
Line 2159 sub exportsheet {
|
| } |
} |
| my %currentlystored=(); |
my %currentlystored=(); |
| unless ($current=~/^error\:/) { |
unless ($current=~/^error\:/) { |
| map { |
foreach (split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current))) { |
| my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); |
my ($name,$value)=split(/\_\_\_\=\_\_\_/,$_); |
| $currentlystored{$name}=$value; |
$currentlystored{$name}=$value; |
| } split(/\_\_\_\&\_\_\_/,&Apache::lonnet::unescape($current)); |
} |
| } |
} |
| $currentlystored{$fn}=join('___;___',@exportarr); |
$currentlystored{$fn}=join('___;___',@exportarr); |
| |
|
| my $newstore=''; |
my $newstore=''; |
| map { |
foreach (keys(%currentlystored)) { |
| if ($newstore) { $newstore.='___&___'; } |
if ($newstore) { $newstore.='___&___'; } |
| $newstore.=$_.'___=___'.$currentlystored{$_}; |
$newstore.=$_.'___=___'.$currentlystored{$_}; |
| } keys %currentlystored; |
} |
| my $now=time; |
my $now=time; |
| if ($stype eq 'studentcalc') { |
if ($stype eq 'studentcalc') { |
| &Apache::lonnet::reply('put:'. |
&Apache::lonnet::reply('put:'. |
|
Line 1869 sub expirationdates {
|
Line 2209 sub expirationdates {
|
| ':nohist_expirationdates', |
':nohist_expirationdates', |
| $ENV{'course.'.$cid.'.home'}); |
$ENV{'course.'.$cid.'.home'}); |
| unless ($reply=~/^error\:/) { |
unless ($reply=~/^error\:/) { |
| map { |
foreach (split(/\&/,$reply)) { |
| my ($name,$value)=split(/\=/,$_); |
my ($name,$value)=split(/\=/,$_); |
| $expiredates{&Apache::lonnet::unescape($name)} |
$expiredates{&Apache::lonnet::unescape($name)} |
| =&Apache::lonnet::unescape($value); |
=&Apache::lonnet::unescape($value); |
| } split(/\&/,$reply); |
} |
| } |
} |
| } |
} |
| |
|
|
Line 1890 sub cachedcsheets {
|
Line 2230 sub cachedcsheets {
|
| ':nohist_calculatedsheets', |
':nohist_calculatedsheets', |
| $ENV{'course.'.$cid.'.home'}); |
$ENV{'course.'.$cid.'.home'}); |
| unless ($reply=~/^error\:/) { |
unless ($reply=~/^error\:/) { |
| map { |
foreach ( split(/\&/,$reply)) { |
| my ($name,$value)=split(/\=/,$_); |
my ($name,$value)=split(/\=/,$_); |
| $oldsheets{&Apache::lonnet::unescape($name)} |
$oldsheets{&Apache::lonnet::unescape($name)} |
| =&Apache::lonnet::unescape($value); |
=&Apache::lonnet::unescape($value); |
| } split(/\&/,$reply); |
} |
| } |
} |
| } |
} |
| |
|
|
Line 1912 sub cachedssheets {
|
Line 2252 sub cachedssheets {
|
| $ENV{'request.course.id'}, |
$ENV{'request.course.id'}, |
| $shome); |
$shome); |
| unless ($reply=~/^error\:/) { |
unless ($reply=~/^error\:/) { |
| map { |
foreach ( split(/\&/,$reply)) { |
| my ($name,$value)=split(/\=/,$_); |
my ($name,$value)=split(/\=/,$_); |
| $oldsheets{&Apache::lonnet::unescape($name)} |
$oldsheets{&Apache::lonnet::unescape($name)} |
| =&Apache::lonnet::unescape($value); |
=&Apache::lonnet::unescape($value); |
| } split(/\&/,$reply); |
} |
| } |
} |
| $loadedcaches{$sname.'_'.$sdom}=1; |
$loadedcaches{$sname.'_'.$sdom}=1; |
| } |
} |
|
Line 1954 $tmpdir=$r->dir_config('lonDaemons').'/t
|
Line 2294 $tmpdir=$r->dir_config('lonDaemons').'/t
|
| |
|
| # --------------------------- Get query string for limited number of parameters |
# --------------------------- Get query string for limited number of parameters |
| |
|
| map { |
foreach (split(/&/,$ENV{'QUERY_STRING'})) { |
| my ($name, $value) = split(/=/,$_); |
my ($name, $value) = split(/=/,$_); |
| $value =~ tr/+/ /; |
$value =~ tr/+/ /; |
| $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
Line 1964 $tmpdir=$r->dir_config('lonDaemons').'/t
|
Line 2304 $tmpdir=$r->dir_config('lonDaemons').'/t
|
| $ENV{'form.'.$name}=$value; |
$ENV{'form.'.$name}=$value; |
| } |
} |
| } |
} |
| } (split(/&/,$ENV{'QUERY_STRING'})); |
} |
| |
|
| if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) { |
if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'})) { |
| $ENV{'form.ufn'}='default_'.$1; |
$ENV{'form.ufn'}='default_'.$1; |
|
Line 2140 ENDSCRIPT
|
Line 2480 ENDSCRIPT
|
| $r->print('<p><input type=submit name=load value="Load ...">'. |
$r->print('<p><input type=submit name=load value="Load ...">'. |
| '<select name="loadthissheet">'. |
'<select name="loadthissheet">'. |
| '<option name="default">Default</option>'); |
'<option name="default">Default</option>'); |
| map { |
foreach (&othersheets($asheet,&gettype($asheet))) { |
| $r->print('<option name="'.$_.'"'); |
$r->print('<option name="'.$_.'"'); |
| if ($ENV{'form.ufn'} eq $_) { |
if ($ENV{'form.ufn'} eq $_) { |
| $r->print(' selected'); |
$r->print(' selected'); |
| } |
} |
| $r->print('>'.$_.'</option>'); |
$r->print('>'.$_.'</option>'); |
| } &othersheets($asheet,&gettype($asheet)); |
} |
| $r->print('</select><p>'); |
$r->print('</select><p>'); |
| if (&gettype($asheet) eq 'studentcalc') { |
if (&gettype($asheet) eq 'studentcalc') { |
| &setothersheets($asheet,&othersheets($asheet,'assesscalc')); |
&setothersheets($asheet,&othersheets($asheet,'assesscalc')); |
![[BACK]](/icons/back.gif){kind=icon}
Return to lonspreadsheet.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface