--- loncom/interface/spreadsheet/assesscalc.pm 2003/09/05 01:57:54 1.19 +++ loncom/interface/spreadsheet/assesscalc.pm 2004/12/08 00:15:18 1.35 @@ -1,5 +1,5 @@ # -# $Id: assesscalc.pm,v 1.19 2003/09/05 01:57:54 matthew Exp $ +# $Id: assesscalc.pm,v 1.35 2004/12/08 00:15:18 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -50,10 +50,12 @@ use Apache::Constants qw(:common :http); use Apache::lonnet; use Apache::loncommon; use Apache::Spreadsheet; +use Apache::loncoursedata(); use HTML::Entities(); use Spreadsheet::WriteExcel; use GDBM_File; use Time::HiRes; +use Apache::lonlocal; @Apache::assesscalc::ISA = ('Apache::Spreadsheet'); @@ -90,6 +92,7 @@ use Time::HiRes; ######################################################## my %Exportrows; +my %newExportrows; my $current_name; my $current_domain; @@ -99,6 +102,7 @@ my %parmhash; my %nice_parameter_name; my %useropt; +my %userdata; my %courseopt; ######################################################## @@ -110,23 +114,43 @@ my %courseopt; =item &clear_package() -Reset all package variables. +Reset all package variables and clean up caches. =cut ######################################################## ######################################################## sub clear_package { + if (defined($current_name) && + defined($current_domain) && + defined($current_course) && + $current_course eq $ENV{'request.course.id'} && + %newExportrows) { + &save_cached_export_rows($current_name,$current_domain); + } undef(%Exportrows); + undef(%newExportrows); undef($current_name); undef($current_domain); undef($current_course); undef(%useropt); + undef(%userdata); undef(%courseopt); } +sub save_cached_export_rows { + my ($sname,$sdomain) = @_; + my $start = Time::HiRes::time; + my $result = &Apache::lonnet::put + ('nohist_calculatedsheets_'.$ENV{'request.course.id'}, + $newExportrows{$sname.':'.$sdomain}, + $sdomain,$sname); + delete($newExportrows{$sname.':'.$sdomain}); +} + sub initialize { &clear_package(); + &Apache::loncoursedata::clear_internal_caches(); } ######################################################## @@ -144,14 +168,18 @@ sub initialize_package { my ($sname,$sdomain) = @_; $current_name = $sname; $current_domain = $sdomain; + undef(%useropt); + undef(%userdata); if ($current_course ne $ENV{'request.course.id'}) { $current_course = $ENV{'request.course.id'}; undef(%courseopt); } &load_cached_export_rows(); &load_parameter_caches(); + &Apache::loncoursedata::clear_internal_caches(); } + ######################################################## ######################################################## @@ -172,7 +200,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,7 +219,14 @@ sub load_parameter_caches { } $useropt{$userprefix.$name}=$value; } + $useropt{'loadtime'} = time; } + if (! %userdata) { + %userdata = &Apache::loncoursedata::get_current_state($current_name, + $current_domain); + $userdata{'loadtime'} = time; + } + return; } ######################################################## @@ -206,7 +240,7 @@ sub load_parameter_caches { ######################################################## ######################################################## -sub ensure_current_parameter_caches { +sub ensure_current_caches { my $self = shift; ## ## Check for a modified parameters @@ -215,6 +249,8 @@ sub ensure_current_parameter_caches { $current_course ne $ENV{'request.course.id'} ) { $current_course = $ENV{'request.course.id'}; undef(%courseopt); + undef(%useropt); + undef(%userdata); } ## ## Check for new user @@ -224,6 +260,7 @@ sub ensure_current_parameter_caches { $current_domain = $self->{'domain'}; $current_name = $self->{'name'}; undef(%useropt); + undef(%userdata); } &load_parameter_caches(); } @@ -263,7 +300,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\_//; @@ -311,7 +348,7 @@ sub parmval { # # Cascade Up my $space=$what; - $space=~s/\.\w+$//; + $space=~s/\.[^._]+$//; if ($space ne '0') { my @parts=split(/_/,$space); my $id=pop(@parts); @@ -331,7 +368,7 @@ sub parmval { sub get_html_title { my $self = shift; - my ($assess_title,$name,$time) = $self->get_title(); + my ($assess_title,$name,$time) = $self->get_full_title(); my $title = '

