--- loncom/interface/spreadsheet/assesscalc.pm 2003/05/27 20:20:25 1.10 +++ loncom/interface/spreadsheet/assesscalc.pm 2003/09/10 18:33:35 1.21 @@ -1,5 +1,5 @@ # -# $Id: assesscalc.pm,v 1.10 2003/05/27 20:20:25 matthew Exp $ +# $Id: assesscalc.pm,v 1.21 2003/09/10 18:33:35 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -44,6 +44,8 @@ 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; @@ -123,6 +125,10 @@ sub clear_package { undef(%courseopt); } +sub initialize { + &clear_package(); +} + ######################################################## ######################################################## @@ -136,10 +142,13 @@ sub clear_package { ######################################################## sub initialize_package { my ($sname,$sdomain) = @_; - $current_course = $ENV{'request.course.id'}; $current_name = $sname; $current_domain = $sdomain; - undef(%courseopt); + undef(%useropt); + if ($current_course ne $ENV{'request.course.id'}) { + $current_course = $ENV{'request.course.id'}; + undef(%courseopt); + } &load_cached_export_rows(); &load_parameter_caches(); } @@ -161,11 +170,9 @@ sub load_parameter_caches { # # Course Parameters Cache if (! %courseopt) { - &Apache::lonnet::logthis("loading course options"); $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'}; @@ -185,6 +192,7 @@ sub load_parameter_caches { } $useropt{$userprefix.$name}=$value; } + $useropt{'loadtime'} = time; } } @@ -201,11 +209,17 @@ sub load_parameter_caches { ######################################################## sub ensure_current_parameter_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); } + ## + ## 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'}; @@ -241,7 +255,7 @@ this user and course. ################################################## sub parmval { my $self = shift; - my ($what,$symb,$uname,$udom,$csec)=@_; + my ($what,$symb,$uname,$udom,$csec,$recurse)=@_; $uname = $self->{'name'} if (! defined($uname)); $udom = $self->{'domain'} if (! defined($udom)); $csec = $self->{'section'} if (! defined($csec)); @@ -250,7 +264,7 @@ sub parmval { my $result=''; # # This should be a - my ($mapname,$id,$fn)=split(/___/,$symb); + my ($mapname,$id,$fn)=&Apache::lonnet::decode_symb($symb); # Cascading lookup scheme my $rwhat=$what; $what =~ s/^parameter\_//; @@ -306,9 +320,12 @@ 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); 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 ''; } @@ -328,11 +345,11 @@ sub get_html_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')) { - my $assess_title = ucfirst($self->{'usymb'}); + 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/^_//; push(@title,$assess_title); } else { @@ -365,13 +382,15 @@ sub outsheet_html { ################################### # Determine table structure ################################### + my $importcolor = '#FFFFFF'; + my $exportcolor = '#FFFFAA'; my $num_uneditable = 1; my $num_left = 52-$num_uneditable; my $tableheader =<<"END"; - + @@ -379,7 +398,7 @@ END my $label_num = 0; foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ if ($label_num<$num_uneditable) { - $tableheader .= ''. - $self->html_template_row($num_uneditable)."\n"); + $self->html_template_row($num_uneditable,$importcolor). + "\n"); # # Print out summary/export row $r->print(''. - $self->html_export_row()."\n"); + $self->html_export_row($exportcolor)."\n"); # # Prepare to output rows $tableheader =<<"END"; @@ -405,7 +425,7 @@ END END foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ if ($label_num<$num_uneditable) { - $tableheader.='
Assessment   Calculations
'; + $tableheader .= ''; } else { $tableheader .= ''; } @@ -392,11 +411,12 @@ END # # Print out template row $r->print('
Template 
Export0
'; + $tableheader.=''; } else { $tableheader.=''; } @@ -418,7 +438,7 @@ END $r->print("
\n".$tableheader); } $r->print(''.$rownum.''. - $self->assess_html_row($rownum)."\n"); + $self->assess_html_row($rownum,$importcolor)."\n"); } $r->print("\n"); return; @@ -426,7 +446,7 @@ END sub assess_html_row { my $self = shift(); - my ($row) = @_; + my ($row,$importcolor) = @_; my $parameter_name = $self->{'formulas'}->{'A'.$row}; my @rowdata = $self->get_row($row); my $num_cols_output = 0; @@ -440,7 +460,7 @@ sub assess_html_row { } foreach my $cell (@rowdata) { if ($num_cols_output < 1) { - $row_html .= ''; + $row_html .= ''; $row_html .= &Apache::Spreadsheet::html_uneditable_cell($cell, '#FFDDDD'); } else { @@ -503,19 +523,17 @@ sub excel_rows { return; } -sub compute { +## +## Routines to support assesscalc::compute +## +sub get_parm_names { 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_and_names; # - # Get the metadata fields and determine their proper names my ($symap,$syid,$srcf)=split(/___/,$self->{'symb'}); my @Metadata = split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); - foreach my $parm (@Metadata) { + foreach my $parm (@Mandatory_parameters,@Metadata) { next if ($parm !~ /^(resource\.|stores|parameter)_/); my $cleaned_name = $parm; $cleaned_name =~ s/^resource\./stores_/; @@ -525,16 +543,29 @@ sub compute { if (! $display) { $display .= &Apache::lonnet::metadata($srcf,$cleaned_name.'.name'); } - $parameters{$cleaned_name}++; - $nice_parameter_name{$cleaned_name} = $display; + $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); } # - # 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)) { + foreach my $parmname (@Parameters) { my $value = $self->parmval($parmname); $parameters{$parmname} =$value; } @@ -542,6 +573,59 @@ sub compute { } 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 compute { + my $self = shift; + my ($r) = @_; + my $connection = $r->connection(); + if ($connection->aborted()) { $self->cleanup(); return; } +# $self->logthis('computing'); + $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 %nice_parm_names = $self->get_parm_names(@Mandatory_parameters); + while (my($cleaned_name,$display) = each(%nice_parm_names)) { + $parameters{$cleaned_name}++; + $nice_parameter_name{$cleaned_name} = $display; + } + # + # Get the values of the metadata fields + if ($connection->aborted()) { $self->cleanup(); return; } + $self->ensure_current_parameter_caches(); + if ($connection->aborted()) { $self->cleanup(); return; } + %parameters = $self->get_parameter_values(keys(%parameters)); + if ($connection->aborted()) { $self->cleanup(); return; } # # Clean out unnecessary parameters foreach (keys(%parameters)) { @@ -569,15 +653,20 @@ sub compute { while (my ($parm,$value) = each(%parameters)) { last if ($self->blackout()); next if ($parm !~ /^(parameter_.*)_problemstatus$/); - next if ($parameters{$1.'_answerdate'}blackout(1); } } } + if ($connection->aborted()) { $self->cleanup(); return; } # # Move the parameters into the spreadsheet + if ($connection->aborted()) { $self->cleanup(); return; } while (my ($parm,$value) = each(%parameters)) { my $cell = 'A'.$self->get_row_number_from_key($parm); $f{$cell} = $parm; @@ -586,15 +675,14 @@ sub compute { } $self->formulas(\%f); $self->constants(\%c); + if ($connection->aborted()) { $self->cleanup(); return; } $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()); + if ($connection->aborted()) { $self->cleanup(); return; } return; } @@ -663,7 +751,7 @@ 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'}, $current_domain,$current_name,undef); @@ -704,14 +792,19 @@ spreadsheet only if necessary. ############################################# sub export_data { my $self = shift; + my ($r) = @_; + my $connection = $r->connection(); 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'}})) { - $self->compute(); + ! defined($Exportrows{$symb}->{$self->{'filename'}}) || + ! ref($Exportrows{$symb}->{$self->{'filename'}}) + ) { + $self->compute($r); } + if ($connection->aborted()) { $self->cleanup(); return; } my @Data = @{$Exportrows{$symb}->{$self->{'filename'}}}; if ($Data[0] =~ /^(.*)___=___/) { $self->{'sheetname'} = $1;