version 1.43, 2005/05/15 02:28:23
|
version 1.48, 2005/05/17 18:01:58
|
Line 301 this user and course.
|
Line 301 this user and course.
|
################################################## |
################################################## |
sub parmval { |
sub parmval { |
my $self = shift; |
my $self = shift; |
my ($what,$symb,$uname,$udom,$csec,$recurse)=@_; |
my ($what,$symb,$uname,$udom,$csec,$recurse,$mapname,$id,$fn)=@_; |
$uname = $self->{'name'} if (! defined($uname)); |
$uname = $self->{'name'} if (! defined($uname)); |
$udom = $self->{'domain'} if (! defined($udom)); |
$udom = $self->{'domain'} if (! defined($udom)); |
$csec = $self->{'section'} if (! defined($csec)); |
$csec = $self->{'section'} if (! defined($csec)); |
Line 310 sub parmval {
|
Line 310 sub parmval {
|
my $result=''; |
my $result=''; |
# |
# |
# This should be a |
# This should be a |
my ($mapname,$id,$fn)=&Apache::lonnet::decode_symb($symb); |
if (!defined($mapname) || !defined($id) || !defined($fn)) { |
|
($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 367 sub parmval {
|
Line 369 sub parmval {
|
if ($part eq '') { $part='0'; } |
if ($part eq '') { $part='0'; } |
my $newwhat=$rwhat; |
my $newwhat=$rwhat; |
$newwhat=~s/\Q$space\E/$part/; |
$newwhat=~s/\Q$space\E/$part/; |
my $partgeneral=$self->parmval($newwhat,$symb,$uname,$udom,$csec,1); |
my $partgeneral=$self->parmval($newwhat,$symb,$uname,$udom,$csec,1, |
|
$mapname,$id,$fn); |
if (defined($partgeneral)) { return $partgeneral; } |
if (defined($partgeneral)) { return $partgeneral; } |
} |
} |
if ($recurse) { return undef; } |
if ($recurse) { return undef; } |
Line 512 sub assess_html_row {
|
Line 515 sub assess_html_row {
|
my @rowdata = $self->get_row($row); |
my @rowdata = $self->get_row($row); |
my $num_cols_output = 0; |
my $num_cols_output = 0; |
my $row_html; |
my $row_html; |
if (exists($nice_parameter_name{$parameter_name})) { |
my $name=$self->get_parm_name($parameter_name); |
my $name = $nice_parameter_name{$parameter_name}; |
if ($name ne '') { |
$name =~ s/ /\ /g; |
$name =~ s/ /\ /g; |
$row_html .= '<td>'.$name.'<br />'.$parameter_name.'</td>'; |
$row_html .= '<td>'.$name.'<br />'.$parameter_name.'</td>'; |
} else { |
} else { |
Line 548 sub csv_rows {
|
Line 551 sub csv_rows {
|
# Write each row |
# Write each row |
foreach my $rownum (sort {$a <=> $b} ($self->rows())) { |
foreach my $rownum (sort {$a <=> $b} ($self->rows())) { |
my $parameter_name = $self->{'formulas'}->{'A'.$rownum}; |
my $parameter_name = $self->{'formulas'}->{'A'.$rownum}; |
my $description = ''; |
my $description = $self->get_parm_name($parameter_name); |
if (exists($nice_parameter_name{$parameter_name})) { |
|
$description = $nice_parameter_name{$parameter_name}; |
|
} |
|
$self->csv_output_row($filehandle,$rownum, |
$self->csv_output_row($filehandle,$rownum, |
$parameter_name,$description); |
$parameter_name,$description); |
} |
} |
Line 575 sub excel_rows {
|
Line 575 sub excel_rows {
|
# Write each row |
# Write each row |
foreach my $rownum (sort {$a <=> $b} ($self->rows())) { |
foreach my $rownum (sort {$a <=> $b} ($self->rows())) { |
my $parameter_name = $self->{'formulas'}->{'A'.$rownum}; |
my $parameter_name = $self->{'formulas'}->{'A'.$rownum}; |
my $description = ''; |
my $description = $self->get_parm_name($parameter_name); |
if (exists($nice_parameter_name{$parameter_name})) { |
|
$description = $nice_parameter_name{$parameter_name}; |
|
} |
|
$self->excel_output_row($worksheet,$rownum,$rows_output++, |
$self->excel_output_row($worksheet,$rownum,$rows_output++, |
$parameter_name,$description); |
$parameter_name,$description); |
} |
} |
Line 588 sub excel_rows {
|
Line 585 sub excel_rows {
|
## |
## |
## Routines to support assesscalc::compute |
## Routines to support assesscalc::compute |
## |
## |
sub get_parm_names { |
sub get_parm { |
my $self = shift; |
my $self = shift; |
my @Mandatory_parameters = @_; |
my @Mandatory_parameters = @_; |
my %parameters_and_names; |
my %parameters; |
# |
# |
my ($symap,$syid,$srcf) = &Apache::lonnet::decode_symb($self->{'symb'}); |
my ($symap,$syid,$srcf) = &Apache::lonnet::decode_symb($self->{'symb'}); |
my @Metadata = split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); |
my @Metadata = split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); |
Line 600 sub get_parm_names {
|
Line 597 sub get_parm_names {
|
my $cleaned_name = $parm; |
my $cleaned_name = $parm; |
$cleaned_name =~ s/^resource\./stores_/; |
$cleaned_name =~ s/^resource\./stores_/; |
$cleaned_name =~ s/\./_/g; |
$cleaned_name =~ s/\./_/g; |
my $display = &Apache::lonnet::metadata($srcf, |
$parameters{$cleaned_name}=1; |
$cleaned_name.'.display'); |
|
if (! $display) { |
|
$display .= &Apache::lonnet::metadata($srcf,$cleaned_name.'.name'); |
|
} |
|
$parameters_and_names{$cleaned_name}=$display; |
|
} |
} |
return (%parameters_and_names); |
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 { |
sub get_parameter_values { |
Line 627 sub get_parameter_values {
|
Line 630 sub get_parameter_values {
|
my $filename = $self->{'coursefilename'}.'_parms.db'; |
my $filename = $self->{'coursefilename'}.'_parms.db'; |
if (tie(%parmhash,'GDBM_File', |
if (tie(%parmhash,'GDBM_File', |
$self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { |
$self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { |
|
my ($mapname,$id,$fn)=&Apache::lonnet::decode_symb($self->{'symb'}); |
foreach my $parmname (@Parameters) { |
foreach my $parmname (@Parameters) { |
my $value = $self->parmval($parmname); |
my $value = $self->parmval($parmname,$self->{'symb'}, |
|
$self->{'name'},$self->{'domain'}, |
|
$self->{'section'},undef, |
|
$mapname,$id,$fn); |
$parameters{$parmname} =$value; |
$parameters{$parmname} =$value; |
} |
} |
untie(%parmhash); |
untie(%parmhash); |
Line 730 sub compute {
|
Line 737 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 %nice_parm_names = $self->get_parm_names(@Mandatory_parameters); |
my @parameters=$self->get_parm(@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 |
# Get the values of the metadata fields |
$self->ensure_current_caches(); |
$self->ensure_current_caches(); |
%parameters = $self->get_parameter_values(keys(%parameters)); |
%parameters = $self->get_parameter_values(@parameters); |
# |
# |
# Clean out unnecessary parameters |
# Clean out unnecessary parameters |
foreach (keys(%parameters)) { |
foreach (keys(%parameters)) { |
Line 783 sub compute {
|
Line 786 sub compute {
|
if ($parm =~ /_submission$/ && $value =~ /(\{|\})/) { |
if ($parm =~ /_submission$/ && $value =~ /(\{|\})/) { |
$value = 'witheld'; |
$value = 'witheld'; |
} |
} |
$value = 'q{'.$value.'}' if ($value =~/([^\d\.]|\.\.)/); |
#$value = 'q{'.$value.'}' if ($value =~/([^\d\.]|\.\.)/); |
$c{$parm} = $value; |
$c{$parm} = $value; |
} |
} |
$self->formulas(\%f); |
$self->formulas(\%f); |
Line 829 sub sett {
|
Line 832 sub sett {
|
while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { |
while (my ($cell,$formula) = each(%{$self->{'formulas'}})) { |
next if ($cell =~ /template_/); |
next if ($cell =~ /template_/); |
if ($cell =~ /^A/ && $cell ne 'A0') { |
if ($cell =~ /^A/ && $cell ne 'A0') { |
if ($formula !~ /^\!/) { |
if ($formula !~ /^\!/ |
|
&& exists($self->{'constants'}->{$formula}) |
|
&& $self->{'constants'}->{$formula} ne '' |
|
) { |
$Apache::Spreadsheet::sheet_values{$cell}= |
$Apache::Spreadsheet::sheet_values{$cell}= |
eval($self->{'constants'}->{$formula}); |
$self->{'constants'}->{$formula}; |
} |
} |
} else { |
} else { |
$t{$cell}=$formula; |
$t{$cell}=$formula; |