--- loncom/interface/spreadsheet/assesscalc.pm 2003/12/08 19:58:39 1.30 +++ loncom/interface/spreadsheet/assesscalc.pm 2006/04/06 20:24:13 1.52 @@ -1,5 +1,5 @@ # -# $Id: assesscalc.pm,v 1.30 2003/12/08 19:58:39 matthew Exp $ +# $Id: assesscalc.pm,v 1.52 2006/04/06 20:24:13 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -104,6 +104,7 @@ my %nice_parameter_name; my %useropt; my %userdata; my %courseopt; +my $navmap; ######################################################## ######################################################## @@ -124,7 +125,7 @@ sub clear_package { if (defined($current_name) && defined($current_domain) && defined($current_course) && - $current_course eq $ENV{'request.course.id'} && + $current_course eq $env{'request.course.id'} && %newExportrows) { &save_cached_export_rows($current_name,$current_domain); } @@ -136,20 +137,28 @@ sub clear_package { undef(%useropt); undef(%userdata); undef(%courseopt); + undef($navmap); } sub save_cached_export_rows { my ($sname,$sdomain) = @_; - my $start = Time::HiRes::time; my $result = &Apache::lonnet::put - ('nohist_calculatedsheets_'.$ENV{'request.course.id'}, + ('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)) { + &Apache::lonnet::logthis('assesscalc:Can not open Coursemap'); + } &Apache::loncoursedata::clear_internal_caches(); } @@ -165,13 +174,14 @@ sub initialize { ######################################################## ######################################################## sub initialize_package { - my ($sname,$sdomain) = @_; + my ($sname,$sdomain,$in_navmap) = @_; $current_name = $sname; $current_domain = $sdomain; + $navmap = $in_navmap; undef(%useropt); undef(%userdata); - if ($current_course ne $ENV{'request.course.id'}) { - $current_course = $ENV{'request.course.id'}; + if ($current_course ne $env{'request.course.id'}) { + $current_course = $env{'request.course.id'}; undef(%courseopt); } &load_cached_export_rows(); @@ -197,13 +207,13 @@ sub load_parameter_caches { # # Course Parameters Cache if (! %courseopt) { - $current_course = $ENV{'request.course.id'}; + $current_course = $env{'request.course.id'}; undef(%courseopt); if (! defined($current_name) || ! defined($current_domain)) { 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; @@ -246,8 +256,8 @@ sub ensure_current_caches { ## 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); @@ -280,7 +290,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. @@ -291,16 +302,19 @@ this user and course. ################################################## sub parmval { my $self = shift; - 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)); - $symb = $self->{'symb'} if (! defined($symb)); + my ($what,$symb,$uname,$udom,$csec,$recurse,$mapname,$id,$fn,$cgroup)=@_; + $uname = $self->{'name'} if (! defined($uname)); + $udom = $self->{'domain'} if (! defined($udom)); + $csec = $self->{'section'} if (! defined($csec)); + $cgroup = $self->{'group'} if (! defined($cgroup)); + $symb = $self->{'symb'} if (! defined($symb)); # my $result=''; # # 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 my $rwhat=$what; $what =~ s/^parameter\_//; @@ -311,6 +325,10 @@ sub parmval { my $courseprefix = $self->{'cid'}; my $usercourseprefix = $uname.'_'.$udom.'_'.$self->{'cid'}; # + my $grplevel=$courseprefix.'.['.$cgroup.'].'.$what; + my $grplevelr=$courseprefix.'.['.$cgroup.'].'.$symbparm; + my $grplevelm=$courseprefix.'.['.$cgroup.'].'.$mapparm; + # my $seclevel = $courseprefix.'.['.$csec.'].'.$what; my $seclevelr = $courseprefix.'.['.$csec.'].'.$symbparm; my $seclevelm = $courseprefix.'.['.$csec.'].'.$mapparm; @@ -322,12 +340,18 @@ 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 group + if (defined($cgroup)) { + return $courseopt{$grplevelr} if (defined($courseopt{$grplevelr})); + return $courseopt{$grplevelm} if (defined($courseopt{$grplevelm})); + return $courseopt{$grplevel} if (defined($courseopt{$grplevel})); + } # check section if (defined($csec)) { return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr})); @@ -337,18 +361,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); @@ -356,7 +381,8 @@ 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,1); + my $partgeneral=$self->parmval($newwhat,$symb,$uname,$udom,$csec,1, + $mapname,$id,$fn); if (defined($partgeneral)) { return $partgeneral; } } if ($recurse) { return undef; } @@ -397,11 +423,8 @@ sub get_full_title { 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+$//; + my $name = &Apache::loncommon::plainname($self->{'name'}, + $self->{'domain'}); push (@title,$name); push (@title,&Apache::lonlocal::locallocaltime(time)); return @title; @@ -504,8 +527,8 @@ sub assess_html_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 { @@ -540,10 +563,7 @@ sub csv_rows { # Write each row foreach my $rownum (sort {$a <=> $b} ($self->rows())) { my $parameter_name = $self->{'formulas'}->{'A'.$rownum}; - my $description = ''; - if (exists($nice_parameter_name{$parameter_name})) { - $description = $nice_parameter_name{$parameter_name}; - } + my $description = $self->get_parm_name($parameter_name); $self->csv_output_row($filehandle,$rownum, $parameter_name,$description); } @@ -554,23 +574,20 @@ 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) = @_; + 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); + $worksheet->write($rows_output,$cols_output++,$value,$format->{'h4'}); } - $rows_output++; + $rows_output++; # # Write each row foreach my $rownum (sort {$a <=> $b} ($self->rows())) { my $parameter_name = $self->{'formulas'}->{'A'.$rownum}; - my $description = ''; - if (exists($nice_parameter_name{$parameter_name})) { - $description = $nice_parameter_name{$parameter_name}; - } + my $description = $self->get_parm_name($parameter_name); $self->excel_output_row($worksheet,$rownum,$rows_output++, $parameter_name,$description); } @@ -580,10 +597,10 @@ sub excel_rows { ## ## Routines to support assesscalc::compute ## -sub get_parm_names { +sub get_parm { my $self = shift; my @Mandatory_parameters = @_; - my %parameters_and_names; + my %parameters; # my ($symap,$syid,$srcf) = &Apache::lonnet::decode_symb($self->{'symb'}); my @Metadata = split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); @@ -592,14 +609,20 @@ sub get_parm_names { 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; + $parameters{$cleaned_name}=1; } - 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 { @@ -619,8 +642,12 @@ sub get_parameter_values { my $filename = $self->{'coursefilename'}.'_parms.db'; if (tie(%parmhash,'GDBM_File', $self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { + my ($mapname,$id,$fn)=&Apache::lonnet::decode_symb($self->{'symb'}); 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; } untie(%parmhash); @@ -653,6 +680,7 @@ sub get_problem_state { sub determine_parts { my $self = shift; + my $check_hidden = shift; if (exists($self->{'Parts'}) && ref($self->{'Parts'}) eq 'HASH') { return; } @@ -663,9 +691,10 @@ sub determine_parts { my $metadata = &Apache::lonnet::metadata($src,'packages'); foreach (split(',',$metadata)) { my ($part) = (/^part_(.*)$/); - if (defined($part) && - ! &Apache::loncommon::check_if_partid_hidden - ($part,$self->{'symb'},$self->{'name'},$self->{'domain'}) + 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}++; } @@ -686,22 +715,22 @@ sub parameter_part_is_valid { return 1; } # - my (undef,$part) = - ($parameter =~ m/^(resource|stores|parameter)_([^_]+)_.*/); - if (exists($self->{'Parts'}) && - exists($self->{'Parts'}->{$part}) && - $self->{'Parts'}->{$part} ) { - return 1; - } else { - return 0; + 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) = @_; - my $connection = $r->connection(); - if ($connection->aborted()) { $self->cleanup(); return; } $self->initialize_safe_space(); ######################################### ######################################### @@ -722,18 +751,11 @@ sub compute { 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; - } + my @parameters=$self->get_parm(@Mandatory_parameters); # # Get the values of the metadata fields - if ($connection->aborted()) { $self->cleanup(); return; } $self->ensure_current_caches(); - if ($connection->aborted()) { $self->cleanup(); return; } - %parameters = $self->get_parameter_values(keys(%parameters)); - if ($connection->aborted()) { $self->cleanup(); return; } + %parameters = $self->get_parameter_values(@parameters); # # Clean out unnecessary parameters foreach (keys(%parameters)) { @@ -741,19 +763,14 @@ sub compute { } # # Get the students performance data + $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 - $self->determine_parts(); - foreach my $param (keys(%parameters)) { - if (! $self->parameter_part_is_valid($param)) { - delete ($parameters{$param}); - } + # Clean out any bad parameters + next if (! $self->parameter_part_is_valid($parm)); + $parameters{$parm} = $value; } # # Set up the formulas and parameter values @@ -761,7 +778,7 @@ 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$/); @@ -775,25 +792,31 @@ sub compute { } } } - if ($connection->aborted()) { $self->cleanup(); return; } # # Move the parameters into the spreadsheet while (my ($parm,$value) = each(%parameters)) { my $cell = 'A'.$self->get_row_number_from_key($parm); $f{$cell} = $parm; - $value = '"'.$value.'"' if ($value =~/[^0-9.]/); + if ($parm =~ /_submission$/ && $value =~ /(\{|\})/) { + $value = 'witheld'; + } + $value = 'q{'.$value.'}' if ($value =~/([^\d\.]|\.\.)/); $c{$parm} = $value; } + 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); - if ($connection->aborted()) { $self->cleanup(); return; } $self->calcsheet(); # # Store export row in cache my @exportarray = $self->exportrow(); $self->deal_with_export_row(@exportarray); $self->save() if ($self->need_to_save()); - if ($connection->aborted()) { $self->cleanup(); return; } return; } @@ -803,6 +826,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. @@ -828,8 +852,12 @@ 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; @@ -864,15 +892,19 @@ These rows are saved in the students dir sub load_cached_export_rows { 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; @@ -904,9 +936,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'} || + 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'}}) || @@ -915,7 +946,6 @@ sub export_data { ) { $self->compute($r); } - if ($connection->aborted()) { $self->cleanup(); return; } my @Data; if ($self->badcalc()) { @Data = ();