'.$assess_title.'

'. '

'.$name.', '. &Apache::loncommon::aboutmewrapper @@ -343,26 +380,27 @@ sub get_html_title { sub get_title { my $self = shift; - my @title = (); 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); + return $assess_title; } else { - push(@title,&Apache::lonnet::gettitle($self->{'symb'})); + return &Apache::lonnet::gettitle($self->{'symb'}); } +} + +sub get_full_title { + my $self = shift; + 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,scalar(localtime(time))); + push (@title,&Apache::lonlocal::locallocaltime(time)); return @title; } @@ -371,13 +409,17 @@ sub parent_link { my $link .= '

'. - 'Student level sheet

'."\n"; + &mt('Student level sheet').'

'."\n"; return $link; } sub outsheet_html { my $self = shift; my ($r) = @_; + #################################### + # Report any calculation errors # + #################################### + $r->print($self->html_report_error()); ################################### # Determine table structure ################################### @@ -385,13 +427,17 @@ sub outsheet_html { my $exportcolor = '#FFFFAA'; my $num_uneditable = 1; my $num_left = 52-$num_uneditable; + my %lt=&Apache::lonlocal::texthash( + 'as' => 'Assessment', + 'ca' => 'Calculations', + ); my $tableheader =<<"END"; - + + $lt{'ca'} END my $label_num = 0; @@ -433,6 +479,11 @@ END # my $num_output = 0; foreach my $rownum (sort {$a <=> $b} ($self->rows())) { + if (! $self->parameter_part_is_valid( + $self->{'formulas'}->{'A'.$rownum} + )) { + next; + } if ($num_output++ % 50 == 0) { $r->print("
Assessment$lt{'as'}   - Calculations
\n".$tableheader); } @@ -477,11 +528,11 @@ sub csv_rows { # writes the meat of the spreadsheet to an excel worksheet. Called # by Spreadsheet::outsheet_excel; my $self = shift; - my ($filehandle) = @_; + my ($connection,$filehandle) = @_; # # Write a header row $self->csv_output_row($filehandle,undef, - ('Parameter','Description','Value')); + (&mt('Parameter'),&mt('Description'),&mt('Value'))); # # Write each row foreach my $rownum (sort {$a <=> $b} ($self->rows())) { @@ -500,7 +551,8 @@ sub excel_rows { # writes the meat of the spreadsheet to an excel worksheet. Called # by Spreadsheet::outsheet_excel; my $self = shift; - my ($worksheet,$cols_output,$rows_output) = @_; + my ($connection,$worksheet,$cols_output,$rows_output) = @_; + return if (! ref($worksheet)); # # Write a header row $cols_output = 0; @@ -522,12 +574,131 @@ 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) = &Apache::lonnet::decode_symb($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 get_problem_state { + my $self = shift; + my %student_parameters; + if (exists($userdata{$self->{'symb'}}) && + ref($userdata{$self->{'symb'}}) eq 'HASH') { + %student_parameters = %{$userdata{$self->{'symb'}}}; + } + return %student_parameters; +} + +sub determine_parts { + my $self = shift; + if (exists($self->{'Parts'}) && ref($self->{'Parts'}) eq 'HASH') { + return; + } + my (undef,undef,$url) = &Apache::lonnet::decode_symb($self->{'symb'}); + my $src = &Apache::lonnet::clutter($url); + return if (! defined($src)); + my %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'}) + ) { + $Parts{$part}++; + } + } + # Make sure part 0 is defined. + $Parts{'0'}++; + $self->{'Parts'} = \%Parts; + return; +} + +sub parameter_part_is_valid { + my $self = shift; + my ($parameter) = @_; + return 1 if ($parameter eq 'timestamp'); + if (! defined($self->{'Parts'}) || + ! ref ($self->{'Parts'}) || + ref($self->{'Parts'}) ne 'HASH') { + 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; + } +} + sub compute { my $self = shift; my ($r) = @_; my $connection = $r->connection(); if ($connection->aborted()) { $self->cleanup(); return; } -# $self->logthis('computing'); $self->initialize_safe_space(); ######################################### ######################################### @@ -548,37 +719,17 @@ 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(); + $self->ensure_current_caches(); if ($connection->aborted()) { $self->cleanup(); return; } - 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); - } + %parameters = $self->get_parameter_values(keys(%parameters)); if ($connection->aborted()) { $self->cleanup(); return; } # # Clean out unnecessary parameters @@ -587,17 +738,21 @@ sub compute { } # # Get the students performance data - my %student_parameters = - &Apache::loncoursedata::get_current_state($self->{'name'}, - $self->{'domain'}, - $self->{'symb'}, - $self->{'cid'}); + 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}); + } + } + # # Set up the formulas and parameter values my %f=$self->formulas(); my %c; @@ -607,7 +762,10 @@ sub compute { while (my ($parm,$value) = each(%parameters)) { last if ($self->blackout()); next if ($parm !~ /^(parameter_.*)_problemstatus$/); - next if ($parameters{$1.'_answerdate'}blackout(1); @@ -617,11 +775,13 @@ sub compute { 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; - $value = '"'.$value.'"' if ($value =~/[^0-9.]/); + if ($parm =~ /_submission$/ && $value =~ /(\{|\})/) { + $value = 'witheld'; + } + $value = 'q{'.$value.'}' if ($value =~/([^\d\.]|\.\.)/); $c{$parm} = $value; } $self->formulas(\%f); @@ -631,11 +791,7 @@ sub compute { # # 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; @@ -717,6 +873,10 @@ sub load_cached_export_rows { # 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; @@ -760,13 +920,20 @@ sub export_data { $self->compute($r); } if ($connection->aborted()) { $self->cleanup(); return; } - my @Data = @{$Exportrows{$symb}->{$self->{'filename'}}}; - if ($Data[0] =~ /^(.*)___=___/) { - $self->{'sheetname'} = $1; - $Data[0] =~ s/^(.*)___=___//; - } - for (my $i=0;$i<$#Data;$i++) { - $Data[$i]="'".$Data[$i]."'" if ($Data[$i]=~/\D/ && defined($Data[$i])); + my @Data; + if ($self->badcalc()) { + @Data = (); + } else { + @Data = @{$Exportrows{$symb}->{$self->{'filename'}}}; + if ($Data[0] =~ /^(.*)___=___/) { + $self->{'sheetname'} = $1; + $Data[0] =~ s/^(.*)___=___//; + } + for (my $i=0;$i<$#Data;$i++) { + if ($Data[$i]=~/\D/ && defined($Data[$i])) { + $Data[$i]="'".$Data[$i]."'"; + } + } } return @Data; } @@ -789,21 +956,23 @@ sub save_export_data { return if ($self->temporary()); my $student = $self->{'name'}.':'.$self->{'domain'}; my $symb = $self->{'symb'}; + if ($self->badcalc()){ + # do not save data away when calculations have not been done properly. + delete($Exportrows{$symb}); + return; + } if (! exists($Exportrows{$symb}) || ! exists($Exportrows{$symb}->{$self->{'filename'}})) { return; } my $key = join(':',($self->{'name'},$self->{'domain'},'assesscalc',$symb)); my $timekey = $key.'.time'; - my $newstore= join('___;___',@{$Exportrows{$symb}->{$self->{'filename'}}}); + my $newstore= join('___;___', + map {s/[^[:print:]]//g;$_;} # strip out unprintable + @{$Exportrows{$symb}->{$self->{'filename'}}}); $newstore = $self->{'filename'}.'___=___'.$newstore; - my $result = &Apache::lonnet::put - ('nohist_calculatedsheets_'.$ENV{'request.course.id'}, - { $key => $newstore, - $timekey => $Exportrows{$symb}->{'time'} }, - $self->{'domain'}, - $self->{'name'}); - + $newExportrows{$student}->{$key} = $newstore; + $newExportrows{$student}->{$timekey} = $Exportrows{$symb}->{'time'}; return; }