--- loncom/interface/spreadsheet/assesscalc.pm 2005/05/17 18:01:58 1.48 +++ loncom/interface/spreadsheet/assesscalc.pm 2016/03/02 14:14:21 1.61 @@ -1,5 +1,5 @@ # -# $Id: assesscalc.pm,v 1.48 2005/05/17 18:01:58 albertel Exp $ +# $Id: assesscalc.pm,v 1.61 2016/03/02 14:14:21 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -156,7 +156,7 @@ sub initialize { if (! defined($navmap)) { $navmap = Apache::lonnavmaps::navmap->new(); } - if (!defined($navmap)) { + if ((!defined($navmap)) || (!ref($navmap))) { &Apache::lonnet::logthis('assesscalc:Can not open Coursemap'); } &Apache::loncoursedata::clear_internal_caches(); @@ -174,7 +174,7 @@ sub initialize { ######################################################## ######################################################## sub initialize_package { - my ($sname,$sdomain,$in_navmap) = @_; + my ($sname,$sdomain,$in_navmap,$calling_sheet) = @_; $current_name = $sname; $current_domain = $sdomain; $navmap = $in_navmap; @@ -185,7 +185,7 @@ sub initialize_package { undef(%courseopt); } &load_cached_export_rows(); - &load_parameter_caches(); + &load_parameter_caches($calling_sheet); &Apache::loncoursedata::clear_internal_caches(); } @@ -202,6 +202,7 @@ sub initialize_package { ######################################################## ######################################################## sub load_parameter_caches { + my ($calling_sheet) = @_; my $userprefix = $current_name.':'.$current_domain.'_'; $userprefix =~ s/:/_/g; # @@ -234,6 +235,10 @@ sub load_parameter_caches { if (! %userdata) { %userdata = &Apache::loncoursedata::get_current_state($current_name, $current_domain); + my ($tmp) = %userdata; + if ($tmp =~ /^error:(.*)/) { + $calling_sheet->set_calcerror($1); + } $userdata{'loadtime'} = time; } return; @@ -272,7 +277,7 @@ sub ensure_current_caches { undef(%useropt); undef(%userdata); } - &load_parameter_caches(); + &load_parameter_caches($self); } ################################################## @@ -290,7 +295,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. @@ -301,17 +307,20 @@ this user and course. ################################################## sub parmval { my $self = shift; - my ($what,$symb,$uname,$udom,$csec,$recurse,$mapname,$id,$fn)=@_; - $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,$groups)=@_; + $uname = $self->{'name'} if (! defined($uname)); + $udom = $self->{'domain'} if (! defined($udom)); + $csec = $self->{'section'} if (! defined($csec)); + $groups = $self->{'groups'} if (! defined($groups)); + $symb = $self->{'symb'} if (! defined($symb)); # my $result=''; + my @recurseup; # # This should be a if (!defined($mapname) || !defined($id) || !defined($fn)) { ($mapname,$id,$fn)=&Apache::lonnet::decode_symb($symb); + $mapname = &Apache::lonnet::deversion($mapname); } # Cascading lookup scheme my $rwhat=$what; @@ -319,31 +328,77 @@ sub parmval { $what =~ s/\_([^\_]+)$/\.$1/; # my $symbparm = $symb.'.'.$what; + my $recurseparm=$mapname.'___(rec).'.$what; my $mapparm = $mapname.'___(all).'.$what; my $courseprefix = $self->{'cid'}; my $usercourseprefix = $uname.'_'.$udom.'_'.$self->{'cid'}; # my $seclevel = $courseprefix.'.['.$csec.'].'.$what; my $seclevelr = $courseprefix.'.['.$csec.'].'.$symbparm; + my $secleveli = $courseprefix.'.['.$csec.'].'.$recurseparm; my $seclevelm = $courseprefix.'.['.$csec.'].'.$mapparm; # my $courselevel = $courseprefix.'.'.$what; my $courselevelr = $courseprefix.'.'.$symbparm; + my $courseleveli = $courseprefix.'.'.$recurseparm; my $courselevelm = $courseprefix.'.'.$mapparm; # my $ucourselevel = $usercourseprefix.'.'.$what; my $ucourselevelr = $usercourseprefix.'.'.$symbparm; + my $ucourseleveli = $usercourseprefix.'.'.$recurseparm; 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{$ucourseleveli} if (defined($useropt{$ucourseleveli})); + unless (@recurseup > 0) { + @recurseup = &Apache::lonnet::get_map_hierarchy($mapname); + } + foreach my $item (@recurseup) { + my $norecursechk=$usercourseprefix.'.'.$item.'___(all).'.$what; + last if (defined($useropt{$norecursechk})); + my $recursechk=$usercourseprefix.'.'.$item.'___(rec).'.$what; + return $useropt{$recursechk} if (defined($useropt{$recursechk})); + } return $useropt{$ucourselevel} if (defined($useropt{$ucourselevel})); } + # check groups + if (defined($groups) && ref($groups) eq 'ARRAY') { + foreach my $group (@{$groups}) { + foreach my $level ($symbparm,$mapparm,$recurseparm,$what) { + my $item = $courseprefix.'.['.$group.'].'.$level; + if ($level eq $what) { + unless (@recurseup > 0) { + @recurseup = &Apache::lonnet::get_map_hierarchy($mapname); + } + foreach my $item (@recurseup) { + my $norecursechk=$courseprefix.'.['.$group.'].'.$item.'___(all).'.$what; + last if (defined($courseopt{$norecursechk})); + my $recursechk=$courseprefix.'.['.$group.'].'.$item.'___(rec).'.$what; + return $courseopt{$recursechk} if (defined($courseopt{$recursechk})); + } + } + if (defined($courseopt{$item})) { + return $courseopt{$item}; + } + } + } + } # check section if (defined($csec)) { return $courseopt{$seclevelr} if (defined($courseopt{$seclevelr})); return $courseopt{$seclevelm} if (defined($courseopt{$seclevelm})); + return $courseopt{$secleveli} if (defined($courseopt{$secleveli})); + unless (@recurseup > 0) { + @recurseup = &Apache::lonnet::get_map_hierarchy($mapname); + } + foreach my $item (@recurseup) { + my $norecursechk=$courseprefix.'.['.$csec.'].'.$item.'___(all).'.$what; + last if (defined($courseopt{$norecursechk})); + my $recursechk=$courseprefix.'.['.$csec.'].'.$item.'___(rec).'.$what; + return $courseopt{$recursechk} if (defined($courseopt{$secleveli})); + } return $courseopt{$seclevel} if (defined($courseopt{$seclevel})); } # @@ -357,6 +412,16 @@ sub parmval { return $thisparm if (defined($thisparm)); # check more course return $courseopt{$courselevelm} if (defined($courseopt{$courselevelm})); + return $courseopt{$courseleveli} if (defined($courseopt{$courseleveli})); + unless (@recurseup > 0) { + @recurseup = &Apache::lonnet::get_map_hierarchy($mapname); + } + foreach my $item (@recurseup) { + my $norecursechk=$courseprefix.'.'.$item.'___(all).'.$what; + last if (defined($courseopt{$norecursechk})); + my $recursechk=$courseprefix.'.'.$item.'___(rec).'.$what; + return $courseopt{$recursechk} if (defined($courseopt{$recursechk})); + } return $courseopt{$courselevel} if (defined($courseopt{$courselevel})); # Cascade Up @@ -370,7 +435,7 @@ sub parmval { my $newwhat=$rwhat; $newwhat=~s/\Q$space\E/$part/; my $partgeneral=$self->parmval($newwhat,$symb,$uname,$udom,$csec,1, - $mapname,$id,$fn); + $mapname,$id,$fn,$groups); if (defined($partgeneral)) { return $partgeneral; } } if ($recurse) { return undef; } @@ -469,19 +534,19 @@ END $r->print($tableheader); # # Print out template row - $r->print('Template '. + $r->print(''.&mt('Template').' '. $self->html_template_row($num_uneditable,$importcolor). "\n"); # # Print out summary/export row - $r->print('Export0'. + $r->print(''.&mt('Export').'0'. $self->html_export_row($exportcolor)."\n"); # # Prepare to output rows - $tableheader =<<"END"; - - -END + $tableheader = + '
rowItem
'. + ''. + ''; foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ if ($label_num<$num_uneditable) { $tableheader.='
'.&mt('Row').''.&mt('Item').''; @@ -528,7 +593,7 @@ sub assess_html_row { $row_html .= &Apache::Spreadsheet::html_uneditable_cell($cell, '#FFDDDD'); } else { - $row_html .= ''; + $row_html .= ''; $row_html .= &Apache::Spreadsheet::html_editable_cell($cell, '#E0FFDD',1); } @@ -631,11 +696,12 @@ sub get_parameter_values { if (tie(%parmhash,'GDBM_File', $self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { my ($mapname,$id,$fn)=&Apache::lonnet::decode_symb($self->{'symb'}); + $mapname = &Apache::lonnet::deversion($mapname); foreach my $parmname (@Parameters) { my $value = $self->parmval($parmname,$self->{'symb'}, $self->{'name'},$self->{'domain'}, $self->{'section'},undef, - $mapname,$id,$fn); + $mapname,$id,$fn,$self->{'groups'}); $parameters{$parmname} =$value; } untie(%parmhash); @@ -703,15 +769,17 @@ 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 { @@ -786,9 +854,15 @@ sub compute { if ($parm =~ /_submission$/ && $value =~ /(\{|\})/) { $value = 'witheld'; } - #$value = 'q{'.$value.'}' if ($value =~/([^\d\.]|\.\.)/); + $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); $self->calcsheet(); @@ -824,7 +898,7 @@ sub sett { # Replace 'A0' with the value from 'A0' $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; # Replace parameters - $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; + $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/sge; } } # @@ -837,13 +911,13 @@ sub sett { && $self->{'constants'}->{$formula} ne '' ) { $Apache::Spreadsheet::sheet_values{$cell}= - $self->{'constants'}->{$formula}; + eval($self->{'constants'}->{$formula}); } } else { $t{$cell}=$formula; $t{$cell}=~s/\.\.+/\,/g; $t{$cell}=~s/(^|[^\"\'])([A-Za-z]\d+)/$1\$sheet_values\{\'$2\'\}/g; - $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/ge; + $t{$cell}=~s/(^|[^\"\'])\[([^\]]+)\]/$1.$self->expandnamed($2)/sge; } } # Put %t into the safe space