--- loncom/interface/spreadsheet/assesscalc.pm 2003/05/22 21:16:35 1.5 +++ loncom/interface/spreadsheet/assesscalc.pm 2014/02/11 19:11:30 1.60 @@ -1,5 +1,5 @@ # -# $Id: assesscalc.pm,v 1.5 2003/05/22 21:16:35 matthew Exp $ +# $Id: assesscalc.pm,v 1.60 2014/02/11 19:11:30 bisitz Exp $ # # Copyright Michigan State University Board of Trustees # @@ -44,14 +44,18 @@ assesscalc 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'); @@ -88,6 +92,7 @@ use Time::HiRes; ######################################################## my %Exportrows; +my %newExportrows; my $current_name; my $current_domain; @@ -97,7 +102,9 @@ my %parmhash; my %nice_parameter_name; my %useropt; +my %userdata; my %courseopt; +my $navmap; ######################################################## ######################################################## @@ -108,19 +115,51 @@ my %courseopt; =item &clear_package() -Reset all package variables. +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(); } ######################################################## @@ -135,15 +174,22 @@ sub clear_package { ######################################################## ######################################################## sub initialize_package { - my ($sname,$sdomain) = @_; - $current_course = $ENV{'request.course.id'}; + my ($sname,$sdomain,$in_navmap,$calling_sheet) = @_; $current_name = $sname; $current_domain = $sdomain; - undef(%courseopt); + $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(); + &load_parameter_caches($calling_sheet); + &Apache::loncoursedata::clear_internal_caches(); } + ######################################################## ######################################################## @@ -156,20 +202,19 @@ sub initialize_package { ######################################################## ######################################################## sub load_parameter_caches { + my ($calling_sheet) = @_; my $userprefix = $current_name.':'.$current_domain.'_'; $userprefix =~ s/:/_/g; # # Course Parameters Cache if (! %courseopt) { - &Apache::lonnet::logthis("loading course options"); - $current_course = $ENV{'request.course.id'}; + $current_course = $env{'request.course.id'}; undef(%courseopt); if (! defined($current_name) || ! defined($current_domain)) { - &Apache::lonnet::logthis('bad call to setup_parameter_caches'); return; } - my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; - my $id = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; + my $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; @@ -185,7 +230,18 @@ sub load_parameter_caches { } $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; } ######################################################## @@ -199,20 +255,29 @@ sub load_parameter_caches { ######################################################## ######################################################## -sub ensure_current_parameter_caches { +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'}; + $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(); + &load_parameter_caches($self); } ################################################## @@ -230,7 +295,8 @@ Returns: The value of a parameter, or '' 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. +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. @@ -241,16 +307,20 @@ this user and course. ################################################## sub parmval { my $self = shift; - my ($what,$symb,$uname,$udom,$csec)=@_; - $uname = $self->{'name'} if (! defined($uname)); - $udom = $self->{'domain'} if (! defined($udom)); - $csec = $self->{'section'} if (! defined($csec)); - $symb = $self->{'symb'} if (! defined($symb)); + my ($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=''; # # This should be a - my ($mapname,$id,$fn)=split(/___/,$symb); + 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\_//; @@ -272,12 +342,23 @@ sub parmval { my $ucourselevel = $usercourseprefix.'.'.$what; my $ucourselevelr = $usercourseprefix.'.'.$symbparm; my $ucourselevelm = $usercourseprefix.'.'.$mapparm; - # check user + # check user if (defined($uname)) { return $useropt{$ucourselevelr} if (defined($useropt{$ucourselevelr})); return $useropt{$ucourselevelm} if (defined($useropt{$ucourselevelm})); 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,$what) { + my $item = $courseprefix.'.['.$group.'].'.$level; + if (defined($courseopt{$item})) { + return $courseopt{$item}; + } + } + } + } # check section if (defined($csec)) { return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr})); @@ -287,18 +368,19 @@ sub parmval { # # check course return $courseopt{$courselevelr} if (defined($courseopt{$courselevelr})); - return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm})); - return $courseopt{$courselevel} if (defined($courseopt{$courselevel})); # 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{$courselevel} if (defined($courseopt{$courselevel})); + # Cascade Up my $space=$what; - $space=~s/\.\w+$//; + $space=~s/\.[^._]+$//; if ($space ne '0') { my @parts=split(/_/,$space); my $id=pop(@parts); @@ -306,40 +388,53 @@ sub parmval { if ($part eq '') { $part='0'; } my $newwhat=$rwhat; $newwhat=~s/\Q$space\E/$part/; - my $partgeneral=$self->parmval($newwhat,$symb,$uname,$udom,$csec); + 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 = '

'.$assess_title.'

'. + '

'.$name.', '. + &Apache::loncommon::aboutmewrapper + ($self->{'name'}.'@'.$self->{'domain'}, + $self->{'name'},$self->{'domain'}); + $title .= '

'.$time.'

