version 1.19, 2003/09/05 01:57:54
|
version 1.21, 2003/09/10 18:33:35
|
Line 144 sub initialize_package {
|
Line 144 sub initialize_package {
|
my ($sname,$sdomain) = @_; |
my ($sname,$sdomain) = @_; |
$current_name = $sname; |
$current_name = $sname; |
$current_domain = $sdomain; |
$current_domain = $sdomain; |
|
undef(%useropt); |
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); |
Line 172 sub load_parameter_caches {
|
Line 173 sub load_parameter_caches {
|
$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 192 sub load_parameter_caches {
|
Line 192 sub load_parameter_caches {
|
} |
} |
$useropt{$userprefix.$name}=$value; |
$useropt{$userprefix.$name}=$value; |
} |
} |
|
$useropt{'loadtime'} = time; |
} |
} |
} |
} |
|
|
Line 263 sub parmval {
|
Line 264 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 522 sub excel_rows {
|
Line 523 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)=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 { |
sub compute { |
my $self = shift; |
my $self = shift; |
my ($r) = @_; |
my ($r) = @_; |
Line 548 sub compute {
|
Line 614 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; |
} |
} |
Line 568 sub compute {
|
Line 624 sub compute {
|
if ($connection->aborted()) { $self->cleanup(); return; } |
if ($connection->aborted()) { $self->cleanup(); return; } |
$self->ensure_current_parameter_caches(); |
$self->ensure_current_parameter_caches(); |
if ($connection->aborted()) { $self->cleanup(); return; } |
if ($connection->aborted()) { $self->cleanup(); return; } |
my $filename = $self->{'coursefilename'}.'_parms.db'; |
%parameters = $self->get_parameter_values(keys(%parameters)); |
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; } |
if ($connection->aborted()) { $self->cleanup(); return; } |
# |
# |
# Clean out unnecessary parameters |
# Clean out unnecessary parameters |
Line 607 sub compute {
|
Line 653 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'} eq '' || |
|
$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); |
Line 631 sub compute {
|
Line 680 sub compute {
|
# |
# |
# 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; } |
if ($connection->aborted()) { $self->cleanup(); return; } |
return; |
return; |