[LON-CAPA-cvs] cvs: modules /matthew/spreadsheet Spreadsheet.pm assesscalc.pm classcalc.pm lonspreadsheet.pm studentcalc.pm
matthew
lon-capa-cvs@mail.lon-capa.org
Wed, 09 Apr 2003 20:57:57 -0000
This is a MIME encoded message
--matthew1049921877
Content-Type: text/plain
matthew Wed Apr 9 16:57:57 2003 EDT
Added files:
/modules/matthew/spreadsheet Spreadsheet.pm assesscalc.pm
classcalc.pm lonspreadsheet.pm
studentcalc.pm
Log:
New spreadsheet objectified code. Assess spreadsheets compute but do not
at this time export their data successfully.
Does not quite work well but need to commit to assuage the fears of the
powers that be. Specifically, the powers that be Guy.
--matthew1049921877
Content-Type: text/plain
Content-Disposition: attachment; filename="matthew-20030409165757.txt"
Index: modules/matthew/spreadsheet/Spreadsheet.pm
+++ modules/matthew/spreadsheet/Spreadsheet.pm
#
# $Id: Spreadsheet.pm,v 1.1 2003/04/09 20:57:56 matthew Exp $
#
# 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
# Spreadsheet/Grades Display Handler
#
# POD required stuff:
=head1 NAME
Spreadsheet
=head1 SYNOPSIS
=head1 DESCRIPTION
=over 4
=cut
###################################################
###################################################
### Spreadsheet ###
###################################################
###################################################
package Apache::Spreadsheet;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Safe;
use Safe::Hole;
use Opcode;
use HTML::Entities();
use HTML::TokeParser;
use Spreadsheet::WriteExcel;
use Time::HiRes;
##
## Package Variables
##
my %expiredates;
my @UC_Columns = split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ');
my @LC_Columns = map { lc($_) } @UC_Columns;
sub new {
my $this = shift;
my $class = ref($this) || $this;
my ($stype) = ($class =~ /Apache::(.*)$/);
#
my ($name,$domain,$usymb)=@_;
#
my $self = {
name => $name,
domain => $domain,
type => $stype,
symb => $usymb,
errorlog => '',
maxrow => '',
cid => $ENV{'request.course.id'},
cnum => $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
cdom => $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
chome => $ENV{'course.'.$ENV{'request.course.id'}.'.home'},
coursedesc => $ENV{'course.'.$ENV{'request.course.id'}.'.description'},
};
$self->{'coursefilename'} = $ENV{'request.course.fn'};
$self->{'uhome'} = &Apache::lonnet::homeserver($name,$domain);
#
$self->{'formulas'} = {};
$self->{'constants'} = {};
$self->{'othersheets'} = [];
#
bless($self,$class);
$self->load();
return $self;
}
sub load_spreadsheet_expirationdates {
undef %expiredates;
my $cid=$ENV{'request.course.id'};
my @tmp = &Apache::lonnet::dump('nohist_expirationdates',
$ENV{'course.'.$cid.'.domain'},
$ENV{'course.'.$cid.'.num'});
if (lc($tmp[0]) !~ /^error/){
%expiredates = @tmp;
}
}
sub check_expiration_time {
my $self = shift;
my ($time)=@_;
my ($key1,$key2,$key3,$key4);
$key1 = '::'.$self->{'type'}.':';
$key2 = $self->{'name'}.':'.$self->{'domain'}.':'.$self->{'type'}.':';
$key3 = $key2.$self->{'container'} if (defined($self->{'container'}));
$key4 = $key2.$self->{'usymb'} if (defined($self->{'usymb'}));
foreach my $key ($key1,$key2,$key3,$key4) {
next if (! defined($key));
if (exists($expiredates{$key}) &&$expiredates{$key} > $time) {
return 0;
}
}
return 1;
}
sub initialize_safe_space {
my $self = shift;
my $safeeval = new Safe(shift);
my $safehole = new Safe::Hole;
$safeeval->permit("entereval");
$safeeval->permit(":base_math");
$safeeval->permit("sort");
$safeeval->deny(":base_io");
$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
$safehole->wrap(\&mask,$safeeval,'&mask');
$safeeval->share('$@');
my $code=<<'ENDDEFS';
# ---------------------------------------------------- Inside of the safe space
#
# f: formulas
# t: intermediate format (variable references expanded)
# v: output values
# c: preloaded constants (A-column)
# rl: row label
# os: other spreadsheets (for student spreadsheet only)
undef %sheet_values; # Holds the (computed, final) values for the sheet
# This is only written to by &calc, the spreadsheet computation routine.
# It is read by many functions
undef %t; # Holds the values of the spreadsheet temporarily. Set in &sett,
# which does the translation of strings like C5 into the value in C5.
# Used in &calc - %t holds the values that are actually eval'd.
undef %f; # Holds the formulas for each cell. This is the users
# (spreadsheet authors) data for each cell.
undef %c; # Holds the constants for a sheet. In the assessment
# sheets, this is the A column. Used in &MINPARM, &MAXPARM, &expandnamed,
# &sett, and &constants. There is no &getconstants.
# &constants is called by &loadstudent, &loadcourse, &load assessment,
undef @os; # Holds the names of other spreadsheets - this is used to specify
# the spreadsheets that are available for the assessment sheet.
# Set by &setothersheets. &setothersheets is called by &handler. A
# related subroutine is &othersheets.
$errorlog = '';
#
$maxrow = 0;
$type = '';
#
# filename/reference of the sheet
$filename = '';
#
# user data
$name = '';
$uhome = '';
$domain = '';
#
# course data
$csec = '';
$chome= '';
$cnum = '';
$cdom = '';
$cid = '';
$coursefilename = '';
#
# symb
$usymb = '';
#
# error messages
$errormsg = '';
#
#-------------------------------------------------------
=pod
=item NUM(range)
returns the number of items in the range.
=cut
#-------------------------------------------------------
sub NUM {
my $mask=&mask(@_);
my $num= $#{@{grep(/$mask/,keys(%sheet_values))}}+1;
return $num;
}
#-------------------------------------------------------
=pod
=item BIN(low,high,lower,upper)
=cut
#-------------------------------------------------------
sub BIN {
my ($low,$high,$lower,$upper)=@_;
my $mask=&mask($lower,$upper);
my $num=0;
foreach (grep /$mask/,keys(%sheet_values)) {
if (($sheet_values{$_}>=$low) && ($sheet_values{$_}<=$high)) {
$num++;
}
}
return $num;
}
#-------------------------------------------------------
=pod
=item SUM(range)
returns the sum of items in the range.
=cut
#-------------------------------------------------------
sub SUM {
my $mask=&mask(@_);
my $sum=0;
foreach (grep /$mask/,keys(%sheet_values)) {
$sum+=$sheet_values{$_};
}
return $sum;
}
#-------------------------------------------------------
=pod
=item MEAN(range)
compute the average of the items in the range.
=cut
#-------------------------------------------------------
sub MEAN {
my $mask=&mask(@_);
# $errorlog.='(mask = '.$mask.' )';
my $sum=0;
my $num=0;
foreach (grep /$mask/,keys(%sheet_values)) {
$sum+=$sheet_values{$_};
$num++;
}
if ($num) {
return $sum/$num;
} else {
return undef;
}
}
#-------------------------------------------------------
=pod
=item STDDEV(range)
compute the standard deviation of the items in the range.
=cut
#-------------------------------------------------------
sub STDDEV {
my $mask=&mask(@_);
# $errorlog.='(mask = '.$mask.' )';
my $sum=0; my $num=0;
foreach (grep /$mask/,keys(%sheet_values)) {
$sum+=$sheet_values{$_};
$num++;
}
unless ($num>1) { return undef; }
my $mean=$sum/$num;
$sum=0;
foreach (grep /$mask/,keys(%sheet_values)) {
$sum+=($sheet_values{$_}-$mean)**2;
}
return sqrt($sum/($num-1));
}
#-------------------------------------------------------
=pod
=item PROD(range)
compute the product of the items in the range.
=cut
#-------------------------------------------------------
sub PROD {
my $mask=&mask(@_);
my $prod=1;
foreach (grep /$mask/,keys(%sheet_values)) {
$prod*=$sheet_values{$_};
}
return $prod;
}
#-------------------------------------------------------
=pod
=item MAX(range)
compute the maximum of the items in the range.
=cut
#-------------------------------------------------------
sub MAX {
my $mask=&mask(@_);
my $max='-';
foreach (grep /$mask/,keys(%sheet_values)) {
unless ($max) { $max=$sheet_values{$_}; }
if (($sheet_values{$_}>$max) || ($max eq '-')) {
$max=$sheet_values{$_};
}
}
return $max;
}
#-------------------------------------------------------
=pod
=item MIN(range)
compute the minimum of the items in the range.
=cut
#-------------------------------------------------------
sub MIN {
my $mask=&mask(@_);
my $min='-';
foreach (grep /$mask/,keys(%sheet_values)) {
unless ($max) { $max=$sheet_values{$_}; }
if (($sheet_values{$_}<$min) || ($min eq '-')) {
$min=$sheet_values{$_};
}
}
return $min;
}
#-------------------------------------------------------
=pod
=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(%sheet_values)) {
push (@inside,$sheet_values{$_});
}
@inside=sort(@inside);
my $sum=0; my $i;
for ($i=$#inside;(($i>$#inside-$num) && ($i>=0));$i--) {
$sum+=$inside[$i];
}
return $sum;
}
#-------------------------------------------------------
=pod
=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);
my @inside=();
foreach (grep /$mask/,keys(%sheet_values)) {
$inside[$#inside+1]=$sheet_values{$_};
}
@inside=sort(@inside);
my $sum=0; my $i;
for ($i=0;(($i<$num) && ($i<=$#inside));$i++) {
$sum+=$inside[$i];
}
return $sum;
}
#-------------------------------------------------------
=pod
=item MINPARM(parametername)
Returns the minimum value of the parameters matching the parametername.
parametername should be a string such as 'duedate'.
=cut
#-------------------------------------------------------
sub MINPARM {
my ($expression) = @_;
my $min = undef;
study($expression);
foreach $parameter (keys(%c)) {
next if ($parameter !~ /$expression/);
if ((! defined($min)) || ($min > $c{$parameter})) {
$min = $c{$parameter}
}
}
return $min;
}
#-------------------------------------------------------
=pod
=item MAXPARM(parametername)
Returns the maximum value of the parameters matching the input parameter name.
parametername should be a string such as 'duedate'.
=cut
#-------------------------------------------------------
sub MAXPARM {
my ($expression) = @_;
my $max = undef;
study($expression);
foreach $parameter (keys(%c)) {
next if ($parameter !~ /$expression/);
if ((! defined($min)) || ($max < $c{$parameter})) {
$max = $c{$parameter}
}
}
return $max;
}
sub calc {
# $errorlog .= "\%t has ".(keys(%t))." keys\n";
%sheet_values = %t; # copy %t into %sheet_values.
# $errorlog .= "\%sheet_values has ".(keys(%sheet_values))." keys\n";
my $notfinished=1;
my $lastcalc='';
my $depth=0;
while ($notfinished) {
$notfinished=0;
while (my ($cell,$value) = each(%t)) {
my $old=$sheet_values{$cell};
$sheet_values{$cell}=eval $value;
if ($@) {
undef %sheet_values;
return $cell.': '.$@;
}
if ($sheet_values{$cell} ne $old) {
$notfinished=1;
$lastcalc=$cell;
}
}
$depth++;
if ($depth>100) {
undef %sheet_values;
return $lastcalc.': Maximum calculation depth exceeded';
}
}
return '';
}
# ------------------------------------------- End of "Inside of the safe space"
ENDDEFS
$safeeval->reval($code);
$self->{'safe'} = $safeeval;
$self->{'root'} = $self->{'safe'}->root();
#
# Place some of the %$self items into the safe space except the safe space
# itself
my $initstring = '';
foreach (qw/name domain type usymb cid csec coursefilename
cnum cdom chome uhome/) {
$initstring.= qq{\$$_="$self->{$_}";};
}
$self->{'safe'}->reval($initstring);
return $self;
}
##
## mask - used to reside in the safe space.
##
{
my %memoizer;
sub mask {
my ($lower,$upper)=@_;
my $key = $lower.'_'.$upper;
if (exists($memoizer{$key})) {
return $memoizer{$key};
}
$upper = $lower if (! defined($upper));
#
my ($la,$ld) = ($lower=~/([A-Za-z]|\*)(\d+|\*)/);
my ($ua,$ud) = ($upper=~/([A-Za-z]|\*)(\d+|\*)/);
#
my $alpha='';
my $num='';
#
if (($la eq '*') || ($ua eq '*')) {
$alpha='[A-Za-z]';
} else {
if (($la=~/[A-Z]/) && ($ua=~/[A-Z]/) ||
($la=~/[a-z]/) && ($ua=~/[a-z]/)) {
$alpha='['.$la.'-'.$ua.']';
} else {
$alpha='['.$la.'-Za-'.$ua.']';
}
}
if (($ld eq '*') || ($ud eq '*')) {
$num='\d+';
} else {
if (length($ld)!=length($ud)) {
$num.='(';
foreach ($ld=~m/\d/g) {
$num.='['.$_.'-9]';
}
if (length($ud)-length($ld)>1) {
$num.='|\d{'.(length($ld)+1).','.(length($ud)-1).'}';
}
$num.='|';
foreach ($ud=~m/\d/g) {
$num.='[0-'.$_.']';
}
$num.=')';
} else {
my @lda=($ld=~m/\d/g);
my @uda=($ud=~m/\d/g);
my $i;
my $j=0;
my $notdone=1;
for ($i=0;($i<=$#lda)&&($notdone);$i++) {
if ($lda[$i]==$uda[$i]) {
$num.=$lda[$i];
$j=$i;
} else {
$notdone=0;
}
}
if ($j<$#lda-1) {
$num.='('.$lda[$j+1];
for ($i=$j+2;$i<=$#lda;$i++) {
$num.='['.$lda[$i].'-9]';
}
if ($uda[$j+1]-$lda[$j+1]>1) {
$num.='|['.($lda[$j+1]+1).'-'.($uda[$j+1]-1).']\d{'.
($#lda-$j-1).'}';
}
$num.='|'.$uda[$j+1];
for ($i=$j+2;$i<=$#uda;$i++) {
$num.='[0-'.$uda[$i].']';
}
$num.=')';
} else {
if ($lda[-1]!=$uda[-1]) {
$num.='['.$lda[-1].'-'.$uda[-1].']';
}
}
}
}
my $expression ='^'.$alpha.$num."\$";
$memoizer{$key} = $expression;
return $expression;
}
}
##
## sub add_hash_to_safe {} # spreadsheet, would like to destroy
##
#
# expandnamed used to reside in the safe space
#
sub expandnamed {
my $self = shift;
my $expression=shift;
if ($expression=~/^\&/) {
my ($func,$var,$formula)=($expression=~/^\&(\w+)\(([^\;]+)\;(.*)\)/);
my @vars=split(/\W+/,$formula);
my %values=();
foreach my $varname ( @vars ) {
if ($varname=~/\D/) {
$formula=~s/$varname/'$c{\''.$varname.'\'}'/ge;
$varname=~s/$var/\([\\w:\\- ]\+\)/g;
foreach (keys(%{$self->{'constants'}})) {
if ($_=~/$varname/) {
$values{$1}=1;
}
}
}
}
if ($func eq 'EXPANDSUM') {
my $result='';
foreach (keys(%values)) {
my $thissum=$formula;
$thissum=~s/$var/$_/g;
$result.=$thissum.'+';
}
$result=~s/\+$//;
return $result;
} else {
return 0;
}
} else {
# 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;
my $parameter;
foreach $parameter (keys(%{$self->{'constants'}})) {
push @matches,$parameter if ($parameter =~ /$expression/);
}
if (scalar(@matches) == 0) {
$returnvalue = 'unmatched parameter: '.$parameter;
} elsif (scalar(@matches) == 1) {
# why do we not do this lookup here, instead of delaying it?
$returnvalue = '$c{\''.$matches[0].'\'}';
} elsif (scalar(@matches) > 0) {
# more than one match. Look for a concise one
$returnvalue = "'non-unique parameter name : $expression'";
foreach (@matches) {
if (/^$expression$/) {
# why do we not do this lookup here?
$returnvalue = '$c{\''.$_.'\'}';
}
}
} else {
# There was a negative number of matches, which indicates
# something is wrong with reality. Better warn the user.
$returnvalue = 'bizzare parameter: '.$parameter;
}
return $returnvalue;
}
}
#
# sett Set up the temporary hash used for computation
#
sub sett {
my $self = shift;
my %t=();
my $pattern='';
if ($self->{'type'} eq 'assesscalc') {
$pattern='A';
} else {
$pattern='[A-Z]';
}
# Deal with the template row
foreach my $col ($self->template_cells()) {
next if ($col=~/^$pattern/);
foreach my $trow ($self->rows()) {
# Get the name of this cell
my $lb=$col.$trow;
# Grab the template declaration
$t{$lb}=$self->formula('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\$sheet_values\{\'$2\'\}/g;
# Replace parameters
$t{$lb}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
}
}
# Deal with the normal cells
foreach ($self->formulas_keys()) {
next if ($_=~/template\_/);
if (($_=~/^$pattern(\d+)/) && ($1)) {
if ($self->formula($_) !~ /^\!/) {
$t{$_}=$self->{'constants'}->{$_};
}
} else {
$t{$_}=$self->formula($_);
$t{$_}=~s/\.\.+/\,/g;
$t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
$t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
}
}
# For inserted lines, [B-Z] is also valid
if ($self->{'type'} ne 'assesscalc') {
foreach ($self->formulas_keys()) {
next if ($_ !~ /[B-Z](\d+)/);
next if ($self->formula('A'.$1) !~ /^[\~\-]/);
$t{$_}=$self->formula($_);
$t{$_}=~s/\.\.+/\,/g;
$t{$_}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
$t{$_}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
}
}
# For some reason 'A0' gets special treatment... This seems superfluous
# but I imagine it is here for a reason.
$t{'A0'}=$self->formula('A0');
$t{'A0'}=~s/\.\.+/\,/g;
$t{'A0'}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
$t{'A0'}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
# Put %t into the safe space
%{$self->{'safe'}->varglob('t')}=%t;
}
##
## sync_safe_space: Called by calcsheet to make sure all the data we
# need to calculate is placed into the safe space
##
sub sync_safe_space {
my $self = shift;
# Inside the safe space 'formulas' has a diabolical alter-ego named 'f'.
%{$self->{'safe'}->varglob('f')}=%{$self->{'formulas'}};
# 'constants' leads a peaceful hidden life of 'c'.
%{$self->{'safe'}->varglob('c')}=%{$self->{'constants'}};
# 'othersheets' hides as 'os', a disguise few can penetrate.
@{$self->{'safe'}->varglob('os')}=@{$self->{'othersheets'}};
}
##
## Retrieve the error log from the safe space (used for debugging)
##
sub get_errorlog {
my $self = shift;
$self->{'errorlog'} = $ { $self->{'safe'}->varglob('errorlog') };
return $self->{'errorlog'};
}
##
## Clear the error log inside the safe space
##
sub clear_errorlog {
my $self = shift;
$ {$self->{'safe'}->varglob('errorlog')} = '';
$self->{'errorlog'} = '';
}
##
## constants: either set or get the constants
##
sub constants {
my $self=shift;
my ($constants) = @_;
if (defined($constants)) {
if (! ref($constants)) {
my %tmp = @_;
$constants = \%tmp;
}
$self->{'constants'} = $constants;
return;
} else {
return %{$self->{'constants'}};
}
}
##
## formulas: either set or get the formulas
##
sub formulas {
my $self=shift;
my ($formulas) = @_;
if (defined($formulas)) {
if (! ref($formulas)) {
my %tmp = @_;
$formulas = \%tmp;
}
$self->{'formulas'} = $formulas;
$self->{'rows'} = [];
$self->{'template_cells'} = [];
return;
} else {
return %{$self->{'formulas'}};
}
}
sub set_formula {
my $self = shift;
my ($cell,$formula) = @_;
$self->{'formulas'}->{$cell}=$formula;
}
##
## formulas_keys: Return the keys to the formulas hash.
##
sub formulas_keys {
my $self = shift;
my @keys = keys(%{$self->{'formulas'}});
return keys(%{$self->{'formulas'}});
}
##
## formula: Return the formula for a given cell in the spreadsheet
## returns '' if the cell does not have a formula or does not exist
##
sub formula {
my $self = shift;
my $cell = shift;
if (defined($cell) && exists($self->{'formulas'}->{$cell})) {
return $self->{'formulas'}->{$cell};
}
return '';
}
##
## logthis: write the input to lonnet.log
##
sub logthis {
my $self = shift;
my $message = shift;
&Apache::lonnet::logthis($self->{'type'}.':'.
$self->{'name'}.':'.$self->{'domain'}.':'.
$message);
return;
}
##
## dump_formulas_to_log: makes lonnet.log huge...
##
sub dump_formulas_to_log {
my $self =shift;
$self->logthis("Spreadsheet formulas");
$self->logthis("--------------------------------------------------------");
while (my ($cell, $formula) = each(%{$self->{'formulas'}})) {
$self->logthis(' '.$cell.' = '.$formula);
}
$self->logthis("--------------------------------------------------------");}
##
## value: returns the computed value of a particular cell
##
sub value {
my $self = shift;
my $cell = shift;
if (defined($cell) && exists($self->{'values'}->{$cell})) {
return $self->{'values'}->{$cell};
}
return '';
}
##
## dump_values_to_log: makes lonnet.log huge...
##
sub dump_values_to_log {
my $self =shift;
$self->logthis("Spreadsheet Values");
$self->logthis("--------------------------------------------------------");
while (my ($cell, $value) = each(%{$self->{'values'}})) {
$self->logthis(' '.$cell.' = '.$value);
}
$self->logthis("--------------------------------------------------------");}
##
## Yet another debugging function
##
sub dump_hash_to_log {
my $self= shift();
my %tmp = @_;
if (@_<2) {
%tmp = %{$_[0]};
}
$self->logthis('---------------------------- (begin hash dump)');
while (my ($key,$val) = each (%tmp)) {
$self->logthis(' '.$key.' = '.$val.':');
}
$self->logthis('---------------------------- (finished hash dump)');
}
##
## rebuild_stats: rebuilds the rows and template_cells arrays
##
sub rebuild_stats {
my $self = shift;
$self->{'rows'}=[];
$self->{'template_cells'}=[];
foreach my $cell($self->formulas_keys()) {
push(@{$self->{'rows'}},$1) if ($cell =~ /^A(\d+)/ && $1 != 0);
push(@{$self->{'template_cells'}},$1) if ($cell =~ /^template_(\w+)/);
}
return;
}
##
## template_cells returns a list of the cells defined in the template row
##
sub template_cells {
my $self = shift;
$self->rebuild_stats() if (! defined($self->{'template_cells'}) ||
! @{$self->{'template_cells'}});
return @{$self->{'template_cells'}};
}
##
## Sigh....
##
sub setothersheets {
my $self = shift;
my @othersheets = @_;
$self->{'othersheets'} = \@othersheets;
}
##
## rows returns a list of the names of cells defined in the A column
##
sub rows {
my $self = shift;
$self->rebuild_stats() if (!@{$self->{'rows'}});
return @{$self->{'rows'}};
}
#
# calcsheet: makes all the calls to compute the spreadsheet.
#
sub calcsheet {
my $self = shift;
$self->sync_safe_space();
$self->clear_errorlog();
$self->sett();
my $result = $self->{'safe'}->reval('&calc();');
%{$self->{'values'}} = %{$self->{'safe'}->varglob('sheet_values')};
# $self->logthis($self->get_errorlog());
return $result;
}
###########################################################
##
## Output Helpers
##
###########################################################
############################################
## HTML output routines ##
############################################
sub html_editable_cell {
my ($cell,$bgcolor) = @_;
my $result;
my ($name,$formula,$value);
if (defined($cell)) {
$name = $cell->{'name'};
$formula = $cell->{'formula'};
$value = $cell->{'value'};
}
$name = '' if (! defined($name));
$formula = '' if (! defined($formula));
if (! defined($value)) {
$value = '<font color="'.$bgcolor.'">#</font>';
if ($formula ne '') {
$value = '<i>undefined value</i>';
}
} elsif ($value =~ /^\s*$/ ) {
$value = '<font color="'.$bgcolor.'">#</font>';
} else {
$value = &HTML::Entities::encode($value) if ($value !~/ /);
}
# Make the formula safe for outputting
$formula =~ s/\'/\"/g;
# The formula will be parsed by the browser twice before being
# displayed to the user for editing.
$formula = &HTML::Entities::encode(&HTML::Entities::encode($formula));
# Escape newlines so they make it into the edit window
$formula =~ s/\n/\\n/gs;
# Glue everything together
$result .= "<a href=\"javascript:celledit(\'".
$name."','".$formula."');\">".$value."</a>";
return $result;
}
sub html_uneditable_cell {
my ($cell,$bgcolor) = @_;
my $value = (defined($cell) ? $cell->{'value'} : '');
$value = &HTML::Entities::encode($value) if ($value !~/ /);
return ' '.$value.' ';
}
sub html_row {
my $self = shift();
my ($num_uneditable,$row) = @_;
my $requester_is_student = ($ENV{'request.role'} =~ /^st\./);
my @rowdata = $self->get_row($row);
my $num_cols_output = 0;
my $row_html;
foreach my $cell (@rowdata) {
if ($requester_is_student ||
$num_cols_output++ < $num_uneditable) {
$row_html .= '<td bgcolor="#FFDDDD">';
$row_html .= &html_uneditable_cell($cell,'#FFDDDD');
} else {
$row_html .= '<td bgcolor="#EOFFDD">';
$row_html .= &html_editable_cell($cell,'#E0FFDD');
}
$row_html .= '</td>';
}
return $row_html;
}
sub create_excel_spreadsheet {
my $self = shift;
my ($r) = @_;
my $filename = '/prtspool/'.
$ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
time.'_'.rand(1000000000).'.xls';
my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
if (! defined($workbook)) {
$r->log_error("Error creating excel spreadsheet $filename: $!");
$r->print("Problems creating new Excel file. ".
"This error has been logged. ".
"Please alert your LON-CAPA administrator");
return undef;
}
#
# The excel spreadsheet stores temporary data in files, then put them
# together. If needed we should be able to disable this (memory only).
# The temporary directory must be specified before calling 'addworksheet'.
# File::Temp is used to determine the temporary directory.
$workbook->set_tempdir('/home/httpd/perl/tmp');
#
# Determine the name to give the worksheet
return ($workbook,$filename);
}
############################################
## XML output routines ##
############################################
sub outsheet_xml {
my $self = shift;
my ($r) = @_;
## Someday XML
## Will be rendered for the user
## But not on this day
}
############################################
### Filesystem routines ###
############################################
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;
}
my %defaultsheets;
my %spreadsheets;
sub load {
my $self = shift;
my ($fn)=@_;
my $includedir = $Apache::lonnet::perlvar{'lonIncludes'};
#
my $stype = $self->{'type'};
my $cnum = $self->{'cnum'};
my $cdom = $self->{'cdom'};
my $chome = $self->{'chome'};
#
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',
['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;
}
}
# $fn now has a value
$self->{'filename'} = $fn;
# see if sheet is cached
if (exists($spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn})) {
my %tmp = split(/___;___/,
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn});
$self->formulas(\%tmp);
} else {
# Not cached, need to read
my %f=();
if ($fn=~/^default_/) {
my $sheetxml='';
my $fh;
my $dfn=$fn;
$dfn=~s/\_/\./g;
if ($fh=Apache::File->new($includedir.'/'.$dfn)) {
$sheetxml=join('',<$fh>);
} else {
# $sheetxml='<field row="0" col="A">"Error"</field>';
$sheetxml='<field row="0" col="A"></field>';
}
%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 %tmphash = &Apache::lonnet::dump($fn,$cdom,$cnum);
my ($tmp) = keys(%tmphash);
if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
foreach (keys(%tmphash)) {
$f{$_}=$tmphash{$_};
}
} else {
# Unable to grab the specified spreadsheet,
# so we get the default ones instead.
$fn = 'default_'.$stype;
$self->{'filename'} = $fn;
my $dfn = $fn;
$dfn =~ s/\_/\./g;
my $sheetxml;
if (my $fh=Apache::File->new($includedir.'/'.$dfn)) {
$sheetxml = join('',<$fh>);
} else {
$sheetxml='<field row="0" col="A">'.
'"Unable to load spreadsheet"</field>';
}
%f=%{&parse_sheet(\$sheetxml)};
}
}
# Cache and set
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
$self->formulas(\%f);
}
$self->set_row_numbers();
}
sub save {
my $self = shift;
my ($makedef)=@_;
my $cid=$self->{'cid'};
if (&Apache::lonnet::allowed('opa',$cid)) {
my %f=$self->formulas();
my $stype= $self->{'type'};
my $cnum = $self->{'cnum'};
my $cdom = $self->{'cdom'};
my $chome= $self->{'chome'};
my $fn = $self->{'filename'};
# Cache new sheet
$spreadsheets{$cnum.'_'.$cdom.'_'.$stype.'_'.$fn}=join('___;___',%f);
# Write sheet
foreach (keys(%f)) {
delete($f{$_}) if ($f{$_} eq 'import');
}
my $reply = &Apache::lonnet::put($fn,\%f,$cdom,$cnum);
if ($reply eq 'ok') {
$reply = &Apache::lonnet::put($stype.'_spreadsheets',
{$fn => $ENV{'user.name'}.'@'.$ENV{'user.domain'}},
$cdom,$cnum);
if ($reply eq 'ok') {
if ($makedef) {
$reply = &Apache::lonnet::put('environment',
{'spreadsheet_default_'.$stype => $fn },
$cdom,$cnum);
if ($reply eq 'ok' &&
($self->{'type'} eq 'studentcalc' ||
$self->{'type'} eq 'assesscalc')) {
# Expire the spreadsheets of the other students.
&Apache::lonnet::expirespread('','','studentcalc','');
}
return $reply;
}
return $reply;
}
return $reply;
}
return $reply;
}
return 'unauthorized';
}
sub save_tmp {
my $self = shift;
my $fn=$ENV{'user.name'}.'_'.
$ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'.
$self->{'filename'};
$fn=~s/\W/\_/g;
$fn=$Apache::lonnet::tmpdir.$fn.'.tmp';
my $fh;
if ($fh=Apache::File->new('>'.$fn)) {
my %f = $self->formulas();
while( my ($cell,$formula) = each(%f)) {
print $fh &Apache::lonnet::escape($cell)."=".&Apache::lonnet::escape($formula)."\n";
}
}
}
sub load_tmp {
my $self = shift;
my ($nfield,$nform)=@_;
my $fn=$ENV{'user.name'}.'_'.
$ENV{'user.domain'}.'_spreadsheet_'.$self->{'usymb'}.'_'.
$self->{'filename'};
$fn=~s/\W/\_/g;
$fn=$Apache::lonnet::tmpdir.$fn.'.tmp';
my $fh;
my %fo=();
my $countrows=0;
if ($fh=Apache::File->new($fn)) {
while (<$fh>) {
chomp;
my ($cell,$formula) = split(/=/);
$cell = &Apache::lonnet::unescape($cell);
$formula = &Apache::lonnet::unescape($formula);
$fo{$cell} = $formula;
}
}
if ($nform eq 'changesheet') {
$fo{'A'.$nfield}=(split(/__&&&\__/,$fo{'A'.$nfield}))[0];
unless ($ENV{'form.sel_'.$nfield} eq 'Default') {
$fo{'A'.$nfield}.='__&&&__'.$ENV{'form.sel_'.$nfield};
}
} else {
if ($nfield) { $fo{$nfield}=$nform; }
}
$self->formulas(\%fo);
$self->set_row_numbers();
}
###########################################
# othersheets: Returns the list of other spreadsheets available
###########################################
sub othersheets {
my $self = shift;
my $stype = $self->{'type'};
#
my $cnum = $self->{'cnum'};
my $cdom = $self->{'cdom'};
my $chome = $self->{'chome'};
#
my @alternatives=();
my %results=&Apache::lonnet::dump($stype.'_spreadsheets',$cdom,$cnum);
my ($tmp) = keys(%results);
unless ($tmp =~ /^(con_lost|error|no_such_host)/i) {
@alternatives = sort (keys(%results));
}
return @alternatives;
}
sub get_row {
my $self = shift;
my ($n)=@_;
my @cols=();
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') {
push(@cols,{ name => $_.$n,
formula => $self->formula($_.$n),
value => $self->value($_.$n)});
}
return @cols;
}
sub get_template_row {
my $self = shift;
my @cols=();
foreach my $col ('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') {
push(@cols,{ name => 'template_'.$col,
formula => $self->formula('template_'.$col),
value => $self->value('template_'.$col) });
}
return @cols;
}
sub set_row_numbers {
my $self = shift;
my %f=$self->formulas();
while (my ($cell,$value) = each(%{$self->{'formulas'}})) {
next if ($cell !~ /^A(\d+)$/);
next if (! defined($value));
$self->{'row_numbers'}->{$value} = $1;
}
}
sub get_row_number_from_key {
my $self = shift;
my ($key) = @_;
if (! exists($self->{'row_numbers'}->{$key}) ||
! defined($self->{'row_numbers'}->{$key})) {
$self->{'maxrow'}++;
$self->set_formula('A'.$self->{'maxrow'},$key);
$self->{'row_numbers'}->{$key} = $self->{'maxrow'};
}
return $self->{'row_numbers'}->{$key};
}
1;
__END__
Index: modules/matthew/spreadsheet/assesscalc.pm
+++ modules/matthew/spreadsheet/assesscalc.pm
#
# $Id: assesscalc.pm,v 1.1 2003/04/09 20:57:56 matthew Exp $
#
# 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
# Spreadsheet/Grades Display Handler
#
# POD required stuff:
=head1 NAME
assesscalc
=head1 SYNOPSIS
=head1 DESCRIPTION
=over 4
=cut
###################################################
### AssessSheet ###
###################################################
package Apache::assesscalc;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::Spreadsheet;
use HTML::Entities();
use Spreadsheet::WriteExcel;
use GDBM_File;
use Time::HiRes;
@Apache::assesscalc::ISA = ('Apache::Spreadsheet');
my %Exportrows;
my $current_name;
my $current_domain;
my $current_course;
my %useropt;
my %courseopt;
my %parmhash;
my $count = 0;
sub initialize_package {
my ($sname,$sdomain) = @_;
$current_name = $sname;
$current_domain = $sdomain;
############################
## Set up the export rows ##
############################
%Exportrows = undef;
my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets_'.
$ENV{'request.course.id'},
$sname,$sdomain);
if ($tmp[0]!~/^error/) {
my %tmp = @tmp;
# We only got one key, so we will access it directly.
while (my ($key,$sheetdata) = each(%tmp)) {
my ($sname,$sdom,$sheettype,$symb) = split(':',$key);
if ($symb =~ /\.time/) {
$Exportrows{$symb}->{'time'} = $sheetdata;
} else {
$sheetdata =~ s/^___=___//;
$Exportrows{$symb}->{'data'} = {split('___;___',$sheetdata)};
}
}
}
}
sub setup_parameter_caches {
my $userprefix = $current_name.':'.$current_domain.'_';
$userprefix =~ s/:/_/g;
#
# Course Parameters Cache
if (! defined($current_course) ||
$current_course ne $ENV{'request.course.id'}) {
$current_course = $ENV{'request.course.id'};
undef(%courseopt);
if (! defined($current_name) || ! defined($current_domain)) {
&Apache::lonnet::logthis('bad call to setup_parameter_caches');
return;
}
my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
my $id = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
my %Tmp = &Apache::lonnet::dump('resourcedata',$dom,$id);
while (my ($name,$value) = each(%Tmp)) {
$courseopt{$userprefix.$name}=$value;
}
}
undef(%useropt);
my %Tmp = &Apache::lonnet::dump('resourcedata',
$current_domain,$current_name);
while (my ($name,$value) = each(%Tmp)) {
if ($name =~ /^error: 2/ || $name =~ /no such file/) {
undef(%useropt);
last;
}
$useropt{$userprefix.$name}=$value;
}
}
sub clear_package {
undef(%Exportrows);
undef($current_name);
undef($current_domain);
undef(%useropt);
undef(%courseopt);
}
##################################################
##################################################
=pod
=item &parmval()
Determine the value of a parameter.
Inputs: $what, the parameter needed, $symb, $uname, $udom, $csec
Returns: The value of a parameter, or '' if none.
This function cascades through the possible levels searching for a value for
a parameter. The levels are checked in the following order:
user, course (at section level and course level), map, and lonnet::metadata.
This function uses %parmhash, which must be tied prior to calling it.
This function also requires %courseopt and %useropt to be initialized for
this user and course.
=cut
##################################################
##################################################
sub parmval {
my $self = shift;
my ($what,$symb,$uname,$udom,$csec)=@_;
$uname = $self->{'name'} if (! defined($uname));
$udom = $self->{'domain'} if (! defined($udom));
$csec = $self->{'section'} if (! defined($csec));
$symb = $self->{'symb'} if (! defined($symb));
#
my $result='';
#
# This should be a
my ($mapname,$id,$fn)=split(/___/,$symb);
# Cascading lookup scheme
my $rwhat=$what;
$what =~ s/^parameter\_//;
$what =~ s/\_([^\_]+)$/\.$1/;
#
my $symbparm = $symb.'.'.$what;
my $mapparm = $mapname.'___(all).'.$what;
my $usercourseprefix = $uname.'_'.$udom.'_'.$self->{'cid'};
#
my $seclevel = $usercourseprefix.'.['.$csec.'].'.$what;
my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm;
my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm;
#
my $courselevel = $usercourseprefix.'.'.$what;
my $courselevelr = $usercourseprefix.'.'.$symbparm;
my $courselevelm = $usercourseprefix.'.'.$mapparm;
foreach ($symbparm, $mapparm,$usercourseprefix,$seclevel,
$seclevelr,$seclevelm,$courselevel,$courselevelr,$courselevelm) {
# $self->logthis('level = '.$_);
# $self->logthis('value = '.$courseopt{$_}) if (exists($courseopt{$_}));
}
# fourth, check user
if (defined($uname)) {
return $useropt{$courselevelr} if (defined($useropt{$courselevelr}));
return $useropt{$courselevelm} if (defined($useropt{$courselevelm}));
return $useropt{$courselevel} if (defined($useropt{$courselevel}));
}
# third, check course
if (defined($csec)) {
return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr}));
return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm}));
return $courseopt{$seclevel} if (defined($courseopt{$seclevel}));
}
#
return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr}));
return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm}));
return $courseopt{$courselevel} if (defined($courseopt{$courselevel}));
# second, check map parms
my $thisparm = $parmhash{$symbparm};
return $thisparm if (defined($thisparm));
# first, check default
$thisparm = &Apache::lonnet::metadata($fn,$rwhat.'.default');
return $thisparm if (defined($thisparm));
#Cascade Up
my $space=$what;
$space=~s/\.\w+$//;
if ($space ne '0') {
my @parts=split(/_/,$space);
my $id=pop(@parts);
my $part=join('_',@parts);
if ($part eq '') { $part='0'; }
my $newwhat=$rwhat;
$newwhat=~s/\Q$space\E/$part/;
my $partgeneral=$self->parmval($newwhat,$symb,$uname,$udom,$csec);
if (defined($partgeneral)) { return $partgeneral; }
}
#nothing defined
return '';
}
sub gettitle {
my $self = shift;
my $title;
if (($self->{'usymb'} eq '_feedback') ||
($self->{'usymb'} eq '_evaluation') ||
($self->{'usymb'} eq '_discussion') ||
($self->{'usymb'} eq '_tutoring')) {
$title = $self->{'usymb'};
$title =~ s/^_//;
$title = ucfirst($title);
return $title;
}
my $navmap = Apache::lonnavmaps::navmap->new(Apache->request,
$ENV{'request.course.fn'}.'.db',
$ENV{'request.coures.fn'}.'_parms.db',0,0);
my $resource = $navmap->getBySymb($self->{'symb'});
$title = $resource->title();
$navmap->untieHashes();
}
sub outsheet_html {
my $self = shift;
my ($r) = @_;
###################################
# Determine table structure
###################################
my $num_uneditable = 1;
my $num_left = 52-$num_uneditable;
my $tableheader =<<"END";
<table border="2">
<tr>
<th colspan="2" rowspan="2"><font size="+2">Assessment</font></th>
<td bgcolor="#FFDDDD" colspan="$num_uneditable"> </td>
<td colspan="$num_left">
<b><font size="+1">Calculations</font></b></td>
</tr><tr>
END
my $label_num = 0;
foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){
if ($label_num<$num_uneditable) {
$tableheader .= '<td bgcolor="#FFDDDD">';
} else {
$tableheader .= '<td>';
}
$tableheader .= "<b><font size=+1>$_</font></b></td>";
$label_num++;
}
$tableheader.="</tr>\n";
#
$r->print($tableheader);
#
# Print out template row
$r->print('<tr><td>Template</td><td> </td>'.
$self->html_row($num_uneditable,'-')."</tr>\n");
#
# Print out summary/export row
$r->print('<tr><td>Export</td><td>0</td>'.
$self->html_row(0,0)."</tr>\n");
#
# Prepare to output rows
$tableheader =<<"END";
<table border="2">
<tr><th>row</th><th>Item</th>
END
foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){
if ($label_num<$num_uneditable) {
$tableheader.='<th bgcolor="#FFDDDD">';
} else {
$tableheader.='<th>';
}
$tableheader.="<b><font size=+1>$_</font></b></th>";
}
#
my $num_output = 0;
foreach my $rownum ($self->rows()) {
if ($num_output++ % 50 == 0) {
$r->print("</table>\n".$tableheader);
}
$r->print('<tr><td>'.$rownum.'</td>'.
$self->assess_html_row($num_uneditable,$rownum)."</tr>\n");
}
$r->print("</table>\n");
return;
}
sub assess_html_row {
my $self = shift();
my ($num_uneditable,$row) = @_;
my $requester_is_student = ($ENV{'request.role'} =~ /^st\./);
my $parameter_name = $self->{'formulas'}->{'A'.$row};
my @rowdata = $self->get_row($row);
my $num_cols_output = 0;
my $row_html = '<td>'.$parameter_name.'</td>';
foreach my $cell (@rowdata) {
if ($requester_is_student ||
$num_cols_output++ < $num_uneditable) {
$row_html .= '<td bgcolor="#FFDDDD">';
$row_html .= &Apache::Spreadsheet::html_uneditable_cell($cell,'#FFDDDD');
} else {
$row_html .= '<td bgcolor="#EOFFDD">';
$row_html .= &Apache::Spreadsheet::html_editable_cell($cell,'#E0FFDD');
}
$row_html .= '</td>';
}
return $row_html;
}
sub outsheet_csv {
my $self = shift;
my ($r)=@_;
}
sub outsheet_excel {
my $self = shift;
my ($r)=@_;
}
sub display {
my $self = shift;
my ($r) = @_;
$self->compute();
$self->outsheet_html($r);
}
my %CourseResourceData;
my %UserResourceData;
sub compute {
my $self = shift;
$self->logthis('computing');
$self->initialize_safe_space();
#
# Definitions
my %parameters; # holds underscored parameters by name
my %parameter_names; # I have no idea.
#
# Get the metadata fields and determine their proper names
my ($symap,$syid,$srcf)=split(/___/,$self->{'symb'});
my @Metadata = split(/\,/,&Apache::lonnet::metadata($srcf,'keys'));
foreach my $parm (@Metadata) {
next if ($parm !~ /^(resource\.|stores|parameter)_/);
my $cleaned_name = $parm;
$cleaned_name =~ s/^resource\./stores_/;
$cleaned_name =~ s/\./_/g;
my $display = &Apache::lonnet::metadata($srcf,
$cleaned_name.'.display');
if (! $display) {
$display .= &Apache::lonnet::metadata($srcf,$cleaned_name.'.name');
}
$parameters{$cleaned_name}++;
$parameter_names{$cleaned_name} = $display;
}
#
# Get the values of the metadata fields
$current_name = $self->{'name'};
$current_domain = $self->{'domain'};
&setup_parameter_caches();
my $filename = $self->{'coursefilename'}.'_parms.db';
if (tie(%parmhash,'GDBM_File',
$self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) {
foreach my $parmname (keys(%parameters)) {
my $value = $self->parmval($parmname);
$parameters{$parmname} =$value;
}
untie(%parmhash);
} else {
$self->logthis('unable to tie '.$filename);
}
#
# Get the students performance data
my %student_parameters;
%student_parameters =
&Apache::loncoursedata::get_current_state($self->{'name'},
$self->{'domain'},
$self->{'symb'},
$self->{'cid'});
while (my ($parm,$value) = each(%student_parameters)) {
$parm =~ s/^resource\./stores_/;
$parm =~ s/\./_/g;
$parameters{$parm} = $value;
}
#
# Clean out unnecessary parameters
foreach (keys(%parameters)) {
delete($parameters{$_}) if (! /(resource\.|stores_|parameter_)/);
}
#
# Set up the formulas and parameter values
my %f=$self->formulas();
my %c;
my %have_seen;
while (my ($cell,$formula) = each(%f)) {
next if ($cell !~ /^A/ || $cell eq 'A0');
$c{$formula}=$parameters{$formula};
$have_seen{$formula}++;
$self->logthis('seen '.$formula);
}
while (my ($parm,$value) = each(%parameters)) {
next if ($have_seen{$parm});
my $cell = 'A'.(++$self->{'maxrows'});
$f{$cell} = $parm;
$c{$parm} = $value;
}
$self->formulas(%f);
$self->constants(%c);
# calculate sheet
$self->calcsheet();
#
# Store export row in cache
my @exportarray=();
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') {
push(@exportarray,$self->value($_.'0'));
}
$Exportrows{$self->{'symb'}}->{'time'} = time;
$Exportrows{$self->{'symb'}}->{'data'} = \@exportarray;
#
# Save the export data
$self->save_export_data();
return;
}
sub sett {
my $self = shift;
my %t=();
#
# Deal with the template row by copying the template formulas into each
# row.
foreach my $col ($self->template_cells()) {
next if ($col=~/^A/);
foreach my $row ($self->rows()) {
# Get the name of this cell
my $cell=$col.$row;
# Grab the template declaration
$t{$cell}=$self->formula('template_'.$col);
# Replace '#' with the row number
$t{$cell}=~s/\#/$row/g;
# Replace '....' with ','
$t{$cell}=~s/\.\.+/\,/g;
# Replace 'A0' with the value from 'A0'
$t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
# Replace parameters
$t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
}
}
#
# Deal with the cells which have formulas
while (my ($cell,$formula) = each(%{$self->{'formulas'}})) {
next if ($cell =~ /template_/);
if ($cell =~ /^A/ && $cell ne 'A0') {
if ($formula !~ /^\!/) {
$t{$cell}=$self->{'constants'}->{$formula};
}
} else {
$t{$cell}=$formula;
$t{$cell}=~s/\.\.+/\,/g;
$t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g;
$t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge;
}
}
# Put %t into the safe space
%{$self->{'safe'}->varglob('t')}=%t;
}
sub export_data {
my $self = shift;
my $symb = $self->{'symb'};
if (! exists($Exportrows{$symb}) || ! defined($Exportrows{$symb}) ||
! $self->check_expiration_time($Exportrows{$symb}->{'time'})) {
$self->compute();
}
return @{$Exportrows{$symb}->{'data'}};
}
sub save_export_data {
return;
my $self = shift;
my $student = $self->{'name'}.':'.$self->{'domain'};
my $symb = $self->{'symb'};
return if (! exists($Exportrows{$symb}));
my $key = join(':',($self->{'name'},$self->{'domain'},'assesscalc',$symb));
my $timekey = $key.'.time';
my $newstore = join('___;___',
@{$Exportrows{$symb}->{'data'}});
$newstore = $self->{'filename'}.'___=___'.$newstore;
&Apache::lonnet::put('nohist_calculatedsheets',
{ $key => $newstore,
$timekey => $Exportrows{$symb}->{'time'} },
$self->{'domain'},
$self->{'name'});
return;
}
1;
__END__
Index: modules/matthew/spreadsheet/classcalc.pm
+++ modules/matthew/spreadsheet/classcalc.pm
#
# $Id: classcalc.pm,v 1.1 2003/04/09 20:57:56 matthew Exp $
#
# 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
# Spreadsheet/Grades Display Handler
#
# POD required stuff:
=head1 NAME
classcalc
=head1 SYNOPSIS
=head1 DESCRIPTION
=over 4
=cut
###################################################
### CourseSheet ###
###################################################
package Apache::classcalc;
use strict;
use Apache::Constants qw(:common :http);
use Apache::loncoursedata;
use Apache::Spreadsheet;
use Apache::studentcalc;
use HTML::Entities();
use Spreadsheet::WriteExcel;
use Apache::lonnet;
use Time::HiRes;
@Apache::classcalc::ISA = ('Apache::Spreadsheet');
sub get_classlist {
my $self = shift;
# Retrieve the classlist
my @Students = ();
my ($classlist,$field_names) = &Apache::loncoursedata::get_classlist
($self->{'cid'},$self->{'cdom'},$self->{'cnum'});
while (my ($student,$student_data) = each (%$classlist)) {
my $studenthash = ();
for (my $i=0; $i< scalar(@$field_names);$i++) {
my $field = $field_names->[$i];
$studenthash->{$field}=$student_data->[$i];
}
# This is where we can skip students because they are in
# the wrong section, have expired or pending roles, whatever...
push (@Students,$studenthash);
}
return @Students;
}
sub gettitle {
my $self = shift;
my $title = '<h2>'.$self->{'coursedesc'}."</h2>\n";
# Section info should be included
return $title;
}
sub outsheet_html {
my $self = shift;
my ($r) = @_;
###################################
# Determine table structure
###################################
my $num_uneditable = 26;
my $num_left = 52-$num_uneditable;
my $tableheader =<<"END";
<table border="2">
<tr>
<th colspan="2" rowspan="2"><font size="+2">Course</font></th>
<td bgcolor="#FFDDDD" colspan="$num_uneditable">
<b><font size="+1">Import</font></b></td>
<td colspan="$num_left">
<b><font size="+1">Calculations</font></b></td>
</tr><tr>
END
my $label_num = 0;
foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){
if ($label_num<$num_uneditable) {
$tableheader.='<td bgcolor="#FFDDDD">';
} else {
$tableheader.='<td>';
}
$tableheader.="<b><font size=+1>$_</font></b></td>";
$label_num++;
}
$tableheader.="</tr>\n";
#
$r->print($tableheader);
#
# Print out template row
$r->print('<tr><td>Template</td><td> </td>'.
$self->html_row($num_uneditable,'-')."</tr>\n");
#
# Print out summary/export row
$r->print('<tr><td>Summary</td><td>0</td>'.
$self->html_row($num_uneditable,0)."</tr>\n");
$r->print("</table>\n");
#
# Prepare to output rows
$tableheader =<<"END";
<table border="2">
<tr><th></th>
<th>student</th><th>username</th><th>domain</th>
<th>section</th><th>status</th>
END
foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){
if ($label_num<$num_uneditable) {
$tableheader.='<td bgcolor="#FFDDDD">';
} else {
$tableheader.='<td>';
}
$tableheader.="<b><font size=+1>$_</font></b></td>";
}
#
my $num_output = 1;
foreach my $student ($self->get_classlist()) {
if ($num_output++ % 50 == 0) {
$r->print("</table>\n".$tableheader);
}
my $rownum = $self->get_row_number_from_key($student);
my $link = '<a href="/adm/studentcalc?sname='.$student->{'username'}.
'&sdomain='.$student->{'domain'}.'">';
$r->print('<tr>'.
'<td>'.$link.$student->{'fullname'}.'</a></td>'.
'<td>'.$student->{'username'}.'</td>'.
'<td>'.$student->{'domain'} .'</td>'.
'<td>'.$student->{'section'} .'</td>'.
'<td>'.$student->{'status'} .'</td>'.
$self->html_row($num_uneditable,$rownum)."</tr>\n");
}
$r->print("</table>\n");
return;
}
sub outsheet_csv {
my $self = shift;
my ($r) = @_;
}
sub outsheet_excel {
my $self = shift;
my ($r) = @_;
}
sub outsheet_recursive_excel {
my $self = shift;
my ($r) = @_;
}
sub display {
my $self = shift;
my ($r) = @_;
$self->compute();
# display as html/csv/excel/etc....
$self->outsheet_html($r);
return;
}
sub compute {
my $self = shift;
$self->initialize_safe_space();
&Apache::studentcalc::initialize_package();
foreach my $student ($self->get_classlist()) {
my $studentsheet = Apache::studentcalc->new
($student->{'username'},$student->{'domain'},undef);
my @exportdata = $studentsheet->export_data();
my $rownum = $self->get_row_number_from_key
($student->{'username'}.':'.$student->{'domain'});
# I really want to try doing the following assignment using
# hash and array slices....
my $i=0;
foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ')) {
$self->{'constants'}->{$_.$rownum}=$exportdata[$i++];
}
}
$self->calcsheet();
}
1;
__END__
Index: modules/matthew/spreadsheet/lonspreadsheet.pm
+++ modules/matthew/spreadsheet/lonspreadsheet.pm
#
# $Id: lonspreadsheet.pm,v 1.1 2003/04/09 20:57:56 matthew Exp $
#
# 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
# Spreadsheet/Grades Display Handler
#
# 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;
use strict;
use Apache::classcalc();
use Apache::studentcalc();
use Apache::assesscalc();
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::lonhtmlcommon;
use HTML::Entities();
##
## HTML utility subroutines really should go in lonhtmlcommon
##
sub textfield {
my ($title,$name,$value)=@_;
return "\n<p><b>$title:</b><br>".
'<input type=text name="'.$name.'" size=80 value="'.$value.'">';
}
sub hiddenfield {
my ($name,$value)=@_;
return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
}
sub selectbox {
my ($title,$name,$value,%options)=@_;
my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
foreach (sort keys(%options)) {
$selout.='<option value="'.$_.'"';
if ($_ eq $value) { $selout.=' selected'; }
$selout.='>'.$options{$_}.'</option>';
}
return $selout.'</select>';
}
sub handler {
my $r=shift;
#
# Overload checking
#
# Check this server
my $loaderror=&Apache::lonnet::overloaderror($r);
if ($loaderror) { return $loaderror; }
# Check the course homeserver
$loaderror= &Apache::lonnet::overloaderror($r,
$ENV{'course.'.$ENV{'request.course.id'}.'.home'});
if ($loaderror) { return $loaderror; }
#
# HTML Header
#
if ($r->header_only) {
$r->content_type('text/html');
$r->send_http_header;
return OK;
}
#
# Roles Checking
#
# Needs to be in a course
if (! $ENV{'request.course.fn'}) {
# Not in a course, or not allowed to modify parms
$ENV{'user.error.msg'}=
$r->uri.":opa:0:0:Cannot modify spreadsheet";
return HTTP_NOT_ACCEPTABLE;
}
#
# Get query string for limited number of parameters
#
&Apache::loncommon::get_unprocessed_cgi
($ENV{'QUERY_STRING'},['sname','sdomain','usymb','filename']);
#
# Deal with restricted student permissions
#
if ($ENV{'request.role'} =~ /^st\./) {
delete $ENV{'form.cell'} if (exists($ENV{'form.cell'}));
delete $ENV{'form.newformula'} if (exists($ENV{'form.newformula'}));
}
#
# Determine basic information about the spreadsheet
my ($sheettype) = ($r->uri=~/\/(\w+)$/);
#
my $symb = undef;
$symb = $ENV{'form.usymb'} if (exists($ENV{'form.usymb'}));
my $name = $ENV{'user.name'};
my $domain = $ENV{'user.domain'};
if (exists($ENV{'form.sname'})) {
$name = $ENV{'form.sname'};
$domain = $ENV{'form.sdomain'};
}
#
# Open page, try to prevent browser cache.
#
$r->content_type('text/html');
$r->header_out('Cache-control','no-cache');
$r->header_out('Pragma','no-cache');
$r->send_http_header;
#
# Header....
#
$r->print('<html><head><title>LON-CAPA Spreadsheet</title>');
my $nothing = &Apache::lonhtmlcommon::javascript_nothing();
if ($ENV{'request.role'} !~ /^st\./) {
$r->print(<<ENDSCRIPT);
<script language="JavaScript">
var editwin;
function celledit(cellname,cellformula) {
var edit_text = '';
// cellformula may contain less-than and greater-than symbols, so
// we need to escape them?
edit_text +='<html><head><title>Cell Edit Window</title></head><body>';
edit_text += '<form name="editwinform">';
edit_text += '<center><h3>Cell '+cellname+'</h3>';
edit_text += '<textarea name="newformula" cols="40" rows="6"';
edit_text += ' wrap="off" >'+cellformula+'</textarea>';
edit_text += '</br>';
edit_text += '<input type="button" name="accept" value="Accept"';
edit_text += ' onClick=\\\'javascript:';
edit_text += 'opener.document.sheet.unewfield.value=';
edit_text += '"'+cellname+'";';
edit_text += 'opener.document.sheet.unewformula.value=';
edit_text += 'document.editwinform.newformula.value;';
edit_text += 'opener.document.sheet.submit();';
edit_text += 'self.close()\\\' />';
edit_text += ' ';
edit_text += '<input type="button" name="abort" ';
edit_text += 'value="Discard Changes"';
edit_text += ' onClick="javascript:self.close()" />';
edit_text += '</center></body></html>';
if (editwin != null && !(editwin.closed) ) {
editwin.close();
}
editwin = window.open($nothing,'CellEditWin','height=200,width=350,scrollbars=no,resizeable=yes,alwaysRaised=yes,dependent=yes',true);
editwin.document.write(edit_text);
}
</script>
ENDSCRIPT
}
$r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet').
'<form action="'.$r->uri.'" name="sheet" method="post">');
$r->print(&hiddenfield('name' ,$ENV{'form.sname'}).
&hiddenfield('domain',$ENV{'form.sdomain'}).
&hiddenfield('symb' ,$ENV{'form.usymb'}).
&hiddenfield('cell' ,'').
&hiddenfield('newformula',''));
$r->rflush();
#
my $spreadsheet = undef;
if ($sheettype eq 'classcalc') {
$spreadsheet = Apache::classcalc->new($name,$domain,
$symb);
} elsif ($sheettype eq 'studentcalc') {
$spreadsheet = Apache::studentcalc->new($name,$domain,
$symb);
} elsif ($sheettype eq 'assesscalc') {
$spreadsheet = Apache::assesscalc->new($name,$domain,
$symb);
} else {
&Apache::lonnet::logthis('Unable to determine spreadsheet type');
}
if (defined($spreadsheet)) {
$spreadsheet->display($r);
}
$r->print('</form></body></html>');
return OK;
}
1;
__END__
Index: modules/matthew/spreadsheet/studentcalc.pm
+++ modules/matthew/spreadsheet/studentcalc.pm
#
# $Id: studentcalc.pm,v 1.1 2003/04/09 20:57:56 matthew Exp $
#
# 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
# Spreadsheet/Grades Display Handler
#
# POD required stuff:
=head1 NAME
studentcalc
=head1 SYNOPSIS
=head1 DESCRIPTION
=over 4
=cut
###################################################
### StudentSheet ###
###################################################
package Apache::studentcalc;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::lonnavmaps;
use Apache::Spreadsheet;
use Apache::assesscalc;
use HTML::Entities();
use Spreadsheet::WriteExcel;
use Time::HiRes;
@Apache::studentcalc::ISA = ('Apache::Spreadsheet');
my @Sequences = ();
my %Exportrows = ();
sub initialize_package {
#
# Set up the sequences and assessments
@Sequences = ();
my ($top,$sequences,$assessments) =
&Apache::loncoursedata::get_sequence_assessment_data();
if (! defined($top) || ! ref($top)) {
# There has been an error, better report it
&Apache::lonnet::logthis('top is undefined');
return;
}
@Sequences = @{$sequences} if (ref($sequences) eq 'ARRAY');
############################
## Set up the export rows ##
############################
%Exportrows = undef;
my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets',
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
$ENV{'request.course.id'},,undef);
if ($tmp[0]!~/^error/) {
my %tmp = @tmp;
# We only got one key, so we will access it directly.
while (my ($key,$sheetdata) = each(%tmp)) {
my ($sname,$sdom,$sheettype,$remainder) = split(':',$key);
my $student = $sname.':'.$sdom;
if ($remainder =~ /\.time/) {
$Exportrows{$student}->{'time'} = $sheetdata;
} else {
$sheetdata =~ s/^___=___//;
$Exportrows{$student}->{'data'} = {split('___;___',$sheetdata)};
}
}
}
}
sub clear_package {
@Sequences = undef;
%Exportrows = undef;
}
sub export_sheet_as_excel {} # spreadsheet, overridden by student
sub gettitle {}
sub exportrow {}
sub outsheet_html {
my $self = shift;
my ($r) = @_;
###################################
# Determine table structure
###################################
my $num_uneditable = 26;
my $num_left = 52-$num_uneditable;
my $tableheader =<<"END";
<table border="2">
<tr>
<th colspan="2" rowspan="2"><font size="+2">Student</font></th>
<td bgcolor="#FFDDDD" colspan="$num_uneditable">
<b><font size="+1">Import</font></b></td>
<td colspan="$num_left">
<b><font size="+1">Calculations</font></b></td>
</tr><tr>
END
my $label_num = 0;
foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){
if ($label_num<$num_uneditable) {
$tableheader .='<td bgcolor="#FFDDDD">';
} else {
$tableheader .='<td>';
}
$tableheader .="<b><font size=+1>$_</font></b></td>";
$label_num++;
}
$tableheader .="</tr>\n";
#
$r->print($tableheader);
#
# Print out template row
$r->print('<tr><td>Template</td><td> </td>'.
$self->html_row($num_uneditable,'-')."</tr>\n");
#
# Print out summary/export row
$r->print('<tr><td>Export</td><td>0</td>'.
$self->html_row($num_uneditable,0)."</tr>\n");
$r->print("</table>\n");
#
# Prepare to output rows
$tableheader =<<"END";
<table border="2">
<tr><th>Row</th><th>Assessment</th>
END
foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){
if ($label_num<$num_uneditable) {
$tableheader.='<td bgcolor="#FFDDDD">';
} else {
$tableheader.='<td>';
}
$tableheader.="<b><font size=+1>$_</font></b></td>";
}
#
my $num_output = 1;
if (scalar(@Sequences)< 1) {
&initialize_package();
}
&Apache::lonnet::logthis('number of sequences:'.(scalar(@Sequences)));
foreach my $Sequence (@Sequences) {
next if ($Sequence->{'num_assess'} < 1);
$r->print("<h2>".$Sequence->{'title'}."</h2>\n");
$r->print($tableheader);
foreach my $resource (@{$Sequence->{'contents'}}) {
next if ($resource->{'type'} ne 'assessment');
my $rownum = $self->get_row_number_from_key($resource->{'symb'});
$r->print('<tr><td>'.$rownum.'</td>'.
'<td>'.
'<a href="/adm/assesscalc?sname='.$self->{'name'}.
'&sdomain='.$self->{'domain'}.
'&usymb='.$resource->{'symb'}.'">'.
$resource->{'title'}.'</a></td>'.
$self->html_row($num_uneditable,$rownum)."</tr>\n");
}
$r->print("</table>\n");
}
return;
}
sub outsheet_csv {
my $self = shift;
my ($r) = @_;
}
sub outsheet_excel {
my $self = shift;
my ($r) = @_;
}
sub outsheet_recursive_excel {
my $self = shift;
my ($r) = @_;
}
sub display {
my $self = shift;
my ($r) = @_;
$self->compute();
$self->outsheet_html($r);
return;
}
sub compute {
my $self = shift;
$self->initialize_safe_space();
my @sequences = @Sequences;
if (@sequences < 1) {
my ($top,$sequences,$assessments) =
&Apache::loncoursedata::get_sequence_assessment_data();
if (! defined($top) || ! ref($top)) {
# There has been an error, better report it
&Apache::lonnet::logthis('top is undefined');
return;
}
@sequences = @{$sequences} if (ref($sequences) eq 'ARRAY');
}
&Apache::lonnet::logthis('num seq = '.(scalar(@sequences)));
&Apache::assesscalc::initialize_package($self->{'name'},
$self->{'domain'});
foreach my $seq (@sequences) {
next if ($seq->{'num_assess'}<1);
foreach my $resource (@{$seq->{'contents'}}) {
next if ($resource->{'type'} ne 'assessment');
my $assessSheet = Apache::assesscalc->new
($self->{'name'},$self->{'domain'},$resource->{'symb'});
my @exportdata = $assessSheet->export_data();
my $rownum = $self->get_row_number_from_key
($self->{'name'}.':'.$self->{'domain'});
# I really want to try doing the following assignment using
# hash and array slices....
my $i=0;
foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ')) {
$self->{'constants'}->{$_.$rownum}=$exportdata[$i++];
}
}
}
$self->calcsheet();
#
# Store export row in cache
my @exportarray=();
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') {
push(@exportarray,$self->value($_.'0'));
}
my $student = $self->{'name'}.':'.$self->{'domain'};
$Exportrows{$student}->{'time'} = time;
$Exportrows{$student}->{'data'} = \@exportarray;
# save export row
return;
}
sub save_export_data {
my $self = shift;
my $student = $self->{'name'}.':'.$self->{'domain'};
return if (! exists($Exportrows{$student}));
my $key = join(':',($self->{'name'},$self->{'domain'},'studentcalc')).':';
my $timekey = $key.'.time';
my $newstore = join('___;___',
@{$Exportrows{$student}->{'data'}});
$newstore = '___=___'.$newstore;
&Apache::lonnet::put('nohist_calculatedsheets',
{ $key => $newstore,
$timekey => $Exportrows{$student}->{'time'} },
$self->{'cdom'},
$self->{'cnum'});
return;
}
sub export_data {
my $self = shift;
my $student = $self->{'name'}.':'.$self->{'domain'};
if (! exists($Exportrows{$student}) ||
! $self->check_expiration_time($Exportrows{$student}->{'time'})) {
$self->compute();
}
return @{$Exportrows{$student}->{'data'}};
}
1;
__END__
--matthew1049921877--