'; + return $title; +} + sub get_title { my $self = shift; - my $title; - if (($self->{'usymb'} eq '_feedback') || - ($self->{'usymb'} eq '_evaluation') || - ($self->{'usymb'} eq '_discussion') || - ($self->{'usymb'} eq '_tutoring')) { - $title = $self->{'usymb'}; - $title =~ s/^_//; - $title = '

'.ucfirst($title)."

\n"; + 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 { - $title = '

'.&Apache::lonnet::gettitle($self->{'symb'})."

\n"; + 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 %userenv = &Apache::loncoursedata::GetUserName($self->{'name'}, - $self->{'domain'}); - my $name = - join(' ',@userenv{'firstname','middlename','lastname','generation'}); - $name =~ s/\s+$//; - $title .= '

'.$name.', '. - &Apache::loncommon::aboutmewrapper($self->{'name'}.'@'.$self->{'domain'}, - $self->{'name'},$self->{'domain'}). - "

\n"; - $title .= '

'.localtime(time).'

'; - # - return $title; + my $name = &Apache::loncommon::plainname($self->{'name'}, + $self->{'domain'}); + push (@title,$name); + push (@title,&Apache::lonlocal::locallocaltime(time)); + return @title; } sub parent_link { @@ -347,31 +442,41 @@ sub parent_link { my $link .= '

'. - 'Student level sheet

'."\n"; + &mt('Student level sheet').'

