--- loncom/interface/spreadsheet/assesscalc.pm 2003/09/05 01:06:45 1.18 +++ loncom/interface/spreadsheet/assesscalc.pm 2003/09/10 18:33:35 1.21 @@ -1,5 +1,5 @@ # -# $Id: assesscalc.pm,v 1.18 2003/09/05 01:06:45 matthew Exp $ +# $Id: assesscalc.pm,v 1.21 2003/09/10 18:33:35 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -144,6 +144,7 @@ sub initialize_package { my ($sname,$sdomain) = @_; $current_name = $sname; $current_domain = $sdomain; + undef(%useropt); if ($current_course ne $ENV{'request.course.id'}) { $current_course = $ENV{'request.course.id'}; undef(%courseopt); @@ -172,7 +173,6 @@ sub load_parameter_caches { $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'}; @@ -192,6 +192,7 @@ sub load_parameter_caches { } $useropt{$userprefix.$name}=$value; } + $useropt{'loadtime'} = time; } } @@ -208,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'}; @@ -257,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\_//; @@ -516,8 +523,76 @@ sub excel_rows { return; } +## +## Routines to support assesscalc::compute +## +sub get_parm_names { + my $self = shift; + my @Mandatory_parameters = @_; + my %parameters_and_names; + # + my ($symap,$syid,$srcf)=split(/___/,$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 compute { my $self = shift; + my ($r) = @_; + my $connection = $r->connection(); + if ($connection->aborted()) { $self->cleanup(); return; } # $self->logthis('computing'); $self->initialize_safe_space(); ######################################### @@ -539,35 +614,18 @@ sub compute { my %parameters; # holds underscored parameters by name # # 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 (@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'); - } + 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(); - 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); - $parameters{$parmname} =$value; - } - untie(%parmhash); - } else { - $self->logthis('unable to tie '.$filename); - } + 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)) { @@ -595,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; @@ -612,16 +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; } @@ -731,6 +792,8 @@ 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}) || @@ -739,8 +802,9 @@ sub export_data { ! defined($Exportrows{$symb}->{$self->{'filename'}}) || ! ref($Exportrows{$symb}->{$self->{'filename'}}) ) { - $self->compute(); + $self->compute($r); } + if ($connection->aborted()) { $self->cleanup(); return; } my @Data = @{$Exportrows{$symb}->{$self->{'filename'}}}; if ($Data[0] =~ /^(.*)___=___/) { $self->{'sheetname'} = $1;