loncom/interface/spreadsheet/assesscalc.pm - view

File: [LON-CAPA] / loncom / interface / spreadsheet / assesscalc.pm
Revision 1.61: download - view: text, annotated - select for diffs
Wed Mar 2 14:14:21 2016 UTC (8 years, 8 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, HEAD

- Bug 4373. Ability to set map-level parameters which apply recursively
  to subfolders.

# # $Id: assesscalc.pm,v 1.61 2016/03/02 14:14:21 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # # The LearningOnline Network with CAPA # Spreadsheet/Grades Display Handler # # POD required stuff: =head1 NAME assesscalc =head1 SYNOPSIS =head1 DESCRIPTION =cut ################################################### ### AssessSheet ### ################################################### package Apache::assesscalc; use strict; use warnings FATAL=>'all'; no warnings 'uninitialized'; use Apache::Constants qw(:common :http); use Apache::lonnet; use Apache::loncommon; use Apache::Spreadsheet; use Apache::loncoursedata(); use HTML::Entities(); use Spreadsheet::WriteExcel; use GDBM_File; use Time::HiRes; use Apache::lonlocal; @Apache::assesscalc::ISA = ('Apache::Spreadsheet'); ######################################################## ######################################################## =pod =head2 Package Variables =over 4 =item %Exportrows =item $current_name =item $current_domain =item $current_course =item %parmhash =item %nice_parameter_name =item %useropt =item %courseopt =back =cut ######################################################## ######################################################## my %Exportrows; my %newExportrows; my $current_name; my $current_domain; my $current_course; my %parmhash; my %nice_parameter_name; my %useropt; my %userdata; my %courseopt; my $navmap; ######################################################## ######################################################## =pod =head2 Package Subroutines =item &clear_package() Reset all package variables and clean up caches. =cut ######################################################## ######################################################## 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(%newExportrows); undef($current_name); undef($current_domain); undef($current_course); undef(%useropt); undef(%userdata); 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 { my ($in_navmap) = @_; &clear_package(); $navmap = $in_navmap; if (! defined($navmap)) { $navmap = Apache::lonnavmaps::navmap->new(); } if ((!defined($navmap)) || (!ref($navmap))) { &Apache::lonnet::logthis('assesscalc:Can not open Coursemap'); } &Apache::loncoursedata::clear_internal_caches(); } ######################################################## ######################################################## =pod =item &initialize_package() =cut ######################################################## ######################################################## sub initialize_package { my ($sname,$sdomain,$in_navmap,$calling_sheet) = @_; $current_name = $sname; $current_domain = $sdomain; $navmap = $in_navmap; undef(%useropt); undef(%userdata); if ($current_course ne $env{'request.course.id'}) { $current_course = $env{'request.course.id'}; undef(%courseopt); } &load_cached_export_rows(); &load_parameter_caches($calling_sheet); &Apache::loncoursedata::clear_internal_caches(); } ######################################################## ######################################################## =pod =item &load_parameter_caches() =cut ######################################################## ######################################################## sub load_parameter_caches { my ($calling_sheet) = @_; my $userprefix = $current_name.':'.$current_domain.'_'; $userprefix =~ s/:/_/g; # # Course Parameters Cache if (! %courseopt) { $current_course = $env{'request.course.id'}; undef(%courseopt); if (! defined($current_name) || ! defined($current_domain)) { return; } my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $id = $env{'course.'.$env{'request.course.id'}.'.num'}; my %Tmp = &Apache::lonnet::dump('resourcedata',$dom,$id); while (my ($name,$value) = each(%Tmp)) { $courseopt{$name}=$value; } } if (! %useropt) { my %Tmp = &Apache::lonnet::dump('resourcedata', $current_domain,$current_name); while (my ($name,$value) = each(%Tmp)) { if ($name =~ /^error: 2/ || $name =~ /no such file/) { undef(%useropt); last; } $useropt{$userprefix.$name}=$value; } $useropt{'loadtime'} = time; } if (! %userdata) { %userdata = &Apache::loncoursedata::get_current_state($current_name, $current_domain); my ($tmp) = %userdata; if ($tmp =~ /^error:(.*)/) { $calling_sheet->set_calcerror($1); } $userdata{'loadtime'} = time; } return; } ######################################################## ######################################################## =pod =head2 assesscalc object methods =cut ######################################################## ######################################################## sub ensure_current_caches { my $self = shift; ## ## Check for a modified parameters ## if (! defined($current_course) || $current_course ne $env{'request.course.id'} ) { $current_course = $env{'request.course.id'}; undef(%courseopt); undef(%useropt); undef(%userdata); } ## ## Check for new user ## if (! defined($current_name) || $current_name ne $self->{'name'} || ! defined($current_domain) || $current_domain ne $self->{'domain'}) { $current_domain = $self->{'domain'}; $current_name = $self->{'name'}; undef(%useropt); undef(%userdata); } &load_parameter_caches($self); } ################################################## ################################################## =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 group, section level and course level), map, and lonnet::metadata. This function uses %parmhash, which must be tied prior to calling it. This function also requires %courseopt and %useropt to be initialized for this user and course. =cut ################################################## ################################################## sub parmval { my $self = shift; my ($what,$symb,$uname,$udom,$csec,$recurse,$mapname,$id,$fn,$groups)=@_; $uname = $self->{'name'} if (! defined($uname)); $udom = $self->{'domain'} if (! defined($udom)); $csec = $self->{'section'} if (! defined($csec)); $groups = $self->{'groups'} if (! defined($groups)); $symb = $self->{'symb'} if (! defined($symb)); # my $result=''; my @recurseup; # # This should be a if (!defined($mapname) || !defined($id) || !defined($fn)) { ($mapname,$id,$fn)=&Apache::lonnet::decode_symb($symb); $mapname = &Apache::lonnet::deversion($mapname); } # Cascading lookup scheme my $rwhat=$what; $what =~ s/^parameter\_//; $what =~ s/\_([^\_]+)$/\.$1/; # my $symbparm = $symb.'.'.$what; my $recurseparm=$mapname.'___(rec).'.$what; my $mapparm = $mapname.'___(all).'.$what; my $courseprefix = $self->{'cid'}; my $usercourseprefix = $uname.'_'.$udom.'_'.$self->{'cid'}; # my $seclevel = $courseprefix.'.['.$csec.'].'.$what; my $seclevelr = $courseprefix.'.['.$csec.'].'.$symbparm; my $secleveli = $courseprefix.'.['.$csec.'].'.$recurseparm; my $seclevelm = $courseprefix.'.['.$csec.'].'.$mapparm; # my $courselevel = $courseprefix.'.'.$what; my $courselevelr = $courseprefix.'.'.$symbparm; my $courseleveli = $courseprefix.'.'.$recurseparm; my $courselevelm = $courseprefix.'.'.$mapparm; # my $ucourselevel = $usercourseprefix.'.'.$what; my $ucourselevelr = $usercourseprefix.'.'.$symbparm; my $ucourseleveli = $usercourseprefix.'.'.$recurseparm; my $ucourselevelm = $usercourseprefix.'.'.$mapparm; # check user if (defined($uname)) { return $useropt{$ucourselevelr} if (defined($useropt{$ucourselevelr})); return $useropt{$ucourselevelm} if (defined($useropt{$ucourselevelm})); return $useropt{$ucourseleveli} if (defined($useropt{$ucourseleveli})); unless (@recurseup > 0) { @recurseup = &Apache::lonnet::get_map_hierarchy($mapname); } foreach my $item (@recurseup) { my $norecursechk=$usercourseprefix.'.'.$item.'___(all).'.$what; last if (defined($useropt{$norecursechk})); my $recursechk=$usercourseprefix.'.'.$item.'___(rec).'.$what; return $useropt{$recursechk} if (defined($useropt{$recursechk})); } return $useropt{$ucourselevel} if (defined($useropt{$ucourselevel})); } # check groups if (defined($groups) && ref($groups) eq 'ARRAY') { foreach my $group (@{$groups}) { foreach my $level ($symbparm,$mapparm,$recurseparm,$what) { my $item = $courseprefix.'.['.$group.'].'.$level; if ($level eq $what) { unless (@recurseup > 0) { @recurseup = &Apache::lonnet::get_map_hierarchy($mapname); } foreach my $item (@recurseup) { my $norecursechk=$courseprefix.'.['.$group.'].'.$item.'___(all).'.$what; last if (defined($courseopt{$norecursechk})); my $recursechk=$courseprefix.'.['.$group.'].'.$item.'___(rec).'.$what; return $courseopt{$recursechk} if (defined($courseopt{$recursechk})); } } if (defined($courseopt{$item})) { return $courseopt{$item}; } } } } # check section if (defined($csec)) { return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr})); return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm})); return $courseopt{$secleveli} if (defined($courseopt{$secleveli})); unless (@recurseup > 0) { @recurseup = &Apache::lonnet::get_map_hierarchy($mapname); } foreach my $item (@recurseup) { my $norecursechk=$courseprefix.'.['.$csec.'].'.$item.'___(all).'.$what; last if (defined($courseopt{$norecursechk})); my $recursechk=$courseprefix.'.['.$csec.'].'.$item.'___(rec).'.$what; return $courseopt{$recursechk} if (defined($courseopt{$secleveli})); } return $courseopt{$seclevel} if (defined($courseopt{$seclevel})); } # # check course return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr})); # check map parms my $thisparm = $parmhash{$symbparm}; return $thisparm if (defined($thisparm)); # check default $thisparm = &Apache::lonnet::metadata($fn,$rwhat.'.default'); return $thisparm if (defined($thisparm)); # check more course return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm})); return $courseopt{$courseleveli} if (defined($courseopt{$courseleveli})); unless (@recurseup > 0) { @recurseup = &Apache::lonnet::get_map_hierarchy($mapname); } foreach my $item (@recurseup) { my $norecursechk=$courseprefix.'.'.$item.'___(all).'.$what; last if (defined($courseopt{$norecursechk})); my $recursechk=$courseprefix.'.'.$item.'___(rec).'.$what; return $courseopt{$recursechk} if (defined($courseopt{$recursechk})); } return $courseopt{$courselevel} if (defined($courseopt{$courselevel})); # Cascade Up my $space=$what; $space=~s/\.[^._]+$//; if ($space ne '0') { my @parts=split(/_/,$space); my $id=pop(@parts); my $part=join('_',@parts); if ($part eq '') { $part='0'; } my $newwhat=$rwhat; $newwhat=~s/\Q$space\E/$part/; my $partgeneral=$self->parmval($newwhat,$symb,$uname,$udom,$csec,1, $mapname,$id,$fn,$groups); if (defined($partgeneral)) { return $partgeneral; } } if ($recurse) { return undef; } my $pack_def=&Apache::lonnet::packages_tab_default($fn,'resource.'.$what); if (defined($pack_def)) { return $pack_def; } #nothing defined return ''; } sub get_html_title { my $self = shift; my ($assess_title,$name,$time) = $self->get_full_title(); my $title = '<h1>'.$assess_title.'</h1>'. '<h2>'.$name.', '. &Apache::loncommon::aboutmewrapper ($self->{'name'}.'@'.$self->{'domain'}, $self->{'name'},$self->{'domain'}); $title .= '<h3>'.$time.'</h3>'; return $title; } sub get_title { my $self = shift; if (($self->{'symb'} eq '_feedback') || ($self->{'symb'} eq '_evaluation') || ($self->{'symb'} eq '_discussion') || ($self->{'symb'} eq '_tutoring')) { my $assess_title = ucfirst($self->{'symb'}); $assess_title =~ s/^_//; return $assess_title; } else { return &Apache::lonnet::gettitle($self->{'symb'}); } } sub get_full_title { my $self = shift; my @title = ($self->get_title()); # Look up the users identifying information # Get the users information my $name = &Apache::loncommon::plainname($self->{'name'}, $self->{'domain'}); push (@title,$name); push (@title,&Apache::lonlocal::locallocaltime(time)); return @title; } sub parent_link { my $self = shift; my $link .= '<p><a href="/adm/studentcalc?'. 'sname='.$self->{'name'}. '&sdomain='.$self->{'domain'}.'">'. &mt('Student level sheet').'</a></p>'."\n"; return $link; } sub outsheet_html { my $self = shift; my ($r) = @_; #################################### # Report any calculation errors # #################################### $r->print($self->html_report_error()); ################################### # Determine table structure ################################### my $importcolor = '#FFFFFF'; my $exportcolor = '#FFFFAA'; my $num_uneditable = 1; my $num_left = 52-$num_uneditable; my %lt=&Apache::lonlocal::texthash( 'as' => 'Assessment', 'ca' => 'Calculations', ); my $tableheader =<<"END"; <table border="2"> <tr> <th colspan="2" rowspan="2"><font size="+2">$lt{'as'}</font></th> <td bgcolor="$importcolor" colspan="$num_uneditable"> </td> <td colspan="$num_left"> <b><font size="+1">$lt{'ca'}</font></b></td> </tr><tr> END my $label_num = 0; foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ if ($label_num<$num_uneditable) { $tableheader .= '<td bgcolor="'.$importcolor.'">'; } else { $tableheader .= '<td>'; } $tableheader .= "<b><font size=+1>$_</font></b></td>"; $label_num++; } $tableheader.="</tr>\n"; # $r->print($tableheader); # # Print out template row $r->print('<tr><td>'.&mt('Template').'</td><td> </td>'. $self->html_template_row($num_uneditable,$importcolor). "</tr>\n"); # # Print out summary/export row $r->print('<tr><td>'.&mt('Export').'</td><td>0</td>'. $self->html_export_row($exportcolor)."</tr>\n"); # # Prepare to output rows $tableheader = '<table border="2">'. '<tr><th>'.&mt('Row').'</th>'. '<th>'.&mt('Item').'</th>'; foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ if ($label_num<$num_uneditable) { $tableheader.='<th bgcolor="'.$importcolor.'">'; } else { $tableheader.='<th>'; } $tableheader.="<b><font size=+1>$_</font></b></th>"; } # my $num_output = 0; foreach my $rownum (sort {$a <=> $b} ($self->rows())) { if (! $self->parameter_part_is_valid( $self->{'formulas'}->{'A'.$rownum} )) { next; } if ($num_output++ % 50 == 0) { $r->print("</table>\n".$tableheader); } $r->print('<tr><td>'.$rownum.'</td>'. $self->assess_html_row($rownum,$importcolor)."</tr>\n"); } $r->print("</table>\n"); return; } sub assess_html_row { my $self = shift(); my ($row,$importcolor) = @_; my $parameter_name = $self->{'formulas'}->{'A'.$row}; my @rowdata = $self->get_row($row); my $num_cols_output = 0; my $row_html; my $name=$self->get_parm_name($parameter_name); if ($name ne '') { $name =~ s/ /\ /g; $row_html .= '<td>'.$name.'<br />'.$parameter_name.'</td>'; } else { $row_html .= '<td>'.$parameter_name.'</td>'; } foreach my $cell (@rowdata) { if ($num_cols_output < 1) { $row_html .= '<td bgcolor="'.$importcolor.'">'; $row_html .= &Apache::Spreadsheet::html_uneditable_cell($cell, '#FFDDDD'); } else { $row_html .= '<td bgcolor="#E0FFDD">'; $row_html .= &Apache::Spreadsheet::html_editable_cell($cell, '#E0FFDD',1); } $row_html .= '</td>'; $num_cols_output++; } return $row_html; } sub csv_rows { # writes the meat of the spreadsheet to an excel worksheet. Called # by Spreadsheet::outsheet_excel; my $self = shift; my ($connection,$filehandle) = @_; # # Write a header row $self->csv_output_row($filehandle,undef, (&mt('Parameter'),&mt('Description'),&mt('Value'))); # # Write each row foreach my $rownum (sort {$a <=> $b} ($self->rows())) { my $parameter_name = $self->{'formulas'}->{'A'.$rownum}; my $description = $self->get_parm_name($parameter_name); $self->csv_output_row($filehandle,$rownum, $parameter_name,$description); } return; } sub excel_rows { # writes the meat of the spreadsheet to an excel worksheet. Called # by Spreadsheet::outsheet_excel; my $self = shift; my ($connection,$worksheet,$cols_output,$rows_output,$format) = @_; return if (! ref($worksheet)); # # Write a header row $cols_output = 0; foreach my $value ('Parameter','Description','Value') { $worksheet->write($rows_output,$cols_output++,$value,$format->{'h4'}); } $rows_output++; # # Write each row foreach my $rownum (sort {$a <=> $b} ($self->rows())) { my $parameter_name = $self->{'formulas'}->{'A'.$rownum}; my $description = $self->get_parm_name($parameter_name); $self->excel_output_row($worksheet,$rownum,$rows_output++, $parameter_name,$description); } return; } ## ## Routines to support assesscalc::compute ## sub get_parm { my $self = shift; my @Mandatory_parameters = @_; my %parameters; # 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; $parameters{$cleaned_name}=1; } return (keys(%parameters)); } sub get_parm_name { my $self = shift; my $parm = shift; my ($symap,$syid,$srcf) = &Apache::lonnet::decode_symb($self->{'symb'}); my $display = &Apache::lonnet::metadata($srcf,$parm.'.display'); if (! $display) { $display .= &Apache::lonnet::metadata($srcf,$parm.'.name'); } return $display; } 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)) { my ($mapname,$id,$fn)=&Apache::lonnet::decode_symb($self->{'symb'}); $mapname = &Apache::lonnet::deversion($mapname); foreach my $parmname (@Parameters) { my $value = $self->parmval($parmname,$self->{'symb'}, $self->{'name'},$self->{'domain'}, $self->{'section'},undef, $mapname,$id,$fn,$self->{'groups'}); $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; my $check_hidden = 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)) { next; } if (!$check_hidden) { $Parts{$part}++; next; } if (!&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 ($start,@pieces)=split('_',$parameter); if ( $start !~ m/^(resource|stores|parameter)$/) { return 0; } while (@pieces) { pop(@pieces); my $testpart=join('_',@pieces); if (exists($self->{'Parts'}->{$testpart}) && $self->{'Parts'}->{$testpart} ) { return 1; } } return 0; } sub compute { my $self = shift; my ($r) = @_; $self->initialize_safe_space(); ######################################### ######################################### ### ### ### Retrieve the problem parameters ### ### ### ######################################### ######################################### my @Mandatory_parameters = ("stores_0_solved", "stores_0_awarddetail", "stores_0_awarded", "timestamp", "stores_0_tries", "stores_0_award"); # # Definitions undef(%nice_parameter_name); my %parameters; # holds underscored parameters by name # # Get the metadata fields and determine their proper names my @parameters=$self->get_parm(@Mandatory_parameters); # # Get the values of the metadata fields $self->ensure_current_caches(); %parameters = $self->get_parameter_values(@parameters); # # Clean out unnecessary parameters foreach (keys(%parameters)) { delete($parameters{$_}) if (! /(resource\.|stores_|parameter_)/); } # # Get the students performance data $self->determine_parts(($parameters{'parameter_0_hiddenparts'} ne '')); my %student_parameters = $self->get_problem_state(); while (my ($parm,$value) = each(%student_parameters)) { $parm =~ s/^resource\./stores_/; $parm =~ s/\./_/g; # Clean out any bad parameters next if (! $self->parameter_part_is_valid($parm)); $parameters{$parm} = $value; } # # Set up the formulas and parameter values my %f=$self->formulas(); my %c; # # Check for blackout requirements if ((!exists($env{'request.role.adv'}) || !$env{'request.role.adv'})) { while (my ($parm,$value) = each(%parameters)) { last if ($self->blackout()); next if ($parm !~ /^(parameter_.*)_problemstatus$/); if ($parameters{$1.'_answerdate'} ne '' && $parameters{$1.'_answerdate'} < time) { next; } if (lc($value) eq 'no') { # We must blackout this sheet $self->blackout(1); } } } # # Move the parameters into the spreadsheet while (my ($parm,$value) = each(%parameters)) { my $cell = 'A'.$self->get_row_number_from_key($parm); $f{$cell} = $parm; if ($parm =~ /_submission$/ && $value =~ /(\{|\})/) { $value = 'witheld'; } $value = 'q{'.$value.'}' if ($value =~/([^\d\.]|\.\.)/); $c{$parm} = $value; } foreach my $cell (grep(/^A/,keys(%f))) { # Clean out any bad formulas next if (exists($c{$f{$cell}})); next if ($cell eq 'A0'); delete($f{$cell}); } $self->formulas(\%f); $self->constants(\%c); $self->calcsheet(); # # Store export row in cache my @exportarray = $self->exportrow(); $self->deal_with_export_row(@exportarray); $self->save() if ($self->need_to_save()); return; } ## ## sett overrides Spreadsheet::sett ## sub sett { my $self = shift; my %t=(); undef(%Apache::Spreadsheet::sheet_values); # # Deal with the template row by copying the template formulas into each # row. foreach my $col ($self->template_cells()) { next if ($col=~/^A/); foreach my $row ($self->rows()) { # Get the name of this cell my $cell=$col.$row; # Grab the template declaration $t{$cell}=$self->formula('template_'.$col); # Replace '#' with the row number $t{$cell}=~s/\#/$row/g; # Replace '....' with ',' $t{$cell}=~s/\.\.+/\,/g; # Replace 'A0' with the value from 'A0' $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; # Replace parameters $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/sge; } } # # Deal with the cells which have formulas while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { next if ($cell =~ /template_/); if ($cell =~ /^A/ && $cell ne 'A0') { if ($formula !~ /^\!/ && exists($self->{'constants'}->{$formula}) && $self->{'constants'}->{$formula} ne '' ) { $Apache::Spreadsheet::sheet_values{$cell}= eval($self->{'constants'}->{$formula}); } } else { $t{$cell}=$formula; $t{$cell}=~s/\.\.+/\,/g; $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/sge; } } # Put %t into the safe space %{$self->{'safe'}->varglob('t')}=%t; } ######################################################## ######################################################## =pod =item &load_cached_export_rows() Retrieves and parsers the export rows of the assessment spreadsheets. These rows are saved in the students directory in the format: sname:sdom:assesscalc:symb.time => time sname:sdom:assesscalc:symb => filename___=___Adata___;___Bdata___;___ ... =cut ######################################################## ######################################################## sub load_cached_export_rows { undef(%Exportrows); my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets_'. $env{'request.course.id'}, $current_domain,$current_name,undef); if ($tmp[0]!~/^error/) { my %tmp = @tmp; my $default_filename = $env{'course.'.$env{'request.course.id'}. '.spreadsheet_default_assesscalc'}; # We only got one key, so we will access it directly. while (my ($key,$sheetdata) = each(%tmp)) { my ($sname,$sdom,$sheettype,$symb) = split(':',$key); if (! defined($sname) || $sname eq '' || ! defined($sdom) || $sdom eq '' ) { next; } if ($symb =~ /\.time$/) { $symb =~ s/\.time$//; $Exportrows{$symb}->{'time'} = $sheetdata; } else { $sheetdata =~ s/^(.*)___=___//; my $filename = $1; $filename = $default_filename if (! defined($filename)); my @Data = split('___;___',$sheetdata); $Exportrows{$symb}->{$filename} = \@Data; } } } } ############################################# ############################################# =pod =item &export_data Returns the export data associated with the spreadsheet. Computes the spreadsheet only if necessary. =cut ############################################# ############################################# sub export_data { my $self = shift; my ($r) = @_; my $symb = $self->{'symb'}; if (! exists($env{'request.role.adv'}) || ! $env{'request.role.adv'} || ! exists($Exportrows{$symb}) || ! defined($Exportrows{$symb}) || ! $self->check_expiration_time($Exportrows{$symb}->{'time'}) || ! exists($Exportrows{$symb}->{$self->{'filename'}}) || ! defined($Exportrows{$symb}->{$self->{'filename'}}) || ! ref($Exportrows{$symb}->{$self->{'filename'}}) ) { $self->compute($r); } my @Data; if ($self->badcalc()) { @Data = (); } 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; } ############################################# ############################################# =pod =item &save_export_data() Writes the export data for this spreadsheet to the students cache. =cut ############################################# ############################################# sub save_export_data { my $self = shift; return if ($self->temporary()); my $student = $self->{'name'}.':'.$self->{'domain'}; 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}) || ! exists($Exportrows{$symb}->{$self->{'filename'}})) { return; } my $key = join(':',($self->{'name'},$self->{'domain'},'assesscalc',$symb)); my $timekey = $key.'.time'; my $newstore= join('___;___', map {s/[^[:print:]]//g;$_;} # strip out unprintable @{$Exportrows{$symb}->{$self->{'filename'}}}); $newstore = $self->{'filename'}.'___=___'.$newstore; $newExportrows{$student}->{$key} = $newstore; $newExportrows{$student}->{$timekey} = $Exportrows{$symb}->{'time'}; return; } 1; __END__