'."\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"; - - + + + $lt{'ca'} END my $label_num = 0; foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ if ($label_num<$num_uneditable) { - $tableheader .= ''. - $self->html_template_row($num_uneditable)."\n"); + $r->print(''. + $self->html_template_row($num_uneditable,$importcolor). + "\n"); # # Print out summary/export row - $r->print(''. - $self->html_export_row()."\n"); + $r->print(''. + $self->html_export_row($exportcolor)."\n"); # # Prepare to output rows - $tableheader =<<"END"; -
Assessment $lt{'as'}  - Calculations
'; + $tableheader .= ''; } else { $tableheader .= ''; } @@ -383,21 +488,22 @@ END $r->print($tableheader); # # Print out template row - $r->print('
Template 
'.&mt('Template').' 
Export0
'.&mt('Export').'0
- -END + $tableheader = + '
rowItem
'. + ''. + ''; foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ if ($label_num<$num_uneditable) { - $tableheader.='
'.&mt('Row').''.&mt('Item').''; + $tableheader.=''; } else { $tableheader.=''; } @@ -405,12 +511,17 @@ END } # my $num_output = 0; - foreach my $rownum ($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) { $r->print("
\n".$tableheader); } $r->print(''.$rownum.''. - $self->assess_html_row($num_uneditable,$rownum)."\n"); + $self->assess_html_row($rownum,$importcolor)."\n"); } $r->print("\n"); return; @@ -418,89 +529,241 @@ END sub assess_html_row { my $self = shift(); - my ($num_uneditable,$row) = @_; - my $requester_is_student = ($ENV{'request.role'} =~ /^st\./); + my ($row,$importcolor) = @_; my $parameter_name = $self->{'formulas'}->{'A'.$row}; my @rowdata = $self->get_row($row); my $num_cols_output = 0; my $row_html; - if (exists($nice_parameter_name{$parameter_name})) { - my $name = $nice_parameter_name{$parameter_name}; + my $name=$self->get_parm_name($parameter_name); + if ($name ne '') { $name =~ s/ /\ /g; $row_html .= ''.$name.'
'.$parameter_name.''; } else { $row_html .= ''.$parameter_name.''; } foreach my $cell (@rowdata) { - if ($requester_is_student || - $num_cols_output++ < $num_uneditable) { - $row_html .= ''; - $row_html .= &Apache::Spreadsheet::html_uneditable_cell($cell,'#FFDDDD'); - } else { - $row_html .= ''; - $row_html .= &Apache::Spreadsheet::html_editable_cell($cell,'#E0FFDD'); - } + if ($num_cols_output < 1) { + $row_html .= ''; + $row_html .= &Apache::Spreadsheet::html_uneditable_cell($cell, + '#FFDDDD'); + } else { + $row_html .= ''; + $row_html .= &Apache::Spreadsheet::html_editable_cell($cell, + '#E0FFDD',1); + } $row_html .= ''; + $num_cols_output++; } return $row_html; } -sub outsheet_csv { - my $self = shift; - my ($r)=@_; -} - -sub outsheet_excel { - my $self = shift; - my ($r)=@_; +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 display { - my $self = shift; - my ($r) = @_; - $self->compute(); - $self->outsheet_html($r); +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; } -sub compute { +## +## Routines to support assesscalc::compute +## +sub get_parm { my $self = shift; - $self->logthis('computing'); - $self->initialize_safe_space(); - # - # Definitions - undef(%nice_parameter_name); - my %parameters; # holds underscored parameters by name + my @Mandatory_parameters = @_; + my %parameters; # - # Get the metadata fields and determine their proper names - my ($symap,$syid,$srcf)=split(/___/,$self->{'symb'}); + my ($symap,$syid,$srcf) = &Apache::lonnet::decode_symb($self->{'symb'}); my @Metadata = split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); - foreach my $parm (@Metadata) { + 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}++; - $nice_parameter_name{$cleaned_name} = $display; + $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); } # - # Get the values of the metadata fields - $self->ensure_current_parameter_caches(); + my %parameters; + # my $filename = $self->{'coursefilename'}.'_parms.db'; if (tie(%parmhash,'GDBM_File', $self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { - foreach my $parmname (keys(%parameters)) { - my $value = $self->parmval($parmname); + 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)) { @@ -508,15 +771,14 @@ sub compute { } # # Get the students performance data - my %student_parameters = - &Apache::loncoursedata::get_current_state($self->{'name'}, - $self->{'domain'}, - $self->{'symb'}, - $self->{'cid'}); + $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; - $parameters{$parm} = $value; + # Clean out any bad parameters + next if (! $self->parameter_part_is_valid($parm)); + $parameters{$parm} = $value; } # # Set up the formulas and parameter values @@ -524,11 +786,14 @@ sub compute { my %c; # # Check for blackout requirements - if ((!exists($ENV{'request.role.adv'}) || !$ENV{'request.role.adv'})) { + 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$/); - next if ($parameters{$1.'_answerdate'}blackout(1); @@ -540,22 +805,26 @@ sub compute { while (my ($parm,$value) = each(%parameters)) { my $cell = 'A'.$self->get_row_number_from_key($parm); $f{$cell} = $parm; - $c{$parm} = ''; - if ($value ne '') { - $c{$parm} = '"'.$value.'"'; + if ($parm =~ /_submission$/ && $value =~ /(\{|\})/) { + $value = 'witheld'; } + $value = 'q{'.$value.'}' if ($value =~/([^\d\.]|\.\.)/); + $c{$parm} = $value; } - $self->formulas(%f); - $self->constants(%c); + 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(); - $Exportrows{$self->{'symb'}}->{'time'} = time; - $Exportrows{$self->{'symb'}}->{$self->{'filename'}} = \@exportarray; - # - # Save the export data - $self->save_export_data(); + $self->deal_with_export_row(@exportarray); + $self->save() if ($self->need_to_save()); return; } @@ -565,6 +834,7 @@ sub compute { 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. @@ -582,7 +852,7 @@ sub sett { # Replace 'A0' with the value from 'A0' $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; # Replace parameters - $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; + $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/sge; } } # @@ -590,14 +860,18 @@ sub sett { while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { next if ($cell =~ /template_/); if ($cell =~ /^A/ && $cell ne 'A0') { - if ($formula !~ /^\!/) { - $t{$cell}=$self->{'constants'}->{$formula}; + 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)/ge; + $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/sge; } } # Put %t into the safe space @@ -624,17 +898,21 @@ These rows are saved in the students dir ######################################################## ######################################################## sub load_cached_export_rows { - %Exportrows = undef; + undef(%Exportrows); my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets_'. - $ENV{'request.course.id'}, + $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'}. + 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; @@ -665,21 +943,31 @@ spreadsheet only if necessary. ############################################# sub export_data { my $self = shift; + my ($r) = @_; 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}) || ! $self->check_expiration_time($Exportrows{$symb}->{'time'}) || ! exists($Exportrows{$symb}->{$self->{'filename'}}) || - ! defined($Exportrows{$symb}->{$self->{'filename'}})) { - $self->compute(); - } - my @Data = @{$Exportrows{$symb}->{$self->{'filename'}}}; - if ($Data[0] =~ /^(.*)___=___/) { - $self->{'sheetname'} = $1; - $Data[0] =~ s/^(.*)___=___//; - } - for (my $i=0;$i<$#Data;$i++) { - $Data[$i]="'".$Data[$i]."'" if ($Data[$i]=~/\D/ && defined($Data[$i])); + ! 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; } @@ -699,23 +987,26 @@ Writes the export data for this spreadsh ############################################# 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('___;___',@{$Exportrows{$symb}->{$self->{'filename'}}}); + my $newstore= join('___;___', + map {s/[^[:print:]]//g;$_;} # strip out unprintable + @{$Exportrows{$symb}->{$self->{'filename'}}}); $newstore = $self->{'filename'}.'___=___'.$newstore; - my $result = &Apache::lonnet::put - ('nohist_calculatedsheets_'.$ENV{'request.course.id'}, - { $key => $newstore, - $timekey => $Exportrows{$symb}->{'time'} }, - $self->{'domain'}, - $self->{'name'}); - + $newExportrows{$student}->{$key} = $newstore; + $newExportrows{$student}->{$timekey} = $Exportrows{$symb}->{'time'}; return; }