version 1.17, 2003/07/29 05:22:56
|
version 1.37, 2005/03/03 17:52:36
|
Line 44 assesscalc
|
Line 44 assesscalc
|
package Apache::assesscalc; |
package Apache::assesscalc; |
|
|
use strict; |
use strict; |
|
use warnings FATAL=>'all'; |
|
no warnings 'uninitialized'; |
use Apache::Constants qw(:common :http); |
use Apache::Constants qw(:common :http); |
use Apache::lonnet; |
use Apache::lonnet; |
use Apache::loncommon; |
use Apache::loncommon; |
use Apache::Spreadsheet; |
use Apache::Spreadsheet; |
|
use Apache::loncoursedata(); |
use HTML::Entities(); |
use HTML::Entities(); |
use Spreadsheet::WriteExcel; |
use Spreadsheet::WriteExcel; |
use GDBM_File; |
use GDBM_File; |
use Time::HiRes; |
use Time::HiRes; |
|
use Apache::lonlocal; |
|
|
@Apache::assesscalc::ISA = ('Apache::Spreadsheet'); |
@Apache::assesscalc::ISA = ('Apache::Spreadsheet'); |
|
|
Line 88 use Time::HiRes;
|
Line 92 use Time::HiRes;
|
######################################################## |
######################################################## |
|
|
my %Exportrows; |
my %Exportrows; |
|
my %newExportrows; |
|
|
my $current_name; |
my $current_name; |
my $current_domain; |
my $current_domain; |
Line 97 my %parmhash;
|
Line 102 my %parmhash;
|
my %nice_parameter_name; |
my %nice_parameter_name; |
|
|
my %useropt; |
my %useropt; |
|
my %userdata; |
my %courseopt; |
my %courseopt; |
|
my $navmap; |
|
|
######################################################## |
######################################################## |
######################################################## |
######################################################## |
Line 108 my %courseopt;
|
Line 115 my %courseopt;
|
|
|
=item &clear_package() |
=item &clear_package() |
|
|
Reset all package variables. |
Reset all package variables and clean up caches. |
|
|
=cut |
=cut |
|
|
######################################################## |
######################################################## |
######################################################## |
######################################################## |
sub clear_package { |
sub clear_package { |
|
if (defined($current_name) && |
|
defined($current_domain) && |
|
defined($current_course) && |
|
$current_course eq $ENV{'request.course.id'} && |
|
%newExportrows) { |
|
&save_cached_export_rows($current_name,$current_domain); |
|
} |
undef(%Exportrows); |
undef(%Exportrows); |
|
undef(%newExportrows); |
undef($current_name); |
undef($current_name); |
undef($current_domain); |
undef($current_domain); |
undef($current_course); |
undef($current_course); |
undef(%useropt); |
undef(%useropt); |
|
undef(%userdata); |
undef(%courseopt); |
undef(%courseopt); |
|
undef($navmap); |
|
} |
|
|
|
sub save_cached_export_rows { |
|
my ($sname,$sdomain) = @_; |
|
my $result = &Apache::lonnet::put |
|
('nohist_calculatedsheets_'.$ENV{'request.course.id'}, |
|
$newExportrows{$sname.':'.$sdomain}, |
|
$sdomain,$sname); |
|
delete($newExportrows{$sname.':'.$sdomain}); |
} |
} |
|
|
sub initialize { |
sub initialize { |
|
my ($in_navmap) = @_; |
&clear_package(); |
&clear_package(); |
|
$navmap = $in_navmap; |
|
if (! defined($navmap)) { |
|
$navmap = Apache::lonnavmaps::navmap->new(); |
|
} |
|
if (!defined($navmap)) { |
|
&Apache::lonnet::logthis('assesscalc:Can not open Coursemap'); |
|
} |
|
&Apache::loncoursedata::clear_internal_caches(); |
} |
} |
|
|
######################################################## |
######################################################## |
Line 139 sub initialize {
|
Line 174 sub initialize {
|
######################################################## |
######################################################## |
######################################################## |
######################################################## |
sub initialize_package { |
sub initialize_package { |
my ($sname,$sdomain) = @_; |
my ($sname,$sdomain,$in_navmap) = @_; |
$current_name = $sname; |
$current_name = $sname; |
$current_domain = $sdomain; |
$current_domain = $sdomain; |
|
$navmap = $in_navmap; |
|
undef(%useropt); |
|
undef(%userdata); |
if ($current_course ne $ENV{'request.course.id'}) { |
if ($current_course ne $ENV{'request.course.id'}) { |
$current_course = $ENV{'request.course.id'}; |
$current_course = $ENV{'request.course.id'}; |
undef(%courseopt); |
undef(%courseopt); |
} |
} |
&load_cached_export_rows(); |
&load_cached_export_rows(); |
&load_parameter_caches(); |
&load_parameter_caches(); |
|
&Apache::loncoursedata::clear_internal_caches(); |
} |
} |
|
|
|
|
######################################################## |
######################################################## |
######################################################## |
######################################################## |
|
|
Line 167 sub load_parameter_caches {
|
Line 207 sub load_parameter_caches {
|
# |
# |
# Course Parameters Cache |
# Course Parameters Cache |
if (! %courseopt) { |
if (! %courseopt) { |
&Apache::lonnet::logthis("loading course options"); |
|
$current_course = $ENV{'request.course.id'}; |
$current_course = $ENV{'request.course.id'}; |
undef(%courseopt); |
undef(%courseopt); |
if (! defined($current_name) || ! defined($current_domain)) { |
if (! defined($current_name) || ! defined($current_domain)) { |
&Apache::lonnet::logthis('bad call to setup_parameter_caches'); |
|
return; |
return; |
} |
} |
my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; |
my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; |
Line 191 sub load_parameter_caches {
|
Line 229 sub load_parameter_caches {
|
} |
} |
$useropt{$userprefix.$name}=$value; |
$useropt{$userprefix.$name}=$value; |
} |
} |
|
$useropt{'loadtime'} = time; |
|
} |
|
if (! %userdata) { |
|
%userdata = &Apache::loncoursedata::get_current_state($current_name, |
|
$current_domain); |
|
$userdata{'loadtime'} = time; |
} |
} |
|
return; |
} |
} |
|
|
######################################################## |
######################################################## |
Line 205 sub load_parameter_caches {
|
Line 250 sub load_parameter_caches {
|
|
|
######################################################## |
######################################################## |
######################################################## |
######################################################## |
sub ensure_current_parameter_caches { |
sub ensure_current_caches { |
my $self = shift; |
my $self = shift; |
|
## |
|
## Check for a modified parameters |
|
## |
if (! defined($current_course) || |
if (! defined($current_course) || |
$current_course ne $ENV{'request.course.id'} ) { |
$current_course ne $ENV{'request.course.id'} ) { |
$current_course = $ENV{'request.course.id'}; |
$current_course = $ENV{'request.course.id'}; |
undef(%courseopt); |
undef(%courseopt); |
|
undef(%useropt); |
|
undef(%userdata); |
} |
} |
|
## |
|
## Check for new user |
|
## |
if (! defined($current_name) || $current_name ne $self->{'name'} || |
if (! defined($current_name) || $current_name ne $self->{'name'} || |
! defined($current_domain) || $current_domain ne $self->{'domain'}) { |
! defined($current_domain) || $current_domain ne $self->{'domain'}) { |
$current_domain = $self->{'domain'}; |
$current_domain = $self->{'domain'}; |
$current_name = $self->{'name'}; |
$current_name = $self->{'name'}; |
undef(%useropt); |
undef(%useropt); |
|
undef(%userdata); |
} |
} |
&load_parameter_caches(); |
&load_parameter_caches(); |
} |
} |
Line 256 sub parmval {
|
Line 310 sub parmval {
|
my $result=''; |
my $result=''; |
# |
# |
# This should be a |
# This should be a |
my ($mapname,$id,$fn)=split(/___/,$symb); |
my ($mapname,$id,$fn)=&Apache::lonnet::decode_symb($symb); |
# Cascading lookup scheme |
# Cascading lookup scheme |
my $rwhat=$what; |
my $rwhat=$what; |
$what =~ s/^parameter\_//; |
$what =~ s/^parameter\_//; |
Line 293 sub parmval {
|
Line 347 sub parmval {
|
# |
# |
# check course |
# check course |
return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr})); |
return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr})); |
return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm})); |
|
return $courseopt{$courselevel} if (defined($courseopt{$courselevel})); |
|
# check map parms |
# check map parms |
my $thisparm = $parmhash{$symbparm}; |
my $thisparm = $parmhash{$symbparm}; |
return $thisparm if (defined($thisparm)); |
return $thisparm if (defined($thisparm)); |
# check default |
# check default |
$thisparm = &Apache::lonnet::metadata($fn,$rwhat.'.default'); |
$thisparm = &Apache::lonnet::metadata($fn,$rwhat.'.default'); |
return $thisparm if (defined($thisparm)); |
return $thisparm if (defined($thisparm)); |
# |
# check more course |
|
return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm})); |
|
return $courseopt{$courselevel} if (defined($courseopt{$courselevel})); |
|
|
# Cascade Up |
# Cascade Up |
my $space=$what; |
my $space=$what; |
$space=~s/\.\w+$//; |
$space=~s/\.[^._]+$//; |
if ($space ne '0') { |
if ($space ne '0') { |
my @parts=split(/_/,$space); |
my @parts=split(/_/,$space); |
my $id=pop(@parts); |
my $id=pop(@parts); |
Line 324 sub parmval {
|
Line 379 sub parmval {
|
|
|
sub get_html_title { |
sub get_html_title { |
my $self = shift; |
my $self = shift; |
my ($assess_title,$name,$time) = $self->get_title(); |
my ($assess_title,$name,$time) = $self->get_full_title(); |
my $title = '<h1>'.$assess_title.'</h1>'. |
my $title = '<h1>'.$assess_title.'</h1>'. |
'<h2>'.$name.', '. |
'<h2>'.$name.', '. |
&Apache::loncommon::aboutmewrapper |
&Apache::loncommon::aboutmewrapper |
Line 336 sub get_html_title {
|
Line 391 sub get_html_title {
|
|
|
sub get_title { |
sub get_title { |
my $self = shift; |
my $self = shift; |
my @title = (); |
|
if (($self->{'symb'} eq '_feedback') || |
if (($self->{'symb'} eq '_feedback') || |
($self->{'symb'} eq '_evaluation') || |
($self->{'symb'} eq '_evaluation') || |
($self->{'symb'} eq '_discussion') || |
($self->{'symb'} eq '_discussion') || |
($self->{'symb'} eq '_tutoring')) { |
($self->{'symb'} eq '_tutoring')) { |
my $assess_title = ucfirst($self->{'symb'}); |
my $assess_title = ucfirst($self->{'symb'}); |
$assess_title =~ s/^_//; |
$assess_title =~ s/^_//; |
push(@title,$assess_title); |
return $assess_title; |
} else { |
} else { |
push(@title,&Apache::lonnet::gettitle($self->{'symb'})); |
return &Apache::lonnet::gettitle($self->{'symb'}); |
} |
} |
|
} |
|
|
|
sub get_full_title { |
|
my $self = shift; |
|
my @title = ($self->get_title()); |
# Look up the users identifying information |
# Look up the users identifying information |
# Get the users information |
# Get the users information |
my %userenv = &Apache::loncoursedata::GetUserName($self->{'name'}, |
my $name = &Apache::loncommon::plainname($self->{'name'}, |
$self->{'domain'}); |
$self->{'domain'}); |
my $name = |
|
join(' ',@userenv{'firstname','middlename','lastname','generation'}); |
|
$name =~ s/\s+$//; |
|
push (@title,$name); |
push (@title,$name); |
push (@title,scalar(localtime(time))); |
push (@title,&Apache::lonlocal::locallocaltime(time)); |
return @title; |
return @title; |
} |
} |
|
|
Line 364 sub parent_link {
|
Line 420 sub parent_link {
|
my $link .= '<p><a href="/adm/studentcalc?'. |
my $link .= '<p><a href="/adm/studentcalc?'. |
'sname='.$self->{'name'}. |
'sname='.$self->{'name'}. |
'&sdomain='.$self->{'domain'}.'">'. |
'&sdomain='.$self->{'domain'}.'">'. |
'Student level sheet</a></p>'."\n"; |
&mt('Student level sheet').'</a></p>'."\n"; |
return $link; |
return $link; |
} |
} |
|
|
sub outsheet_html { |
sub outsheet_html { |
my $self = shift; |
my $self = shift; |
my ($r) = @_; |
my ($r) = @_; |
|
#################################### |
|
# Report any calculation errors # |
|
#################################### |
|
$r->print($self->html_report_error()); |
################################### |
################################### |
# Determine table structure |
# Determine table structure |
################################### |
################################### |
Line 378 sub outsheet_html {
|
Line 438 sub outsheet_html {
|
my $exportcolor = '#FFFFAA'; |
my $exportcolor = '#FFFFAA'; |
my $num_uneditable = 1; |
my $num_uneditable = 1; |
my $num_left = 52-$num_uneditable; |
my $num_left = 52-$num_uneditable; |
|
my %lt=&Apache::lonlocal::texthash( |
|
'as' => 'Assessment', |
|
'ca' => 'Calculations', |
|
); |
my $tableheader =<<"END"; |
my $tableheader =<<"END"; |
<table border="2"> |
<table border="2"> |
<tr> |
<tr> |
<th colspan="2" rowspan="2"><font size="+2">Assessment</font></th> |
<th colspan="2" rowspan="2"><font size="+2">$lt{'as'}</font></th> |
<td bgcolor="$importcolor" colspan="$num_uneditable"> </td> |
<td bgcolor="$importcolor" colspan="$num_uneditable"> </td> |
<td colspan="$num_left"> |
<td colspan="$num_left"> |
<b><font size="+1">Calculations</font></b></td> |
<b><font size="+1">$lt{'ca'}</font></b></td> |
</tr><tr> |
</tr><tr> |
END |
END |
my $label_num = 0; |
my $label_num = 0; |
Line 426 END
|
Line 490 END
|
# |
# |
my $num_output = 0; |
my $num_output = 0; |
foreach my $rownum (sort {$a <=> $b} ($self->rows())) { |
foreach my $rownum (sort {$a <=> $b} ($self->rows())) { |
|
if (! $self->parameter_part_is_valid( |
|
$self->{'formulas'}->{'A'.$rownum} |
|
)) { |
|
next; |
|
} |
if ($num_output++ % 50 == 0) { |
if ($num_output++ % 50 == 0) { |
$r->print("</table>\n".$tableheader); |
$r->print("</table>\n".$tableheader); |
} |
} |
Line 470 sub csv_rows {
|
Line 539 sub csv_rows {
|
# writes the meat of the spreadsheet to an excel worksheet. Called |
# writes the meat of the spreadsheet to an excel worksheet. Called |
# by Spreadsheet::outsheet_excel; |
# by Spreadsheet::outsheet_excel; |
my $self = shift; |
my $self = shift; |
my ($filehandle) = @_; |
my ($connection,$filehandle) = @_; |
# |
# |
# Write a header row |
# Write a header row |
$self->csv_output_row($filehandle,undef, |
$self->csv_output_row($filehandle,undef, |
('Parameter','Description','Value')); |
(&mt('Parameter'),&mt('Description'),&mt('Value'))); |
# |
# |
# Write each row |
# Write each row |
foreach my $rownum (sort {$a <=> $b} ($self->rows())) { |
foreach my $rownum (sort {$a <=> $b} ($self->rows())) { |
Line 493 sub excel_rows {
|
Line 562 sub excel_rows {
|
# writes the meat of the spreadsheet to an excel worksheet. Called |
# writes the meat of the spreadsheet to an excel worksheet. Called |
# by Spreadsheet::outsheet_excel; |
# by Spreadsheet::outsheet_excel; |
my $self = shift; |
my $self = shift; |
my ($worksheet,$cols_output,$rows_output) = @_; |
my ($connection,$worksheet,$cols_output,$rows_output) = @_; |
|
return if (! ref($worksheet)); |
# |
# |
# Write a header row |
# Write a header row |
$cols_output = 0; |
$cols_output = 0; |
Line 515 sub excel_rows {
|
Line 585 sub excel_rows {
|
return; |
return; |
} |
} |
|
|
|
## |
|
## Routines to support assesscalc::compute |
|
## |
|
sub get_parm_names { |
|
my $self = shift; |
|
my @Mandatory_parameters = @_; |
|
my %parameters_and_names; |
|
# |
|
my ($symap,$syid,$srcf) = &Apache::lonnet::decode_symb($self->{'symb'}); |
|
my @Metadata = split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); |
|
foreach my $parm (@Mandatory_parameters,@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_and_names{$cleaned_name}=$display; |
|
} |
|
return (%parameters_and_names); |
|
} |
|
|
|
sub get_parameter_values { |
|
my $self = shift(); |
|
my @Parameters; |
|
my ($parameters) = @_; |
|
if (!ref($parameters)) { |
|
@Parameters = @_; |
|
} elsif (ref($parameters) eq 'ARRAY') { |
|
@Parameters = @$parameters; |
|
} elsif (ref($parameters) eq 'HASH') { |
|
@Parameters = keys(%$parameters); |
|
} |
|
# |
|
my %parameters; |
|
# |
|
my $filename = $self->{'coursefilename'}.'_parms.db'; |
|
if (tie(%parmhash,'GDBM_File', |
|
$self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { |
|
foreach my $parmname (@Parameters) { |
|
my $value = $self->parmval($parmname); |
|
$parameters{$parmname} =$value; |
|
} |
|
untie(%parmhash); |
|
} else { |
|
$self->logthis('unable to tie '.$filename); |
|
} |
|
return %parameters; |
|
} |
|
|
|
sub deal_with_export_row { |
|
my $self = shift(); |
|
my @exportarray = @_; |
|
$Exportrows{$self->{'symb'}}->{'time'} = time; |
|
$Exportrows{$self->{'symb'}}->{$self->{'filename'}} = \@exportarray; |
|
# |
|
# Save the export data |
|
$self->save_export_data(); |
|
return; |
|
} |
|
|
|
sub get_problem_state { |
|
my $self = shift; |
|
my %student_parameters; |
|
if (exists($userdata{$self->{'symb'}}) && |
|
ref($userdata{$self->{'symb'}}) eq 'HASH') { |
|
%student_parameters = %{$userdata{$self->{'symb'}}}; |
|
} |
|
return %student_parameters; |
|
} |
|
|
|
sub determine_parts { |
|
my $self = shift; |
|
if (exists($self->{'Parts'}) && ref($self->{'Parts'}) eq 'HASH') { |
|
return; |
|
} |
|
my (undef,undef,$url) = &Apache::lonnet::decode_symb($self->{'symb'}); |
|
my $src = &Apache::lonnet::clutter($url); |
|
return if (! defined($src)); |
|
my %Parts; |
|
my $metadata = &Apache::lonnet::metadata($src,'packages'); |
|
foreach (split(',',$metadata)) { |
|
my ($part) = (/^part_(.*)$/); |
|
if (defined($part) && |
|
! &Apache::loncommon::check_if_partid_hidden |
|
($part,$self->{'symb'},$self->{'name'},$self->{'domain'}) |
|
) { |
|
$Parts{$part}++; |
|
} |
|
} |
|
# Make sure part 0 is defined. |
|
$Parts{'0'}++; |
|
$self->{'Parts'} = \%Parts; |
|
return; |
|
} |
|
|
|
sub parameter_part_is_valid { |
|
my $self = shift; |
|
my ($parameter) = @_; |
|
return 1 if ($parameter eq 'timestamp'); |
|
if (! defined($self->{'Parts'}) || |
|
! ref ($self->{'Parts'}) || |
|
ref($self->{'Parts'}) ne 'HASH') { |
|
return 1; |
|
} |
|
# |
|
my (undef,$part) = |
|
($parameter =~ m/^(resource|stores|parameter)_([^_]+)_.*/); |
|
if (exists($self->{'Parts'}) && |
|
exists($self->{'Parts'}->{$part}) && |
|
$self->{'Parts'}->{$part} ) { |
|
return 1; |
|
} else { |
|
return 0; |
|
} |
|
} |
|
|
sub compute { |
sub compute { |
my $self = shift; |
my $self = shift; |
# $self->logthis('computing'); |
my ($r) = @_; |
|
my $connection = $r->connection(); |
|
if ($connection->aborted()) { $self->cleanup(); return; } |
$self->initialize_safe_space(); |
$self->initialize_safe_space(); |
######################################### |
######################################### |
######################################### |
######################################### |
Line 538 sub compute {
|
Line 730 sub compute {
|
my %parameters; # holds underscored parameters by name |
my %parameters; # holds underscored parameters by name |
# |
# |
# Get the metadata fields and determine their proper names |
# Get the metadata fields and determine their proper names |
my ($symap,$syid,$srcf)=split(/___/,$self->{'symb'}); |
my %nice_parm_names = $self->get_parm_names(@Mandatory_parameters); |
my @Metadata = split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); |
while (my($cleaned_name,$display) = each(%nice_parm_names)) { |
foreach my $parm (@Mandatory_parameters,@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}++; |
$parameters{$cleaned_name}++; |
$nice_parameter_name{$cleaned_name} = $display; |
$nice_parameter_name{$cleaned_name} = $display; |
} |
} |
# |
# |
# Get the values of the metadata fields |
# Get the values of the metadata fields |
$self->ensure_current_parameter_caches(); |
if ($connection->aborted()) { $self->cleanup(); return; } |
my $filename = $self->{'coursefilename'}.'_parms.db'; |
$self->ensure_current_caches(); |
if (tie(%parmhash,'GDBM_File', |
if ($connection->aborted()) { $self->cleanup(); return; } |
$self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { |
%parameters = $self->get_parameter_values(keys(%parameters)); |
foreach my $parmname (keys(%parameters)) { |
if ($connection->aborted()) { $self->cleanup(); return; } |
my $value = $self->parmval($parmname); |
|
$parameters{$parmname} =$value; |
|
} |
|
untie(%parmhash); |
|
} else { |
|
$self->logthis('unable to tie '.$filename); |
|
} |
|
# |
# |
# Clean out unnecessary parameters |
# Clean out unnecessary parameters |
foreach (keys(%parameters)) { |
foreach (keys(%parameters)) { |
Line 574 sub compute {
|
Line 749 sub compute {
|
} |
} |
# |
# |
# Get the students performance data |
# Get the students performance data |
my %student_parameters = |
my %student_parameters = $self->get_problem_state(); |
&Apache::loncoursedata::get_current_state($self->{'name'}, |
|
$self->{'domain'}, |
|
$self->{'symb'}, |
|
$self->{'cid'}); |
|
while (my ($parm,$value) = each(%student_parameters)) { |
while (my ($parm,$value) = each(%student_parameters)) { |
$parm =~ s/^resource\./stores_/; |
$parm =~ s/^resource\./stores_/; |
$parm =~ s/\./_/g; |
$parm =~ s/\./_/g; |
$parameters{$parm} = $value; |
$parameters{$parm} = $value; |
} |
} |
# |
# |
|
# Clean out any bad parameters |
|
$self->determine_parts(); |
|
foreach my $param (keys(%parameters)) { |
|
if (! $self->parameter_part_is_valid($param)) { |
|
delete ($parameters{$param}); |
|
} |
|
} |
|
# |
# Set up the formulas and parameter values |
# Set up the formulas and parameter values |
my %f=$self->formulas(); |
my %f=$self->formulas(); |
my %c; |
my %c; |
Line 594 sub compute {
|
Line 773 sub compute {
|
while (my ($parm,$value) = each(%parameters)) { |
while (my ($parm,$value) = each(%parameters)) { |
last if ($self->blackout()); |
last if ($self->blackout()); |
next if ($parm !~ /^(parameter_.*)_problemstatus$/); |
next if ($parm !~ /^(parameter_.*)_problemstatus$/); |
next if ($parameters{$1.'_answerdate'}<time); |
if ($parameters{$1.'_answerdate'} ne '' && |
|
$parameters{$1.'_answerdate'} < time) { |
|
next; |
|
} |
if (lc($value) eq 'no') { |
if (lc($value) eq 'no') { |
# We must blackout this sheet |
# We must blackout this sheet |
$self->blackout(1); |
$self->blackout(1); |
} |
} |
} |
} |
} |
} |
|
if ($connection->aborted()) { $self->cleanup(); return; } |
# |
# |
# Move the parameters into the spreadsheet |
# Move the parameters into the spreadsheet |
while (my ($parm,$value) = each(%parameters)) { |
while (my ($parm,$value) = each(%parameters)) { |
my $cell = 'A'.$self->get_row_number_from_key($parm); |
my $cell = 'A'.$self->get_row_number_from_key($parm); |
$f{$cell} = $parm; |
$f{$cell} = $parm; |
$value = '"'.$value.'"' if ($value =~/[^0-9.]/); |
if ($parm =~ /_submission$/ && $value =~ /(\{|\})/) { |
|
$value = 'witheld'; |
|
} |
|
$value = 'q{'.$value.'}' if ($value =~/([^\d\.]|\.\.)/); |
$c{$parm} = $value; |
$c{$parm} = $value; |
} |
} |
$self->formulas(\%f); |
$self->formulas(\%f); |
$self->constants(\%c); |
$self->constants(\%c); |
|
if ($connection->aborted()) { $self->cleanup(); return; } |
$self->calcsheet(); |
$self->calcsheet(); |
# |
# |
# Store export row in cache |
# Store export row in cache |
my @exportarray = $self->exportrow(); |
my @exportarray = $self->exportrow(); |
$Exportrows{$self->{'symb'}}->{'time'} = time; |
$self->deal_with_export_row(@exportarray); |
$Exportrows{$self->{'symb'}}->{$self->{'filename'}} = \@exportarray; |
|
# |
|
# Save the export data |
|
$self->save_export_data(); |
|
$self->save() if ($self->need_to_save()); |
$self->save() if ($self->need_to_save()); |
|
if ($connection->aborted()) { $self->cleanup(); return; } |
return; |
return; |
} |
} |
|
|
Line 689 These rows are saved in the students dir
|
Line 873 These rows are saved in the students dir
|
######################################################## |
######################################################## |
######################################################## |
######################################################## |
sub load_cached_export_rows { |
sub load_cached_export_rows { |
%Exportrows = undef; |
undef(%Exportrows); |
my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets_'. |
my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets_'. |
$ENV{'request.course.id'}, |
$ENV{'request.course.id'}, |
$current_domain,$current_name,undef); |
$current_domain,$current_name,undef); |
Line 700 sub load_cached_export_rows {
|
Line 884 sub load_cached_export_rows {
|
# We only got one key, so we will access it directly. |
# We only got one key, so we will access it directly. |
while (my ($key,$sheetdata) = each(%tmp)) { |
while (my ($key,$sheetdata) = each(%tmp)) { |
my ($sname,$sdom,$sheettype,$symb) = split(':',$key); |
my ($sname,$sdom,$sheettype,$symb) = split(':',$key); |
|
if (! defined($sname) || $sname eq '' || |
|
! defined($sdom) || $sdom eq '' ) { |
|
next; |
|
} |
if ($symb =~ /\.time$/) { |
if ($symb =~ /\.time$/) { |
$symb =~ s/\.time$//; |
$symb =~ s/\.time$//; |
$Exportrows{$symb}->{'time'} = $sheetdata; |
$Exportrows{$symb}->{'time'} = $sheetdata; |
Line 730 spreadsheet only if necessary.
|
Line 918 spreadsheet only if necessary.
|
############################################# |
############################################# |
sub export_data { |
sub export_data { |
my $self = shift; |
my $self = shift; |
|
my ($r) = @_; |
|
my $connection = $r->connection(); |
my $symb = $self->{'symb'}; |
my $symb = $self->{'symb'}; |
if (! exists($ENV{'request.role.adv'}) || ! $ENV{'request.role.adv'} || |
if (! exists($ENV{'request.role.adv'}) || ! $ENV{'request.role.adv'} || |
! exists($Exportrows{$symb}) || ! defined($Exportrows{$symb}) || |
! exists($Exportrows{$symb}) || ! defined($Exportrows{$symb}) || |
! $self->check_expiration_time($Exportrows{$symb}->{'time'}) || |
! $self->check_expiration_time($Exportrows{$symb}->{'time'}) || |
! exists($Exportrows{$symb}->{$self->{'filename'}}) || |
! exists($Exportrows{$symb}->{$self->{'filename'}}) || |
! defined($Exportrows{$symb}->{$self->{'filename'}})) { |
! defined($Exportrows{$symb}->{$self->{'filename'}}) || |
$self->compute(); |
! ref($Exportrows{$symb}->{$self->{'filename'}}) |
} |
) { |
my @Data = @{$Exportrows{$symb}->{$self->{'filename'}}}; |
$self->compute($r); |
if ($Data[0] =~ /^(.*)___=___/) { |
} |
$self->{'sheetname'} = $1; |
if ($connection->aborted()) { $self->cleanup(); return; } |
$Data[0] =~ s/^(.*)___=___//; |
my @Data; |
} |
if ($self->badcalc()) { |
for (my $i=0;$i<$#Data;$i++) { |
@Data = (); |
$Data[$i]="'".$Data[$i]."'" if ($Data[$i]=~/\D/ && defined($Data[$i])); |
} else { |
|
@Data = @{$Exportrows{$symb}->{$self->{'filename'}}}; |
|
if ($Data[0] =~ /^(.*)___=___/) { |
|
$self->{'sheetname'} = $1; |
|
$Data[0] =~ s/^(.*)___=___//; |
|
} |
|
for (my $i=0;$i<$#Data;$i++) { |
|
if ($Data[$i]=~/\D/ && defined($Data[$i])) { |
|
$Data[$i]="'".$Data[$i]."'"; |
|
} |
|
} |
} |
} |
return @Data; |
return @Data; |
} |
} |
Line 767 sub save_export_data {
|
Line 967 sub save_export_data {
|
return if ($self->temporary()); |
return if ($self->temporary()); |
my $student = $self->{'name'}.':'.$self->{'domain'}; |
my $student = $self->{'name'}.':'.$self->{'domain'}; |
my $symb = $self->{'symb'}; |
my $symb = $self->{'symb'}; |
|
if ($self->badcalc()){ |
|
# do not save data away when calculations have not been done properly. |
|
delete($Exportrows{$symb}); |
|
return; |
|
} |
if (! exists($Exportrows{$symb}) || |
if (! exists($Exportrows{$symb}) || |
! exists($Exportrows{$symb}->{$self->{'filename'}})) { |
! exists($Exportrows{$symb}->{$self->{'filename'}})) { |
return; |
return; |
} |
} |
my $key = join(':',($self->{'name'},$self->{'domain'},'assesscalc',$symb)); |
my $key = join(':',($self->{'name'},$self->{'domain'},'assesscalc',$symb)); |
my $timekey = $key.'.time'; |
my $timekey = $key.'.time'; |
my $newstore= join('___;___',@{$Exportrows{$symb}->{$self->{'filename'}}}); |
my $newstore= join('___;___', |
|
map {s/[^[:print:]]//g;$_;} # strip out unprintable |
|
@{$Exportrows{$symb}->{$self->{'filename'}}}); |
$newstore = $self->{'filename'}.'___=___'.$newstore; |
$newstore = $self->{'filename'}.'___=___'.$newstore; |
my $result = &Apache::lonnet::put |
$newExportrows{$student}->{$key} = $newstore; |
('nohist_calculatedsheets_'.$ENV{'request.course.id'}, |
$newExportrows{$student}->{$timekey} = $Exportrows{$symb}->{'time'}; |
{ $key => $newstore, |
|
$timekey => $Exportrows{$symb}->{'time'} }, |
|
$self->{'domain'}, |
|
$self->{'name'}); |
|
|
|
return; |
return; |
} |
} |
|
|