File:
[LON-CAPA] /
loncom /
interface /
Attic /
lonspreadsheet.pm
Revision
1.176:
download - view:
text,
annotated -
select for diffs
Mon Mar 10 20:21:45 2003 UTC (21 years, 5 months ago) by
matthew
Branches:
MAIN
CVS tags:
HEAD
Created loncommon::decode_user_agent() subroutine with code removed from
lonauth.pm. The code was modified to not require $r be passed along
ad nauseum.
Created lonhtmlcommon::javascript_nothing which returns an appropriate value
of nothing for use as the first parameter for window.open. Most notably,
IE on macs get a different version, "'javascript:void(0);'", than everyone
one else, "''". Of course IE on PC appearantly used to require the former
but now requires the latter.
lonmenu.pm and lonspreadsheet.pm were modified to use javascript_nothing.
lonauth was modified to use decode_user_agent.
#
# $Id: lonspreadsheet.pm,v 1.176 2003/03/10 20:21:45 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::Constants qw(:common :http);
use Apache::lonnet;
use Apache::lonhtmlcommon;
use HTML::Entities();
# --------------------------------------------------------- Various form fields
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>';
}
my %oldsheets;
my %loadedcaches;
# ================================================================ Main handler
#
# Interactive call to screen
#
#
sub handler {
my $r=shift;
my ($sheettype) = ($r->uri=~/\/(\w+)$/);
if (! exists($ENV{'form.Status'})) {
$ENV{'form.Status'} = 'Active';
}
if ( ! exists($ENV{'form.output'}) ||
($sheettype ne 'classcalc' &&
lc($ENV{'form.output'}) eq 'recursive excel')) {
$ENV{'form.output'} = 'HTML';
}
#
# 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'},['uname','udom','usymb','ufn','mapid','resid']);
#
# Deal with restricted student permissions
#
if ($ENV{'request.role'} =~ /^st\./) {
delete $ENV{'form.unewfield'} if (exists($ENV{'form.unewfield'}));
delete $ENV{'form.unewformula'} if (exists($ENV{'form.unewformula'}));
}
#
# Look for special assessment spreadsheets - '_feedback', etc.
#
if (($ENV{'form.usymb'}=~/^\_(\w+)/) && (!$ENV{'form.ufn'} ||
$ENV{'form.ufn'} eq '' ||
$ENV{'form.ufn'} eq 'default')) {
$ENV{'form.ufn'}='default_'.$1;
}
if (!$ENV{'form.ufn'} || $ENV{'form.ufn'} eq 'default') {
$ENV{'form.ufn'}='course_default_'.$sheettype;
}
#
# Interactive loading of specific sheet?
#
if (($ENV{'form.load'}) && ($ENV{'form.loadthissheet'} ne 'Default')) {
$ENV{'form.ufn'}=$ENV{'form.loadthissheet'};
}
#
# Determine the user name and domain for the sheet.
my $aname;
my $adom;
unless ($ENV{'form.uname'}) {
$aname=$ENV{'user.name'};
$adom=$ENV{'user.domain'};
} else {
$aname=$ENV{'form.uname'};
$adom=$ENV{'form.udom'};
}
#
# 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);
}
function changesheet(cn) {
document.sheet.unewfield.value=cn;
document.sheet.unewformula.value='changesheet';
document.sheet.submit();
}
function insertrow(cn) {
document.sheet.unewfield.value='insertrow';
document.sheet.unewformula.value=cn;
document.sheet.submit();
}
</script>
ENDSCRIPT
}
$r->print('</head>'.&Apache::loncommon::bodytag('Grades Spreadsheet').
'<form action="'.$r->uri.'" name="sheet" method="post">');
$r->print(&hiddenfield('uname',$ENV{'form.uname'}).
&hiddenfield('udom',$ENV{'form.udom'}).
&hiddenfield('usymb',$ENV{'form.usymb'}).
&hiddenfield('unewfield','').
&hiddenfield('unewformula',''));
$r->rflush();
#
# Full recalc?
#
# Read new sheet or modified worksheet
my $sheet=Apache::lonspreadsheet::Spreadsheet->new($aname,$adom,$sheettype,$ENV{'form.usymb'});
if ($ENV{'form.forcerecalc'}) {
$r->print('<h4>Completely Recalculating Sheet ...</h4>');
$sheet->complete_recalc();
}
#
# Global directory configs
#
$sheet->includedir($r->dir_config('lonIncludes'));
#
# Check user permissions
if (($sheet->{'type'} eq 'classcalc' ) ||
($sheet->{'uname'} ne $ENV{'user.name'} ) ||
($sheet->{'udom'} ne $ENV{'user.domain'})) {
unless (&Apache::lonnet::allowed('vgr',$sheet->{'cid'})) {
$r->print('<h1>Access Permission Denied</h1>'.
'</form></body></html>');
return OK;
}
}
# Print out user information
$r->print('<h2>'.$sheet->{'coursedesc'}.'</h2>');
if ($sheet->{'type'} ne 'classcalc') {
$r->print('<h2>'.$sheet->gettitle().'</h2><p>');
}
if ($sheet->{'type'} eq 'assesscalc') {
$r->print('<b>User:</b> '.$sheet->{'uname'}.
'<br /><b>Domain:</b> '.$sheet->{'udom'}.'<br />');
}
if ($sheet->{'type'} eq 'studentcalc' ||
$sheet->{'type'} eq 'assesscalc') {
$r->print('<b>Section/Group:</b>'.$sheet->{'csec'}.'</p>');
}
#
# If a new formula had been entered, go from work copy
if ($ENV{'form.unewfield'}) {
$r->print('<h2>Modified Workcopy</h2>');
#$ENV{'form.unewformula'}=~s/\'/\"/g;
$r->print('<p>Cell '.$ENV{'form.unewfield'}.' = <pre>');
$r->print(&HTML::Entities::encode($ENV{'form.unewformula'}).
'</pre></p>');
$sheet->{'filename'} = $ENV{'form.ufn'};
$sheet->tmpread($ENV{'form.unewfield'},$ENV{'form.unewformula'});
} elsif ($ENV{'form.saveas'}) {
$sheet->{'filename'} = $ENV{'form.ufn'};
$sheet->tmpread();
} else {
$sheet->readsheet($ENV{'form.ufn'});
}
# Additional options
if ($sheet->{'type'} eq 'assesscalc') {
$r->print('<p><font size=+2>'.
'<a href="/adm/studentcalc?'.
'uname='.$sheet->{'uname'}.
'&udom='.$sheet->{'udom'}.'">'.
'Level up: Student Sheet</a></font></p>');
}
if (($sheet->{'type'} eq 'studentcalc') &&
(&Apache::lonnet::allowed('vgr',$sheet->{'cid'}))) {
$r->print ('<p><font size=+2><a href="/adm/classcalc">'.
'Level up: Course Sheet</a></font></p>');
}
# Recalc button
$r->print('<br />'.
'<input type="submit" name="forcerecalc" '.
'value="Completely Recalculate Sheet"></p>');
# Save dialog
if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
my $fname=$ENV{'form.ufn'};
$fname=~s/\_[^\_]+$//;
if ($fname eq 'default') { $fname='course_default'; }
$r->print('<input type=submit name=saveas value="Save as ...">'.
'<input type=text size=20 name=newfn value="'.$fname.'">'.
'make default: <input type=checkbox name="makedefufn"><p>');
}
$r->print(&hiddenfield('ufn',$sheet->{'filename'}));
# Load dialog
if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
$r->print('<p><input type=submit name=load value="Load ...">'.
'<select name="loadthissheet">'.
'<option name="default">Default</option>');
foreach ($sheet->othersheets()) {
$r->print('<option name="'.$_.'"');
if ($ENV{'form.ufn'} eq $_) {
$r->print(' selected');
}
$r->print('>'.$_.'</option>');
}
$r->print('</select><p>');
if ($sheet->{'type'} eq 'studentcalc') {
$sheet->setothersheets($sheet->othersheets('assesscalc'));
}
}
#
# Set up caching mechanisms
#
&Apache::lonspreadsheet::Spreadsheet::load_spreadsheet_expirationdates();
# Clear out old caches if we have not seen this class before.
if (exists($oldsheets{'course'}) &&
$oldsheets{'course'} ne $sheet->{'cid'}) {
undef %oldsheets;
undef %loadedcaches;
}
$oldsheets{'course'} = $sheet->{'cid'};
#
if ($sheet->{'type'} eq 'classcalc') {
$r->print("Loading previously calculated student sheets ...\n");
$r->rflush();
&Apache::lonspreadsheet::Spreadsheet::cachedcsheets();
} elsif ($sheet->{'type'} eq 'studentcalc') {
$r->print("Loading previously calculated assessment sheets ...\n");
$r->rflush();
$sheet->cachedssheets();
}
# Update sheet, load rows
$r->print("Loaded sheet(s), updating rows ...<br>\n");
$r->rflush();
#
$sheet->updatesheet();
$r->print("Updated rows, loading row data ...\n");
$r->rflush();
#
$sheet->loadrows($r);
$r->print("Loaded row data, calculating sheet ...<br>\n");
$r->rflush();
#
my $calcoutput=$sheet->calcsheet();
$r->print('<h3><font color=red>'.$calcoutput.'</h3></font>');
# See if something to save
if (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'})) {
my $fname='';
if ($ENV{'form.saveas'} && ($fname=$ENV{'form.newfn'})) {
$fname=~s/\W/\_/g;
if ($fname eq 'default') { $fname='course_default'; }
$fname.='_'.$sheet->{'type'};
$sheet->{'filename'} = $fname;
$ENV{'form.ufn'}=$fname;
$r->print('<p>Saving spreadsheet: '.
$sheet->writesheet($ENV{'form.makedefufn'}).
'<p>');
}
}
#
# Write the modified worksheet
$r->print('<b>Current sheet:</b> '.$sheet->{'filename'}.'</p>');
$sheet->tmpwrite();
if ($sheet->{'type'} eq 'assesscalc') {
$r->print('<p>Show rows with empty A column: ');
} else {
$r->print('<p>Show empty rows: ');
}
#
$r->print(&hiddenfield('userselhidden','true').
'<input type="checkbox" name="showall" onClick="submit()"');
#
if ($ENV{'form.showall'}) {
$r->print(' checked');
} else {
unless ($ENV{'form.userselhidden'}) {
unless
($ENV{'course.'.$sheet->{'cid'}.'.hideemptyrows'} eq 'yes') {
$r->print(' checked');
$ENV{'form.showall'}=1;
}
}
}
$r->print('>');
#
# output format select box
$r->print(' Output as <select name="output" size="1" onChange="submit()">'.
"\n");
foreach my $mode (qw/HTML CSV Excel/) {
$r->print('<option value="'.$mode.'"');
if ($ENV{'form.output'} eq $mode) {
$r->print(' selected ');
}
$r->print('>'.$mode.'</option>'."\n");
}
#
# Mulit-sheet excel takes too long and does not work at all for large
# classes. Future inclusion of this option may be possible with the
# Spreadsheet::WriteExcel::Big and speed improvements.
#
# if ($sheet->{'type'} eq 'classcalc') {
# $r->print('<option value="recursive excel"');
# if ($ENV{'form.output'} eq 'recursive excel') {
# $r->print(' selected ');
# }
# $r->print(">Multi-Sheet Excel</option>\n");
# }
$r->print("</select>\n");
#
if ($sheet->{'type'} eq 'classcalc') {
$r->print(' Student Status: '.
&Apache::lonhtmlcommon::StatusOptions
($ENV{'form.Status'},'sheet'));
}
#
# Buttons to insert rows
# $r->print(<<ENDINSERTBUTTONS);
#<br>
#<input type='button' onClick='insertrow("top");'
#value='Insert Row Top'>
#<input type='button' onClick='insertrow("bottom");'
#value='Insert Row Bottom'><br>
#ENDINSERTBUTTONS
# Print out sheet
$sheet->outsheet($r);
$r->print('</form></body></html>');
# Done
return OK;
}
1;
#############################################################
#############################################################
#############################################################
package Apache::lonspreadsheet::Spreadsheet;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::loncoursedata;
use Apache::File();
use Safe;
use Safe::Hole;
use Opcode;
use GDBM_File;
use HTML::Entities();
use HTML::TokeParser;
use Spreadsheet::WriteExcel;
use Time::HiRes;
#
# These global hashes are dependent on user, course and resource,
# and need to be initialized every time when a sheet is calculated
#
my %courseopt;
my %useropt;
my %parmhash;
#
# Caches for coursewide information
#
my %Section;
#
# Caches for previously calculated spreadsheets
#
my %expiredates;
#
# Cache for stores of an individual user
#
my $cachedassess;
my %cachedstores;
#
# Some hashes for stats on timing and performance
#
my %starttimes;
my %usedtimes;
my %numbertimes;
#
# Directories
#
my $includedir;
sub includedir {
my $self = shift;
$includedir = shift;
}
my %spreadsheets;
#my %loadedcaches;
my %courserdatas;
my %userrdatas;
my %defaultsheets;
my %rowlabel_cache;
#my %oldsheets;
sub complete_recalc {
my $self = shift;
undef %spreadsheets;
undef %courserdatas;
undef %userrdatas;
undef %defaultsheets;
undef %rowlabel_cache;
}
sub get_sheet {
my $self = shift;
my $sheet_id = shift;
my $formulas;
# if we already have the file loaded and parsed, return the formulas
if (exists($self->{'sheets'}->{$sheet_id})) {
$formulas = $self->{'sheets'}->{$sheet_id};
$self->debug('retrieved '.$sheet_id);
} else {
# load the file
# set $error and return undef if there is an error loading
# parse it
# set $error and return undef if there is an error parsing
}
return $formulas;
}
#
# Load previously cached student spreadsheets for this course
#
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;
}
}
# ===================================================== Calculated sheets cache
#
# Load previously cached student spreadsheets for this course
#
sub cachedcsheets {
my $cid=$ENV{'request.course.id'};
my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets',
$ENV{'course.'.$cid.'.domain'},
$ENV{'course.'.$cid.'.num'});
if ($tmp[0] !~ /^error/) {
my %StupidTempHash = @tmp;
while (my ($key,$value) = each %StupidTempHash) {
$Apache::lonspreadsheet::oldsheets{$key} = $value;
}
}
}
#
# Load previously cached assessment spreadsheets for this student
#
sub cachedssheets {
my $self = shift;
my ($uname,$udom) = @_;
$uname = $uname || $self->{'uname'};
$udom = $udom || $self->{'udom'};
if (! exists($Apache::lonspreadsheet::loadedcaches{$uname.'_'.$udom})) {
my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets_'.
$ENV{'request.course.id'},
$self->{'udom'},
$self->{'uname'});
if ($tmp[0] !~ /^error/) {
my %TempHash = @tmp;
my $count = 0;
while (my ($key,$value) = each %TempHash) {
$Apache::lonspreadsheet::oldsheets{$key} = $value;
$count++;
}
$Apache::lonspreadsheet::loadedcaches{$self->{'uname'}.'_'.$self->{'udom'}}=1;
}
}
}
# ======================================================= Forced recalculation?
sub checkthis {
my ($keyname,$time)=@_;
if (! exists($expiredates{$keyname})) {
return 0;
} else {
return ($time<$expiredates{$keyname});
}
}
sub forcedrecalc {
my ($uname,$udom,$stype,$usymb)=@_;
my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
my $time=$Apache::lonspreadsheet::oldsheets{$key.'.time'};
if ($ENV{'form.forcerecalc'}) { return 1; }
unless ($time) { return 1; }
if ($stype eq 'assesscalc') {
my $map=(split(/___/,$usymb))[0];
if (&checkthis('::assesscalc:',$time) ||
&checkthis('::assesscalc:'.$map,$time) ||
&checkthis('::assesscalc:'.$usymb,$time) ||
&checkthis($uname.':'.$udom.':assesscalc:',$time) ||
&checkthis($uname.':'.$udom.':assesscalc:'.$map,$time) ||
&checkthis($uname.':'.$udom.':assesscalc:'.$usymb,$time)) {
return 1;
}
} else {
if (&checkthis('::studentcalc:',$time) ||
&checkthis($uname.':'.$udom.':studentcalc:',$time)) {
return 1;
}
}
return 0;
}
##################################################
##################################################
=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 ($what,$symb,$uname,$udom,$csec)=@_;
return '' if (!$symb);
#
my $cid = $ENV{'request.course.id'};
my $result='';
#
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.'_'.$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;
# 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=&parmval($newwhat,$symb,$uname,$udom,$csec);
if (defined($partgeneral)) { return $partgeneral; }
}
#nothing defined
return '';
}
#
# new: Make a new spreadsheet
#
sub new {
my $this = shift;
my $class = ref($this) || $this;
#
my ($uname,$udom,$stype,$usymb)=@_;
#
my $self = {
uname => $uname,
udom => $udom,
type => $stype,
usymb => $usymb,
errorlog => '',
maxrow => '',
mapid => $ENV{'form.mapid'},
resid => $ENV{'form.resid'},
cid => $ENV{'request.course.id'},
csec => $Section{$uname.':'.$udom},
cnum => $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
cdom => $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
chome => $ENV{'course.'.$ENV{'request.course.id'}.'.home'},
coursefilename => $ENV{'request.course.fn'},
coursedesc => $ENV{'course.'.$ENV{'request.course.id'}.'.description'},
rows => [],
template_cells => [],
};
$self->{'uhome'} = &Apache::lonnet::homeserver($uname,$udom);
#
#
$self->{'formulas'} = {};
$self->{'constants'} = {};
$self->{'othersheets'} = [];
$self->{'rowlabel'} = {};
#
#
$self->{'safe'} = &initsheet($self->{'type'});
$self->{'root'} = $self->{'safe'}->root();
#
# Place some of the %$self items into the safe space except the safe space
# itself
my $initstring = '';
foreach (qw/uname udom type usymb cid csec coursefilename
cnum cdom chome uhome/) {
$initstring.= qq{\$$_="$self->{$_}";};
}
$self->{'safe'}->reval($initstring);
bless($self,$class);
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 {
my $self = shift;
my $code = <<'END';
#-------------------------------------------------------
=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(%sheet_values);
@Keys = $sheet_values{@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(%sheet_values);
@Values =$sheet_values{@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 = $sheet_values{$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(%sheet_values);
@Keys = $sheet_values{@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(%sheet_values);
@Values =$sheet_values{@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];
}
END
$self->{'safe'}->reval($code);
return;
}
sub initsheet {
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
$uname = '';
$uhome = '';
$udom = '';
# course data
$csec = '';
$chome= '';
$cnum = '';
$cdom = '';
$cid = '';
$coursefilename = '';
# symb
$usymb = '';
# error messages
$errormsg = '';
#-------------------------------------------------------
=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;
}
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;
}
#-------------------------------------------------------
=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;
}
#-------------------------------------------------------
=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;
}
}
#-------------------------------------------------------
=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));
}
#-------------------------------------------------------
=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;
}
#-------------------------------------------------------
=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;
}
#-------------------------------------------------------
=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;
}
#-------------------------------------------------------
=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;
}
#-------------------------------------------------------
=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;
}
#-------------------------------------------------------
=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;
}
#-------------------------------------------------------
=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);
return $safeeval;
}
#
# 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 used to reside in the safe space
#
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;
}
###########################################
### Row output routines ###
###########################################
#
# get_row: Produce output row n from sheet by calling the appropriate routine
#
sub get_row {
my $self = shift;
my ($n) = @_;
my ($rowlabel,@rowdata);
if ($n eq '-') {
($rowlabel,@rowdata) = $self->templaterow();
} elsif ($self->{'type'} eq 'studentcalc') {
($rowlabel,@rowdata) = $self->outrowassess($n);
} else {
($rowlabel,@rowdata) = $self->outrow($n);
}
return ($rowlabel,@rowdata);
}
sub templaterow {
my $self = shift;
my @cols=();
my $rowlabel = 'Template</td><td> ';
foreach my $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') {
push(@cols,{ name => 'template_'.$_,
formula => $self->formula('template_'.$n),
value => $self->value('template_'.$n) });
}
return ($rowlabel,@cols);
}
sub outrowassess {
my $self = shift;
# $n is the current row number
my ($n) = @_;
my @cols=();
my $rowlabel='';
if ($n) {
my ($usy,$ufn)=split(/__&&&\__/,$self->formula('A'.$n));
if (exists($self->{'rowlabel'}->{$usy})) {
# This is dumb, but we need the information when we output
# the html version of the studentcalc spreadsheet for the
# links to the assesscalc sheets.
$rowlabel = $self->{'rowlabel'}->{$usy}.':'.
&Apache::lonnet::escape($ufn);
} else {
$rowlabel = '';
}
} elsif ($ENV{'request.role'} =~ /^st\./) {
$rowlabel = 'Summary</td><td>0';
} else {
$rowlabel = 'Export</td><td>0';
}
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 ($rowlabel,@cols);
}
sub outrow {
my $self = shift;
my ($n)=@_;
my @cols=();
my $rowlabel;
if ($n) {
$rowlabel = $self->{'rowlabel'}->{$self->formula('A'.$n)};
} else {
if ($self->{'type'} eq 'classcalc') {
$rowlabel = 'Summary</td><td>0';
} else {
$rowlabel = 'Export</td><td>0';
}
}
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 ($rowlabel,@cols);
}
########################################################
#### Spreadsheet calculation methods #####
########################################################
#
# 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;
}
##
## 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'} = '';
}
########################################################
#### Spreadsheet content retrieval/setting methods #####
########################################################
##
## 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'}};
}
}
##
## 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->{'uname'}.':'.$self->{'udom'}.':'.
$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('---------------------------- (entries end with ":"');
while (my ($key,$val) = each (%tmp)) {
$self->logthis($key.' = '.$val.':');
}
$self->logthis('---------------------------- (entries end with ":"');
}
################################
## Helper functions ##
################################
##
## 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 (!@{$self->{'template_cells'}});
return @{$self->{'template_cells'}};
}
##
## 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'}};
}
##
## Sigh....
##
sub setothersheets {
my $self = shift;
my @othersheets = @_;
$self->{'othersheets'} = \@othersheets;
}
##
## rowlabels: get or set the rowlabels hash from the spreadsheet.
##
sub rowlabels {
my $self = shift;
my ($rowlabel) = @_;
if (defined($rowlabel)) {
if (! ref($rowlabel)) {
my %tmp = @_;
$rowlabel = \%tmp;
}
$self->{'rowlabel'}=$rowlabel;
return;
} else {
return %{$self->{'rowlabel'}} if (defined($self->{'rowlabel'}));
}
}
##
## gettitle: returns a title for the spreadsheet.
##
sub gettitle {
my $self = shift;
if ($self->{'type'} eq 'classcalc') {
return $self->{'coursedesc'};
} elsif ($self->{'type'} eq 'studentcalc') {
return 'Grades for '.$self->{'uname'}.'@'.$self->{'udom'};
} elsif ($self->{'type'} eq 'assesscalc') {
if (($self->{'usymb'} eq '_feedback') ||
($self->{'usymb'} eq '_evaluation') ||
($self->{'usymb'} eq '_discussion') ||
($self->{'usymb'} eq '_tutoring')) {
my $title = $self->{'usymb'};
$title =~ s/^_//;
$title = ucfirst($title);
return $title;
}
return if (! defined($self->{'mapid'}) ||
$self->{'mapid'} !~ /^\d+$/);
my $mapid = $self->{'mapid'};
return if (! defined($self->{'resid'}) ||
$self->{'resid'} !~ /^\d+$/);
my $resid = $self->{'resid'};
my %course_db;
tie(%course_db,'GDBM_File',$self->{'coursefilename'}.'.db',
&GDBM_READER(),0640);
return if (! tied(%course_db));
my $key = 'title_'.$mapid.'.'.$resid;
my $title = '';
if (exists($course_db{$key})) {
$title = $course_db{$key};
} else {
$title = $self->{'usymb'};
}
untie (%course_db);
return $title;
}
}
#
# Export of A-row
#
sub exportdata {
my $self=shift;
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'));
}
return @exportarray;
}
##
## update_student_sheet: experimental function
##
sub update_student_sheet{
my $self = shift;
my ($r,$c) = @_;
# Load in the studentcalc sheet
$self->readsheet('default_studentcalc');
# Determine the structure (contained assessments, etc) of the sheet
$self->updatesheet();
# Load in the cached sheets for this student
$self->cachedssheets();
# Load in the (possibly cached) data from the assessment sheets
$self->loadstudent($r,$c);
# Compute the sheet
$self->calcsheet();
}
#
# sort_indicies: returns an ordered list of the rows of the spreadsheet
#
sub sort_indicies {
my $self = shift;
my @sortidx=();
#
if ($self->{'type'} eq 'classcalc') {
my @sortby=(undef);
# Skip row 0
for (my $row=1;$row<=$self->{'maxrow'};$row++) {
my (undef,$sname,$sdom,$fullname,$section,$id) =
split(':',$self->{'rowlabel'}->{$self->formula('A'.$row)});
push (@sortby, lc($fullname));
push (@sortidx, $row);
}
@sortidx = sort { $sortby[$a] cmp $sortby[$b]; } @sortidx;
} elsif ($self->{'type'} eq 'studentcalc') {
my @sortby1=(undef);
my @sortby2=(undef);
# Skip row 0
for (my $row=1;$row<=$self->{'maxrow'};$row++) {
my ($key,undef) = split(/__&&&\__/,$self->formula('A'.$row));
my $rowlabel = $self->{'rowlabel'}->{$key};
my (undef,$symb,$mapid,$resid,$title,$ufn) =
split(':',$rowlabel);
$ufn = &Apache::lonnet::unescape($ufn);
$symb = &Apache::lonnet::unescape($symb);
$title = &Apache::lonnet::unescape($title);
my ($sequence) = ($symb =~ /\/([^\/]*\.sequence)/);
if ($sequence eq '') {
$sequence = $symb;
}
push (@sortby1, $sequence);
push (@sortby2, $title);
push (@sortidx, $row);
}
@sortidx = sort { $sortby1[$a] cmp $sortby1[$b] ||
$sortby2[$a] cmp $sortby2[$b] } @sortidx;
} else {
my @sortby=(undef);
# Skip row 0
$self->sync_safe_space();
for (my $row=1;$row<=$self->{'maxrow'};$row++) {
push (@sortby, $self->{'safe'}->reval('$f{"A'.$row.'"}'));
push (@sortidx, $row);
}
@sortidx = sort { $sortby[$a] cmp $sortby[$b]; } @sortidx;
}
return @sortidx;
}
#############################################################
### ###
### Spreadsheet Output Routines ###
### ###
#############################################################
############################################
## 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 outsheet_html {
my $self = shift;
my ($r) = @_;
my ($num_uneditable,$realm,$row_type);
my $requester_is_student = ($ENV{'request.role'} =~ /^st\./);
if ($self->{'type'} eq 'assesscalc') {
$num_uneditable = 1;
$realm = 'Assessment';
$row_type = 'Item';
} elsif ($self->{'type'} eq 'studentcalc') {
$num_uneditable = 26;
$realm = 'User';
$row_type = 'Assessment';
} elsif ($self->{'type'} eq 'classcalc') {
$num_uneditable = 26;
$realm = 'Course';
$row_type = 'Student';
} else {
return; # error
}
####################################
# Print out header table
####################################
my $num_left = 52-$num_uneditable;
my $tabledata =<<"END";
<table border="2">
<tr>
<th colspan="2" rowspan="2"><font size="+2">$realm</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) {
$tabledata.='<td bgcolor="#FFDDDD">';
} else {
$tabledata.='<td>';
}
$tabledata.="<b><font size=+1>$_</font></b></td>";
$label_num++;
}
$tabledata.="</tr>\n";
$r->print($tabledata);
####################################
# Print out template row
####################################
my ($num_cols_output,$row_html,$rowlabel,@rowdata);
if (! $requester_is_student) {
($rowlabel,@rowdata) = $self->get_row('-');
$row_html = '<tr><td>'.$self->format_html_rowlabel($rowlabel).'</td>';
$num_cols_output = 0;
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>';
}
$row_html.= "</tr>\n";
$r->print($row_html);
}
####################################
# Print out summary/export row
####################################
($rowlabel,@rowdata) = $self->get_row('0');
$row_html = '<tr><td>'.$self->format_html_rowlabel($rowlabel).'</td>';
$num_cols_output = 0;
foreach my $cell (@rowdata) {
if ($num_cols_output++ < 26 && ! $requester_is_student) {
$row_html .= '<td bgcolor="#CCCCFF">';
$row_html .= &html_editable_cell($cell,'#CCCCFF');
} else {
$row_html .= '<td bgcolor="#DDCCFF">';
$row_html .= &html_uneditable_cell($cell,'#CCCCFF');
}
$row_html .= '</td>';
}
$row_html.= "</tr>\n";
$r->print($row_html);
$r->print('</table>');
####################################
# Prepare to output rows
####################################
my @Rows = $self->sort_indicies();
#
# Loop through the rows and output them one at a time
my $rows_output=0;
foreach my $rownum (@Rows) {
my ($rowlabel,@rowdata) = $self->get_row($rownum);
next if ($rowlabel =~ /^\s*$/);
next if (($self->{'type'} eq 'assesscalc') &&
(! $ENV{'form.showall'}) &&
($rowdata[0]->{'value'} =~ /^\s*$/));
if (! $ENV{'form.showall'} &&
$self->{'type'} =~ /^(studentcalc|classcalc)$/) {
my $row_is_empty = 1;
foreach my $cell (@rowdata) {
if ($cell->{'value'} !~ /^\s*$/) {
$row_is_empty = 0;
last;
}
}
next if ($row_is_empty);
}
#
my $defaultbg='#E0FF';
#
my $row_html ="\n".'<tr><td><b><font size=+1>'.$rownum.
'</font></b></td>';
#
if ($self->{'type'} eq 'classcalc') {
$row_html.='<td>'.$self->format_html_rowlabel($rowlabel).'</td>';
# Output links for each student?
# Nope, that is already done for us in format_html_rowlabel
# (for now)
} elsif ($self->{'type'} eq 'studentcalc') {
my $ufn = (split(/:/,$rowlabel))[5];
$row_html.='<td>'.$self->format_html_rowlabel($rowlabel);
$row_html.= '<br>'.
'<select name="sel_'.$rownum.'" '.
'onChange="changesheet('.$rownum.')">'.
'<option name="default">Default</option>';
foreach (@{$self->{'othersheets'}}) {
$row_html.='<option name="'.$_.'"';
if ($ufn eq $_) {
$row_html.=' selected';
}
$row_html.='>'.$_.'</option>';
}
$row_html.='</select></td>';
} elsif ($self->{'type'} eq 'assesscalc') {
$row_html.='<td>'.$self->format_html_rowlabel($rowlabel).'</td>';
}
#
my $shown_cells = 0;
foreach my $cell (@rowdata) {
my $value = $cell->{'value'};
my $formula = $cell->{'formula'};
my $cellname = $cell->{'name'};
#
my $bgcolor;
if ($shown_cells && ($shown_cells/5 == int($shown_cells/5))) {
$bgcolor = $defaultbg.'99';
} else {
$bgcolor = $defaultbg.'DD';
}
$bgcolor='#FFDDDD' if ($shown_cells < $num_uneditable);
#
$row_html.='<td bgcolor='.$bgcolor.'>';
if ($requester_is_student || $shown_cells < $num_uneditable) {
$row_html .= &html_uneditable_cell($cell,$bgcolor);
} else {
$row_html .= &html_editable_cell($cell,$bgcolor);
}
$row_html.='</td>';
$shown_cells++;
}
if ($row_html) {
if ($rows_output % 25 == 0) {
$r->print("</table>\n<br>\n");
$r->rflush();
$r->print('<table border=2>'.
'<tr><td> <td>'.$row_type.'</td>'.
'<td>'.
join('</td><td>',
(split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
'abcdefghijklmnopqrstuvwxyz'))).
"</td></tr>\n");
}
$rows_output++;
$r->print($row_html);
}
}
#
$r->print('</table>');
#
# Debugging code (be sure to uncomment errorlog code in safe space):
#
# $r->print("\n<pre>");
# $r->print(&geterrorlog($self));
# $r->print("\n</pre>");
return 1;
}
############################################
## csv output routines ##
############################################
sub outsheet_csv {
my $self = shift;
my ($r) = @_;
my $csvdata = '';
my @Values;
####################################
# Prepare to output rows
####################################
my @Rows = $self->sort_indicies();
#
# Loop through the rows and output them one at a time
my $rows_output=0;
foreach my $rownum (@Rows) {
my ($rowlabel,@rowdata) = $self->get_row($rownum);
next if ($rowlabel =~ /^\s*$/);
push (@Values,$self->format_csv_rowlabel($rowlabel));
foreach my $cell (@rowdata) {
push (@Values,'"'.$cell->{'value'}.'"');
}
$csvdata.= join(',',@Values)."\n";
@Values = ();
}
#
# Write the CSV data to a file and serve up a link
#
my $filename = '/prtspool/'.
$ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
time.'_'.rand(1000000000).'.csv';
my $file;
unless ($file = Apache::File->new('>'.'/home/httpd'.$filename)) {
$r->log_error("Couldn't open $filename for output $!");
$r->print("Problems occured in writing the csv file. ".
"This error has been logged. ".
"Please alert your LON-CAPA administrator.");
$r->print("<pre>\n".$csvdata."</pre>\n");
return 0;
}
print $file $csvdata;
close($file);
$r->print('<br /><br />'.
'<a href="'.$filename.'">Your CSV spreadsheet.</a>'."\n");
#
return 1;
}
############################################
## Excel output routines ##
############################################
sub outsheet_recursive_excel {
my $self = shift;
my ($r) = @_;
my $c = $r->connection;
return undef if ($self->{'type'} ne 'classcalc');
my ($workbook,$filename) = $self->create_excel_spreadsheet($r);
return undef if (! defined($workbook));
#
# Create main worksheet
my $main_worksheet = $workbook->addworksheet('main');
#
# Figure out who the students are
my %f=$self->formulas();
my $count = 0;
$r->print(<<END);
<p>
Compiling Excel Workbook with a worksheet for each student.
</p><p>
This operation may take longer than a complete recalculation of the
spreadsheet.
</p><p>
To abort this operation, hit the stop button on your browser.
</p><p>
A link to the spreadsheet will be available at the end of this process.
</p>
<p>
END
$r->rflush();
my $starttime = time;
foreach my $rownum ($self->sort_indicies()) {
$count++;
my ($sname,$sdom) = split(':',$f{'A'.$rownum});
my $student_excel_worksheet=$workbook->addworksheet($sname.'@'.$sdom);
# Create a new spreadsheet
my $studentsheet = &Apache::lonspreadsheet::Spreadsheet->new
($sname,$sdom,'studentcalc',undef);
# Read in the spreadsheet definition
$studentsheet->update_student_sheet($r,$c);
# Stuff the sheet into excel
$studentsheet->export_sheet_as_excel($student_excel_worksheet);
my $totaltime = int((time - $starttime) / $count * $self->{'maxrow'});
my $timeleft = int((time - $starttime) / $count * ($self->{'maxrow'} - $count));
if ($count % 5 == 0) {
$r->print($count.' students completed.'.
' Time remaining: '.$timeleft.' sec. '.
' Estimated total time: '.$totaltime." sec <br />\n");
$r->rflush();
}
if(defined($c) && ($c->aborted())) {
last;
}
}
#
if(! $c->aborted() ) {
$r->print('All students spreadsheets completed!<br />');
$r->rflush();
#
# &export_sheet_as_excel fills $worksheet with the data from $sheet
$self->export_sheet_as_excel($main_worksheet);
#
$workbook->close();
# Okay, the spreadsheet is taken care of, so give the user a link.
$r->print('<br /><br />'.
'<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n");
} else {
$workbook->close(); # Not sure how necessary this is.
#unlink('/home/httpd'.$filename); # No need to keep this around?
}
return 1;
}
sub outsheet_excel {
my $self = shift;
my ($r) = @_;
my ($workbook,$filename) = $self->create_excel_spreadsheet($r);
return undef if (! defined($workbook));
my $sheetname;
if ($self->{'type'} eq 'classcalc') {
$sheetname = 'Main';
} elsif ($self->{'type'} eq 'studentcalc') {
$sheetname = $self->{'uname'}.'@'.$self->{'udom'};
} elsif ($self->{'type'} eq 'assesscalc') {
$sheetname = $self->{'uname'}.'@'.$self->{'udom'}.' assessment';
}
my $worksheet = $workbook->addworksheet($sheetname);
#
# &export_sheet_as_excel fills $worksheet with the data from $sheet
$self->export_sheet_as_excel($worksheet);
#
$workbook->close();
# Okay, the spreadsheet is taken care of, so give the user a link.
$r->print('<br /><br />'.
'<a href="'.$filename.'">Your Excel spreadsheet.</a>'."\n");
return 1;
}
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);
}
sub export_sheet_as_excel {
my $self = shift;
my $worksheet = shift;
#
my $rows_output = 0;
my $cols_output = 0;
####################################
# Write an identifying row #
####################################
my @Headerinfo = ($self->{'coursedesc'});
my $title = $self->gettitle();
$cols_output = 0;
if (defined($title)) {
$worksheet->write($rows_output++,$cols_output++,$title);
}
####################################
# Write the summary/export row #
####################################
my ($rowlabel,@rowdata) = &get_row($self,'0');
my $label = &format_excel_rowlabel($self,$rowlabel);
$cols_output = 0;
$worksheet->write($rows_output,$cols_output++,$label);
foreach my $cell (@rowdata) {
$worksheet->write($rows_output,$cols_output++,$cell->{'value'});
}
$rows_output+= 2; # Skip a row, just for fun
####################################
# Prepare to output rows
####################################
my @Rows = &sort_indicies($self);
#
# Loop through the rows and output them one at a time
foreach my $rownum (@Rows) {
my ($rowlabel,@rowdata) = &get_row($self,$rownum);
next if ($rowlabel =~ /^[\s]*$/);
$cols_output = 0;
my $label = &format_excel_rowlabel($self,$rowlabel);
if ( ! $ENV{'form.showall'} &&
$self->{'type'} =~ /^(studentcalc|classcalc)$/) {
my $row_is_empty = 1;
foreach my $cell (@rowdata) {
if ($cell->{'value'} !~ /^\s*$/) {
$row_is_empty = 0;
last;
}
}
next if ($row_is_empty);
}
$worksheet->write($rows_output,$cols_output++,$rownum);
$worksheet->write($rows_output,$cols_output++,$label);
if (ref($label)) {
$cols_output = (scalar(@$label));
}
foreach my $cell (@rowdata) {
$worksheet->write($rows_output,$cols_output++,$cell->{'value'});
}
$rows_output++;
}
return;
}
############################################
## XML output routines ##
############################################
sub outsheet_xml {
my $self = shift;
my ($r) = @_;
## Someday XML
## Will be rendered for the user
## But not on this day
}
##
## Outsheet - calls other outsheet_* functions
##
sub outsheet {
my $self = shift;
my ($r)=@_;
if (! exists($ENV{'form.output'})) {
$ENV{'form.output'} = 'HTML';
}
if (lc($ENV{'form.output'}) eq 'csv') {
$self->outsheet_csv($r);
} elsif (lc($ENV{'form.output'}) eq 'excel') {
$self->outsheet_excel($r);
} elsif (lc($ENV{'form.output'}) eq 'recursive excel') {
$self->outsheet_recursive_excel($r);
# } elsif (lc($ENV{'form.output'}) eq 'xml' ) {
# $self->outsheet_xml($r);
} else {
$self->outsheet_html($r);
}
}
#
# othersheets: Returns the list of other spreadsheets available
#
sub othersheets {
my $self = shift;
my ($stype)=@_;
$stype = $self->{'type'} if (! defined($stype));
#
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;
}
#
# 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;
}
sub readsheet {
my $self = shift;
my ($fn)=@_;
#
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);
}
}
# ------------------------------------------------------------ Save spreadsheet
sub writesheet {
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';
}
# ----------------------------------------------- Make a temp copy of the sheet
# "Modified workcopy" - interactive only
#
sub tmpwrite {
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";
}
}
}
# ---------------------------------------------------------- Read the temp copy
sub tmpread {
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);
}
##################################################################
## Row label formatting routines ##
##################################################################
sub format_html_rowlabel {
my $self = shift;
my $rowlabel = shift;
return '' if ($rowlabel eq '');
my ($type,$labeldata) = split(':',$rowlabel,2);
my $result = '';
if ($type eq 'symb') {
my ($symb,$mapid,$resid,$title,$ufn) = split(':',$labeldata);
$ufn = 'default' if (!defined($ufn) || $ufn eq '');
$ufn = &Apache::lonnet::unescape($ufn);
$symb = &Apache::lonnet::unescape($symb);
$title = &Apache::lonnet::unescape($title);
$result = '<a href="/adm/assesscalc?usymb='.$symb.
'&uname='.$self->{'uname'}.'&udom='.$self->{'udom'}.
'&ufn='.$ufn.
'&mapid='.$mapid.'&resid='.$resid.'">'.$title.'</a>';
} elsif ($type eq 'student') {
my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata);
if ($fullname =~ /^\s*$/) {
$fullname = $sname.'@'.$sdom;
}
$result ='<a href="/adm/studentcalc?uname='.$sname.
'&udom='.$sdom.'">';
$result.=$section.' '.$id." ".$fullname.'</a>';
} elsif ($type eq 'parameter') {
$result = $labeldata;
} else {
$result = '<b><font size=+1>'.$rowlabel.'</font></b>';
}
return $result;
}
sub format_csv_rowlabel {
my $self = shift;
my $rowlabel = shift;
return '' if ($rowlabel eq '');
my ($type,$labeldata) = split(':',$rowlabel,2);
my $result = '';
if ($type eq 'symb') {
my ($symb,$mapid,$resid,$title,$ufn) = split(':',$labeldata);
$ufn = &Apache::lonnet::unescape($ufn);
$symb = &Apache::lonnet::unescape($symb);
$title = &Apache::lonnet::unescape($title);
$result = $title;
} elsif ($type eq 'student') {
my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata);
$result = join('","',($sname,$sdom,$fullname,$section,$id));
} elsif ($type eq 'parameter') {
$labeldata =~ s/<br>/ /g;
$result = $labeldata;
} else {
$result = $rowlabel;
}
return '"'.$result.'"';
}
sub format_excel_rowlabel {
my $self = shift;
my $rowlabel = shift;
return '' if ($rowlabel eq '');
my ($type,$labeldata) = split(':',$rowlabel,2);
my $result = '';
if ($type eq 'symb') {
my ($symb,$mapid,$resid,$title,$ufn) = split(':',$labeldata);
$ufn = &Apache::lonnet::unescape($ufn);
$symb = &Apache::lonnet::unescape($symb);
$title = &Apache::lonnet::unescape($title);
$result = $title;
} elsif ($type eq 'student') {
my ($sname,$sdom,$fullname,$section,$id) = split(':',$labeldata);
$section = '' if (! defined($section));
$id = '' if (! defined($id));
my @Data = ($sname,$sdom,$fullname,$section,$id);
$result = \@Data;
} elsif ($type eq 'parameter') {
$labeldata =~ s/<br>/ /g;
$result = $labeldata;
} else {
$result = $rowlabel;
}
return $result;
}
# ---------------------------------------------- Update rows for course listing
sub updateclasssheet {
my $self = shift;
my $cnum =$self->{'cnum'};
my $cdom =$self->{'cdom'};
my $cid =$self->{'cid'};
my $chome =$self->{'chome'};
#
%Section = ();
#
# Read class list and row labels
my $classlist = &Apache::loncoursedata::get_classlist();
if (! defined($classlist)) {
return 'Could not access course classlist';
}
#
my %currentlist=();
foreach my $student (keys(%$classlist)) {
my ($studentDomain,$studentName,$end,$start,$id,$studentSection,
$fullname,$status) = @{$classlist->{$student}};
$Section{$studentName.':'.$studentDomain} = $studentSection;
if ($ENV{'form.Status'} eq $status || $ENV{'form.Status'} eq 'Any') {
$currentlist{$student}=join(':',('student',$studentName,
$studentDomain,$fullname,
$studentSection,$id));
}
}
#
# Find discrepancies between the course row table and this
#
my %f=$self->formulas();
my $changed=0;
#
$self->{'maxrow'}=0;
my %existing=();
#
# Now obsolete rows
foreach my $rownum ($self->rows()) {
my $cell = 'A'.$rownum;
if ($rownum > $self->{'maxrow'}) {
$self->{'maxrow'}= $rownum;
}
$existing{$f{$cell}}=1;
if (! defined($currentlist{$f{$cell}}) && ($f{$cell}=~/^(~~~|---)/)) {
$f{$cell}='!!! Obsolete';
$changed=1;
}
}
#
# New and unknown keys
foreach my $student (sort keys(%currentlist)) {
next if ($existing{$student});
$changed=1;
$self->{'maxrow'}++;
$f{'A'.$self->{'maxrow'}}=$student;
}
$self->formulas(\%f) if ($changed);
#
$self->rowlabels(\%currentlist);
}
# ----------------------------------- Update rows for student and assess sheets
sub get_student_rowlabels {
my $self = shift;
#
my %course_db;
#
my $stype = $self->{'type'};
my $uname = $self->{'uname'};
my $udom = $self->{'udom'};
#
$self->{'rowlabel'} = {};
#
my $identifier =$self->{'coursefilename'}.'_'.$stype;
if (exists($rowlabel_cache{$identifier})) {
my %tmp = split(/___;___/,$rowlabel_cache{$identifier});
$self->rowlabels(\%tmp);
} else {
# Get the data and store it in the cache
# Tie hash
tie(%course_db,'GDBM_File',$self->{'coursefilename'}.'.db',
&GDBM_READER(),0640);
if (! tied(%course_db)) {
return 'Could not access course data';
}
#
my %assesslist = ();
foreach ('Feedback','Evaluation','Tutoring','Discussion') {
my $symb = '_'.lc($_);
$assesslist{$symb} = join(':',('symb',$symb,0,0,
&Apache::lonnet::escape($_)));
}
#
while (my ($key,$srcf) = each(%course_db)) {
next if ($key !~ /^src_(\d+)\.(\d+)$/);
my $mapid = $1;
my $resid = $2;
my $id = $mapid.'.'.$resid;
if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
my $symb=
&Apache::lonnet::declutter($course_db{'map_id_'.$mapid}).
'___'.$resid.'___'.&Apache::lonnet::declutter($srcf);
$assesslist{$symb} ='symb:'.&Apache::lonnet::escape($symb).':'
.$mapid.':'.$resid.':'.
&Apache::lonnet::escape($course_db{'title_'.$id});
}
}
untie(%course_db);
# Store away the data
$self->{'rowlabel'} = \%assesslist;
$rowlabel_cache{$identifier}=join('___;___',%{$self->{'rowlabel'}});
}
}
sub get_assess_rowlabels {
my $self = shift;
#
my %course_db;
#
my $stype = $self->{'type'};
my $uname = $self->{'uname'};
my $udom = $self->{'udom'};
my $usymb = $self->{'usymb'};
#
$self->rowlabels({});
my $identifier =$self->{'coursefilename'}.'_'.$stype.'_'.$usymb;
#
if (exists($rowlabel_cache{$identifier})) {
my %tmp = split('___;___',$rowlabel_cache{$identifier});
$self->rowlabels(\%tmp);
} else {
# Get the data and store it in the cache
# Tie hash
tie(%course_db,'GDBM_File',$self->{'coursefilename'}.'.db',
&GDBM_READER(),0640);
if (! tied(%course_db)) {
return 'Could not access course data';
}
#
my %parameter_labels=
('timestamp' =>
'parameter:Timestamp of Last Transaction<br>timestamp',
'subnumber' =>
'parameter:Number of Submissions<br>subnumber',
'tutornumber' =>
'parameter:Number of Tutor Responses<br>tutornumber',
'totalpoints' =>
'parameter:Total Points Granted<br>totalpoints');
while (my ($key,$srcf) = each(%course_db)) {
next if ($key !~ /^src_(\d+)\.(\d+)$/);
my $mapid = $1;
my $resid = $2;
my $id = $mapid.'.'.$resid;
if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
# Loop through the metadata for this key
my @Metadata = split(/,/,
&Apache::lonnet::metadata($srcf,'keys'));
foreach my $key (@Metadata) {
next if ($key !~ /^(stores|parameter)_/);
my $display=
&Apache::lonnet::metadata($srcf,$key.'.display');
unless ($display) {
$display.=
&Apache::lonnet::metadata($srcf,$key.'.name');
}
$display.='<br>'.$key;
$parameter_labels{$key}='parameter:'.$display;
} # end of foreach
}
}
untie(%course_db);
# Store away the results
$self->rowlabels(\%parameter_labels);
$rowlabel_cache{$identifier}=join('___;___',%parameter_labels);
}
}
sub updatestudentassesssheet {
my $self = shift;
if ($self->{'type'} eq 'studentcalc') {
$self->get_student_rowlabels();
} else {
$self->get_assess_rowlabels();
}
# Determine if any of the information has changed
my %f=$self->formulas();
my $changed=0;
$self->{'maxrow'} = 0;
my %existing=();
# Now obsolete rows
foreach my $rownum ($self->rows()) {
my $cell = 'A'.$rownum;
my $formula = $f{$cell};
$self->{'maxrow'} = $rownum if ($rownum > $self->{'maxrow'});
my ($usy,$ufn)=split(/__&&&\__/,$formula);
$existing{$usy}=1;
if ( ! exists($self->{'rowlabel'}->{$usy}) ||
! defined($self->{'rowlabel'}->{$usy}) ||
($formula =~ /^(~~~|---)/) ||
($formula =~ /^\s*$/)) {
$f{$cell}='!!! Obsolete';
$changed=1;
}
}
# New and unknown keys
my %keys_hates_me = $self->rowlabels();
foreach (keys(%keys_hates_me)) {
unless ($existing{$_}) {
$changed=1;
$self->{'maxrow'}++;
$f{'A'.$self->{'maxrow'}}=$_;
}
}
$self->formulas(\%f) if ($changed);
# $self->dump_formulas_to_log();
}
# ------------------------------------------------ Load data for one assessment
sub loadstudent{
my $self = shift;
my ($r,$c)=@_;
my %constants = ();
my %formulas = $self->formulas();
$cachedassess = $self->{'uname'}.':'.$self->{'udom'};
# Get ALL the student preformance data
my @tmp = &Apache::loncoursedata::get_current_state($self->{'uname'},
$self->{'udom'},
undef,
$self->{'cid'});
if ((scalar @tmp > 0) && ($tmp[0] !~ /^error:/)) {
%cachedstores = @tmp;
}
undef @tmp;
# debugging code
# $self->dump_hash_to_log(\%cachedstores);
#
my @assessdata=();
foreach my $row ($self->rows()) {
my $cell = 'A'.$row;
my $value = $formulas{$cell};
if(defined($c) && ($c->aborted())) {
last;
}
next if ($value =~ /^[!~-]/);
my ($usy,$ufn)=split(/__&&&\__/,$value);
@assessdata=$self->exportsheet($self->{'uname'},
$self->{'udom'},
'assesscalc',$usy,$ufn,$r);
my $index=0;
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') {
if (defined($assessdata[$index])) {
if ($assessdata[$index]=~/\D/) {
$constants{$col.$row}="'".$assessdata[$index]."'";
} else {
$constants{$col.$row}=$assessdata[$index];
}
$formulas{$col.$row}='import' if ($col ne 'A');
}
$index++;
}
}
$cachedassess='';
undef %cachedstores;
$self->formulas(\%formulas);
$self->constants(\%constants);
}
# --------------------------------------------------- Load Course Sheet
#
sub loadcourse {
my $self = shift;
my ($r,$c)=@_;
#
my %constants=();
my %formulas=$self->formulas();
#
my $total=0;
foreach ($self->rows()) {
$total++ if ($formulas{'A'.$_} !~ /^[!~-]/);
}
my %prog_state=&Apache::lonhtmlcommon::Create_PrgWin($r,
'Spreadsheet Status','Spreadsheet Calculation Progress', $total);
&Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,
'Processing Course Assessment Data');
# It would be nice to load in the classlist and assessment info at this
# point, before attacking the student spreadsheets.
foreach my $row ($self->rows()) {
if(defined($c) && ($c->aborted())) {
last;
}
my $cell = 'A'.$row;
next if ($formulas{$cell}=~/^[\!\~\-]/);
my ($sname,$sdom) = split(':',$formulas{$cell});
my $started = time;
my @studentdata=$self->exportsheet($sname,$sdom,'studentcalc',
undef,undef,$r);
undef %userrdatas;
&Apache::lonhtmlcommon::Increment_PrgWin($r,\%prog_state,
'last student');
my $index=0;
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 (defined($studentdata[$index])) {
my $col=$_;
if ($studentdata[$index]=~/\D/) {
$constants{$col.$row}="'".$studentdata[$index]."'";
} else {
$constants{$col.$row}=$studentdata[$index];
}
unless ($col eq 'A') {
$formulas{$col.$row}='import';
}
}
$index++;
}
}
$self->formulas(\%formulas);
$self->constants(\%constants);
&Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state);
}
# ------------------------------------------------ Load data for one assessment
#
sub loadassessment {
my $self = shift;
my ($r,$c)=@_;
my $uhome = $self->{'uhome'};
my $uname = $self->{'uname'};
my $udom = $self->{'udom'};
my $symb = $self->{'usymb'};
my $cid = $self->{'cid'};
my $cnum = $self->{'cnum'};
my $cdom = $self->{'cdom'};
my $chome = $self->{'chome'};
my $csec = $self->{'csec'};
my $namespace;
unless ($namespace=$cid) { return ''; }
# Get stored values
my %returnhash=();
if ($cachedassess eq $uname.':'.$udom) {
#
# get data out of the dumped stores
#
if (exists($cachedstores{$symb})) {
%returnhash = %{$cachedstores{$symb}};
} else {
%returnhash = ();
}
} else {
#
# restore individual
#
%returnhash = &Apache::lonnet::restore($symb,$namespace,$udom,$uname);
}
#
# returnhash now has all stores for this resource
# convert all "_" to "." to be able to use libraries, multiparts, etc
#
# This is dumb. It is also necessary :(
my @oldkeys=keys %returnhash;
#
foreach my $name (@oldkeys) {
my $value=$returnhash{$name};
delete $returnhash{$name};
$name=~s/\_/\./g;
$returnhash{$name}=$value;
}
# initialize coursedata and userdata for this user
undef %courseopt;
undef %useropt;
my $userprefix=$uname.'_'.$udom.'_';
unless ($uhome eq 'no_host') {
# Get coursedata
unless ((time-$courserdatas{$cid.'.last_cache'})<240) {
my %Tmp = &Apache::lonnet::dump('resourcedata',$cdom,$cnum);
$courserdatas{$cid}=\%Tmp;
$courserdatas{$cid.'.last_cache'}=time;
}
while (my ($name,$value) = each(%{$courserdatas{$cid}})) {
$courseopt{$userprefix.$name}=$value;
}
# Get userdata (if present)
unless ((time-$userrdatas{$uname.'@'.$udom.'.last_cache'})<240) {
my %Tmp = &Apache::lonnet::dump('resourcedata',$udom,$uname);
$userrdatas{$cid} = \%Tmp;
# Most of the time the user does not have a 'resourcedata.db'
# file. We need to cache that we got nothing instead of bothering
# with requesting it every time.
$userrdatas{$uname.'@'.$udom.'.last_cache'}=time;
}
while (my ($name,$value) = each(%{$userrdatas{$cid}})) {
$useropt{$userprefix.$name}=$value;
}
}
# now courseopt, useropt initialized for this user and course
# (used by parmval)
#
# Load keys for this assessment only
#
my %thisassess=();
my ($symap,$syid,$srcf)=split(/\_\_\_/,$symb);
foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) {
$thisassess{$_}=1;
}
#
# Load parameters
#
my %c=();
if (tie(%parmhash,'GDBM_File',
$self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) {
my %f=$self->formulas();
foreach my $row ($self->rows()) {
my $cell = 'A'.$row;
my $formula = $self->formula($cell);
next if ($formula =~/^[\!\~\-]/);
if ($formula =~ /^parameter/) {
if (defined($thisassess{$formula})) {
my $val = &parmval($formula,$symb,$uname,$udom,$csec);
$c{$cell} = $val;
$c{$formula} = $val;
}
} else {
my $ckey=$formula;
$formula=~s/^stores\_/resource\./;
$formula=~s/\_/\./g;
$c{$cell}=$returnhash{$formula};
$c{$ckey}=$returnhash{$formula};
}
}
untie(%parmhash);
}
$self->constants(\%c);
}
# =============================================== Update information in a sheet
#
# Add new users or assessments, etc.
#
sub updatesheet {
my $self = shift;
if ($self->{'type'} eq 'classcalc') {
return $self->updateclasssheet();
} else {
return $self->updatestudentassesssheet();
}
}
# =================================================== Load the rows for a sheet
#
# Import the data for rows
#
sub loadrows {
my $self = shift;
my ($r)=@_;
my $c = $r->connection;
if ($self->{'type'} eq 'classcalc') {
$self->loadcourse($r,$c);
} elsif ($self->{'type'} eq 'studentcalc') {
$self->loadstudent($r,$c);
} else {
$self->loadassessment($r,$c);
}
}
# ============================================================== Export handler
# exportsheet
# returns the export row for a spreadsheet.
#
sub exportsheet {
my $self = shift;
my ($uname,$udom,$stype,$usymb,$fn,$r)=@_;
my $flag = 0;
$uname = $uname || $self->{'uname'};
$udom = $udom || $self->{'udom'};
$stype = $stype || $self->{'type'};
my @exportarr=();
# This handles the assessment sheets for '_feedback', etc
if (defined($usymb) && ($usymb=~/^\_(\w+)/) &&
(!defined($fn) || $fn eq '')) {
$fn='default_'.$1;
}
#
# Check if cached
#
my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
my $found='';
if ($Apache::lonspreadsheet::oldsheets{$key}) {
foreach (split(/___&\___/,$Apache::lonspreadsheet::oldsheets{$key})) {
my ($name,$value)=split(/___=___/,$_);
if ($name eq $fn) {
$found=$value;
}
}
}
unless ($found) {
&cachedssheets($self,$uname,$udom);
if ($Apache::lonspreadsheet::oldsheets{$key}) {
foreach (split(/___&\___/,$Apache::lonspreadsheet::oldsheets{$key})) {
my ($name,$value)=split(/___=___/,$_);
if ($name eq $fn) {
$found=$value;
}
}
}
}
#
# Check if still valid
#
if ($found) {
if (&forcedrecalc($uname,$udom,$stype,$usymb)) {
$found='';
}
}
if ($found) {
#
# Return what was cached
#
@exportarr=split(/___;___/,$found);
return @exportarr;
}
#
# Not cached
#
my $newsheet = Apache::lonspreadsheet::Spreadsheet->new($uname,$udom,
$stype,$usymb);
$newsheet->readsheet($fn);
$newsheet->updatesheet();
$newsheet->loadrows($r);
$newsheet->calcsheet();
@exportarr=$newsheet->exportdata();
##
## Store now
##
#
# load in the old value
#
my %currentlystored=();
if ($stype eq 'studentcalc') {
my @tmp = &Apache::lonnet::get('nohist_calculatedsheets',
[$key],
$self->{'cdom'},$self->{'cnum'});
if ($tmp[0]!~/^error/) {
# We only got one key, so we will access it directly.
foreach (split('___&___',$tmp[1])) {
my ($key,$value) = split('___=___',$_);
$key = '' if (! defined($key));
$currentlystored{$key} = $value;
}
}
} else {
my @tmp = &Apache::lonnet::get('nohist_calculatedsheets_'.
$self->{'cid'},[$key],
$self->{'udom'},$self->{'uname'});
if ($tmp[0]!~/^error/) {
# We only got one key, so we will access it directly.
foreach (split('___&___',$tmp[1])) {
my ($key,$value) = split('___=___',$_);
$key = '' if (! defined($key));
$currentlystored{$key} = $value;
}
}
}
#
# Add the new line
#
$currentlystored{$fn}=join('___;___',@exportarr);
#
# Stick everything back together
#
my $newstore='';
foreach (keys(%currentlystored)) {
if ($newstore) { $newstore.='___&___'; }
$newstore.=$_.'___=___'.$currentlystored{$_};
}
my $now=time;
#
# Store away the new value
#
my $timekey = $key.'.time';
if ($stype eq 'studentcalc') {
my $result = &Apache::lonnet::put('nohist_calculatedsheets',
{ $key => $newstore,
$timekey => $now },
$self->{'cdom'},
$self->{'cnum'});
} else {
my $result = &Apache::lonnet::put('nohist_calculatedsheets_'.$self->{'cid'},
{ $key => $newstore,
$timekey => $now },
$self->{'udom'},
$self->{'uname'});
}
return @exportarr;
}
1;
__END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>