version 1.1, 2003/05/16 20:55:11
|
version 1.18, 2003/09/05 01:06:45
|
Line 44 assesscalc
|
Line 44 assesscalc
|
package Apache::assesscalc; |
package Apache::assesscalc; |
|
|
use strict; |
use strict; |
|
use warnings FATAL=>'all'; |
|
no warnings 'uninitialized'; |
use Apache::Constants qw(:common :http); |
use Apache::Constants qw(:common :http); |
use Apache::lonnet; |
use Apache::lonnet; |
|
use Apache::loncommon; |
use Apache::Spreadsheet; |
use Apache::Spreadsheet; |
use HTML::Entities(); |
use HTML::Entities(); |
use Spreadsheet::WriteExcel; |
use Spreadsheet::WriteExcel; |
Line 122 sub clear_package {
|
Line 125 sub clear_package {
|
undef(%courseopt); |
undef(%courseopt); |
} |
} |
|
|
|
sub initialize { |
|
&clear_package(); |
|
} |
|
|
######################################################## |
######################################################## |
######################################################## |
######################################################## |
|
|
Line 135 sub clear_package {
|
Line 142 sub clear_package {
|
######################################################## |
######################################################## |
sub initialize_package { |
sub initialize_package { |
my ($sname,$sdomain) = @_; |
my ($sname,$sdomain) = @_; |
$current_course = $ENV{'request.course.id'}; |
|
$current_name = $sname; |
$current_name = $sname; |
$current_domain = $sdomain; |
$current_domain = $sdomain; |
undef(%courseopt); |
if ($current_course ne $ENV{'request.course.id'}) { |
|
$current_course = $ENV{'request.course.id'}; |
|
undef(%courseopt); |
|
} |
&load_cached_export_rows(); |
&load_cached_export_rows(); |
&load_parameter_caches(); |
&load_parameter_caches(); |
} |
} |
Line 160 sub load_parameter_caches {
|
Line 169 sub load_parameter_caches {
|
# |
# |
# Course Parameters Cache |
# Course Parameters Cache |
if (! %courseopt) { |
if (! %courseopt) { |
&Apache::lonnet::logthis("loading course options"); |
|
$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)) { |
Line 171 sub load_parameter_caches {
|
Line 179 sub load_parameter_caches {
|
my $id = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; |
my $id = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; |
my %Tmp = &Apache::lonnet::dump('resourcedata',$dom,$id); |
my %Tmp = &Apache::lonnet::dump('resourcedata',$dom,$id); |
while (my ($name,$value) = each(%Tmp)) { |
while (my ($name,$value) = each(%Tmp)) { |
$courseopt{$userprefix.$name}=$value; |
$courseopt{$name}=$value; |
} |
} |
} |
} |
if (! %useropt) { |
if (! %useropt) { |
Line 198 sub load_parameter_caches {
|
Line 206 sub load_parameter_caches {
|
|
|
######################################################## |
######################################################## |
######################################################## |
######################################################## |
|
|
sub ensure_current_parameter_caches { |
sub ensure_current_parameter_caches { |
my $self = shift; |
my $self = shift; |
if (! defined($current_course) || |
if (! defined($current_course) || |
Line 241 this user and course.
|
Line 248 this user and course.
|
################################################## |
################################################## |
sub parmval { |
sub parmval { |
my $self = shift; |
my $self = shift; |
my ($what,$symb,$uname,$udom,$csec)=@_; |
my ($what,$symb,$uname,$udom,$csec,$recurse)=@_; |
$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 258 sub parmval {
|
Line 265 sub parmval {
|
# |
# |
my $symbparm = $symb.'.'.$what; |
my $symbparm = $symb.'.'.$what; |
my $mapparm = $mapname.'___(all).'.$what; |
my $mapparm = $mapname.'___(all).'.$what; |
|
my $courseprefix = $self->{'cid'}; |
my $usercourseprefix = $uname.'_'.$udom.'_'.$self->{'cid'}; |
my $usercourseprefix = $uname.'_'.$udom.'_'.$self->{'cid'}; |
# |
# |
my $seclevel = $usercourseprefix.'.['.$csec.'].'.$what; |
my $seclevel = $courseprefix.'.['.$csec.'].'.$what; |
my $seclevelr = $usercourseprefix.'.['.$csec.'].'.$symbparm; |
my $seclevelr = $courseprefix.'.['.$csec.'].'.$symbparm; |
my $seclevelm = $usercourseprefix.'.['.$csec.'].'.$mapparm; |
my $seclevelm = $courseprefix.'.['.$csec.'].'.$mapparm; |
# |
# |
my $courselevel = $usercourseprefix.'.'.$what; |
my $courselevel = $courseprefix.'.'.$what; |
my $courselevelr = $usercourseprefix.'.'.$symbparm; |
my $courselevelr = $courseprefix.'.'.$symbparm; |
my $courselevelm = $usercourseprefix.'.'.$mapparm; |
my $courselevelm = $courseprefix.'.'.$mapparm; |
|
# |
|
my $ucourselevel = $usercourseprefix.'.'.$what; |
|
my $ucourselevelr = $usercourseprefix.'.'.$symbparm; |
|
my $ucourselevelm = $usercourseprefix.'.'.$mapparm; |
# check user |
# check user |
if (defined($uname)) { |
if (defined($uname)) { |
return $useropt{$courselevelr} if (defined($useropt{$courselevelr})); |
return $useropt{$ucourselevelr} if (defined($useropt{$ucourselevelr})); |
return $useropt{$courselevelm} if (defined($useropt{$courselevelm})); |
return $useropt{$ucourselevelm} if (defined($useropt{$ucourselevelm})); |
return $useropt{$courselevel} if (defined($useropt{$courselevel})); |
return $useropt{$ucourselevel} if (defined($useropt{$ucourselevel})); |
} |
} |
# check section |
# check section |
if (defined($csec)) { |
if (defined($csec)) { |
Line 301 sub parmval {
|
Line 313 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); |
my $partgeneral=$self->parmval($newwhat,$symb,$uname,$udom,$csec,1); |
if (defined($partgeneral)) { return $partgeneral; } |
if (defined($partgeneral)) { return $partgeneral; } |
} |
} |
|
if ($recurse) { return undef; } |
|
my $pack_def=&Apache::lonnet::packages_tab_default($fn,'resource.'.$what); |
|
if (defined($pack_def)) { return $pack_def; } |
#nothing defined |
#nothing defined |
return ''; |
return ''; |
} |
} |
|
|
|
sub get_html_title { |
|
my $self = shift; |
|
my ($assess_title,$name,$time) = $self->get_title(); |
|
my $title = '<h1>'.$assess_title.'</h1>'. |
|
'<h2>'.$name.', '. |
|
&Apache::loncommon::aboutmewrapper |
|
($self->{'name'}.'@'.$self->{'domain'}, |
|
$self->{'name'},$self->{'domain'}); |
|
$title .= '<h3>'.$time.'</h3>'; |
|
return $title; |
|
} |
|
|
sub get_title { |
sub get_title { |
my $self = shift; |
my $self = shift; |
my $title; |
my @title = (); |
if (($self->{'usymb'} eq '_feedback') || |
if (($self->{'symb'} eq '_feedback') || |
($self->{'usymb'} eq '_evaluation') || |
($self->{'symb'} eq '_evaluation') || |
($self->{'usymb'} eq '_discussion') || |
($self->{'symb'} eq '_discussion') || |
($self->{'usymb'} eq '_tutoring')) { |
($self->{'symb'} eq '_tutoring')) { |
$title = $self->{'usymb'}; |
my $assess_title = ucfirst($self->{'symb'}); |
$title =~ s/^_//; |
$assess_title =~ s/^_//; |
$title = '<h1>'.ucfirst($title)."</h1>\n"; |
push(@title,$assess_title); |
} else { |
} else { |
$title = '<h1>'.&Apache::lonnet::gettitle($self->{'symb'})."</h1>\n"; |
push(@title,&Apache::lonnet::gettitle($self->{'symb'})); |
} |
} |
$title .= '<h2>'.$self->{'name'}.'@'.$self->{'domain'}."</h2>\n"; |
# Look up the users identifying information |
$title .= '<h3>'.localtime(time).'</h3>'; |
# Get the users information |
# |
my %userenv = &Apache::loncoursedata::GetUserName($self->{'name'}, |
return $title; |
$self->{'domain'}); |
|
my $name = |
|
join(' ',@userenv{'firstname','middlename','lastname','generation'}); |
|
$name =~ s/\s+$//; |
|
push (@title,$name); |
|
push (@title,scalar(localtime(time))); |
|
return @title; |
} |
} |
|
|
sub parent_link { |
sub parent_link { |
Line 342 sub outsheet_html {
|
Line 375 sub outsheet_html {
|
################################### |
################################### |
# Determine table structure |
# Determine table structure |
################################### |
################################### |
|
my $importcolor = '#FFFFFF'; |
|
my $exportcolor = '#FFFFAA'; |
my $num_uneditable = 1; |
my $num_uneditable = 1; |
my $num_left = 52-$num_uneditable; |
my $num_left = 52-$num_uneditable; |
my $tableheader =<<"END"; |
my $tableheader =<<"END"; |
<table border="2"> |
<table border="2"> |
<tr> |
<tr> |
<th colspan="2" rowspan="2"><font size="+2">Assessment</font></th> |
<th colspan="2" rowspan="2"><font size="+2">Assessment</font></th> |
<td bgcolor="#FFDDDD" colspan="$num_uneditable"> </td> |
<td bgcolor="$importcolor" colspan="$num_uneditable"> </td> |
<td colspan="$num_left"> |
<td colspan="$num_left"> |
<b><font size="+1">Calculations</font></b></td> |
<b><font size="+1">Calculations</font></b></td> |
</tr><tr> |
</tr><tr> |
Line 356 END
|
Line 391 END
|
my $label_num = 0; |
my $label_num = 0; |
foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ |
foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ |
if ($label_num<$num_uneditable) { |
if ($label_num<$num_uneditable) { |
$tableheader .= '<td bgcolor="#FFDDDD">'; |
$tableheader .= '<td bgcolor="'.$importcolor.'">'; |
} else { |
} else { |
$tableheader .= '<td>'; |
$tableheader .= '<td>'; |
} |
} |
Line 369 END
|
Line 404 END
|
# |
# |
# Print out template row |
# Print out template row |
$r->print('<tr><td>Template</td><td> </td>'. |
$r->print('<tr><td>Template</td><td> </td>'. |
$self->html_template_row($num_uneditable)."</tr>\n"); |
$self->html_template_row($num_uneditable,$importcolor). |
|
"</tr>\n"); |
# |
# |
# Print out summary/export row |
# Print out summary/export row |
$r->print('<tr><td>Export</td><td>0</td>'. |
$r->print('<tr><td>Export</td><td>0</td>'. |
$self->html_export_row()."</tr>\n"); |
$self->html_export_row($exportcolor)."</tr>\n"); |
# |
# |
# Prepare to output rows |
# Prepare to output rows |
$tableheader =<<"END"; |
$tableheader =<<"END"; |
Line 382 END
|
Line 418 END
|
END |
END |
foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ |
foreach (split(//,'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz')){ |
if ($label_num<$num_uneditable) { |
if ($label_num<$num_uneditable) { |
$tableheader.='<th bgcolor="#FFDDDD">'; |
$tableheader.='<th bgcolor="'.$importcolor.'">'; |
} else { |
} else { |
$tableheader.='<th>'; |
$tableheader.='<th>'; |
} |
} |
Line 390 END
|
Line 426 END
|
} |
} |
# |
# |
my $num_output = 0; |
my $num_output = 0; |
foreach my $rownum ($self->rows()) { |
foreach my $rownum (sort {$a <=> $b} ($self->rows())) { |
if ($num_output++ % 50 == 0) { |
if ($num_output++ % 50 == 0) { |
$r->print("</table>\n".$tableheader); |
$r->print("</table>\n".$tableheader); |
} |
} |
$r->print('<tr><td>'.$rownum.'</td>'. |
$r->print('<tr><td>'.$rownum.'</td>'. |
$self->assess_html_row($num_uneditable,$rownum)."</tr>\n"); |
$self->assess_html_row($rownum,$importcolor)."</tr>\n"); |
} |
} |
$r->print("</table>\n"); |
$r->print("</table>\n"); |
return; |
return; |
Line 403 END
|
Line 439 END
|
|
|
sub assess_html_row { |
sub assess_html_row { |
my $self = shift(); |
my $self = shift(); |
my ($num_uneditable,$row) = @_; |
my ($row,$importcolor) = @_; |
my $requester_is_student = ($ENV{'request.role'} =~ /^st\./); |
|
my $parameter_name = $self->{'formulas'}->{'A'.$row}; |
my $parameter_name = $self->{'formulas'}->{'A'.$row}; |
my @rowdata = $self->get_row($row); |
my @rowdata = $self->get_row($row); |
my $num_cols_output = 0; |
my $num_cols_output = 0; |
Line 417 sub assess_html_row {
|
Line 452 sub assess_html_row {
|
$row_html .= '<td>'.$parameter_name.'</td>'; |
$row_html .= '<td>'.$parameter_name.'</td>'; |
} |
} |
foreach my $cell (@rowdata) { |
foreach my $cell (@rowdata) { |
if ($requester_is_student || |
if ($num_cols_output < 1) { |
$num_cols_output++ < $num_uneditable) { |
$row_html .= '<td bgcolor="'.$importcolor.'">'; |
$row_html .= '<td bgcolor="#FFDDDD">'; |
$row_html .= &Apache::Spreadsheet::html_uneditable_cell($cell, |
$row_html .= &Apache::Spreadsheet::html_uneditable_cell($cell,'#FFDDDD'); |
'#FFDDDD'); |
} else { |
} else { |
$row_html .= '<td bgcolor="#EOFFDD">'; |
$row_html .= '<td bgcolor="#EOFFDD">'; |
$row_html .= &Apache::Spreadsheet::html_editable_cell($cell,'#E0FFDD'); |
$row_html .= &Apache::Spreadsheet::html_editable_cell($cell, |
} |
'#E0FFDD',1); |
|
} |
$row_html .= '</td>'; |
$row_html .= '</td>'; |
|
$num_cols_output++; |
} |
} |
return $row_html; |
return $row_html; |
} |
} |
|
|
sub outsheet_csv { |
sub csv_rows { |
my $self = shift; |
# writes the meat of the spreadsheet to an excel worksheet. Called |
my ($r)=@_; |
# by Spreadsheet::outsheet_excel; |
} |
my $self = shift; |
|
my ($filehandle) = @_; |
sub outsheet_excel { |
# |
my $self = shift; |
# Write a header row |
my ($r)=@_; |
$self->csv_output_row($filehandle,undef, |
|
('Parameter','Description','Value')); |
|
# |
|
# 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}; |
|
} |
|
$self->csv_output_row($filehandle,$rownum, |
|
$parameter_name,$description); |
|
} |
|
return; |
} |
} |
|
|
sub display { |
sub excel_rows { |
my $self = shift; |
# writes the meat of the spreadsheet to an excel worksheet. Called |
my ($r) = @_; |
# by Spreadsheet::outsheet_excel; |
$self->compute(); |
my $self = shift; |
$self->outsheet_html($r); |
my ($worksheet,$cols_output,$rows_output) = @_; |
|
# |
|
# Write a header row |
|
$cols_output = 0; |
|
foreach my $value ('Parameter','Description','Value') { |
|
$worksheet->write($rows_output,$cols_output++,$value); |
|
} |
|
$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}; |
|
} |
|
$self->excel_output_row($worksheet,$rownum,$rows_output++, |
|
$parameter_name,$description); |
|
} |
|
return; |
} |
} |
|
|
sub compute { |
sub compute { |
my $self = shift; |
my $self = shift; |
$self->logthis('computing'); |
# $self->logthis('computing'); |
$self->initialize_safe_space(); |
$self->initialize_safe_space(); |
|
######################################### |
|
######################################### |
|
### ### |
|
### Retrieve the problem parameters ### |
|
### ### |
|
######################################### |
|
######################################### |
|
my @Mandatory_parameters = ("stores_0_solved", |
|
"stores_0_awarddetail", |
|
"stores_0_awarded", |
|
"timestamp", |
|
"stores_0_tries", |
|
"stores_0_award"); |
# |
# |
# Definitions |
# Definitions |
undef(%nice_parameter_name); |
undef(%nice_parameter_name); |
Line 459 sub compute {
|
Line 541 sub compute {
|
# 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 ($symap,$syid,$srcf)=split(/___/,$self->{'symb'}); |
my @Metadata = split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); |
my @Metadata = split(/\,/,&Apache::lonnet::metadata($srcf,'keys')); |
foreach my $parm (@Metadata) { |
foreach my $parm (@Mandatory_parameters,@Metadata) { |
next if ($parm !~ /^(resource\.|stores|parameter)_/); |
next if ($parm !~ /^(resource\.|stores|parameter)_/); |
my $cleaned_name = $parm; |
my $cleaned_name = $parm; |
$cleaned_name =~ s/^resource\./stores_/; |
$cleaned_name =~ s/^resource\./stores_/; |
Line 479 sub compute {
|
Line 561 sub compute {
|
if (tie(%parmhash,'GDBM_File', |
if (tie(%parmhash,'GDBM_File', |
$self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { |
$self->{'coursefilename'}.'_parms.db',&GDBM_READER(),0640)) { |
foreach my $parmname (keys(%parameters)) { |
foreach my $parmname (keys(%parameters)) { |
my $value = $self->parmval($parmname); |
my $value = $self->parmval($parmname); |
$parameters{$parmname} =$value; |
$parameters{$parmname} =$value; |
} |
} |
untie(%parmhash); |
untie(%parmhash); |
Line 508 sub compute {
|
Line 590 sub compute {
|
my %f=$self->formulas(); |
my %f=$self->formulas(); |
my %c; |
my %c; |
# |
# |
|
# Check for blackout requirements |
|
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$/); |
|
next if ($parameters{$1.'_answerdate'}<time); |
|
if (lc($value) eq 'no') { |
|
# We must blackout this sheet |
|
$self->blackout(1); |
|
} |
|
} |
|
} |
|
# |
|
# Move the parameters into the spreadsheet |
while (my ($parm,$value) = each(%parameters)) { |
while (my ($parm,$value) = each(%parameters)) { |
my $cell = 'A'.$self->get_row_number_from_key($parm); |
my $cell = 'A'.$self->get_row_number_from_key($parm); |
$f{$cell} = $parm; |
$f{$cell} = $parm; |
|
$value = '"'.$value.'"' if ($value =~/[^0-9.]/); |
$c{$parm} = $value; |
$c{$parm} = $value; |
} |
} |
$self->formulas(%f); |
$self->formulas(\%f); |
$self->constants(%c); |
$self->constants(\%c); |
$self->calcsheet(); |
$self->calcsheet(); |
# |
# |
# Store export row in cache |
# Store export row in cache |
Line 524 sub compute {
|
Line 621 sub compute {
|
# |
# |
# Save the export data |
# Save the export data |
$self->save_export_data(); |
$self->save_export_data(); |
|
$self->save() if ($self->need_to_save()); |
return; |
return; |
} |
} |
|
|
Line 592 These rows are saved in the students dir
|
Line 690 These rows are saved in the students dir
|
######################################################## |
######################################################## |
######################################################## |
######################################################## |
sub load_cached_export_rows { |
sub load_cached_export_rows { |
%Exportrows = undef; |
undef(%Exportrows); |
&Apache::lonnet::logthis("loading cached assess sheets for $current_name $current_domain"); |
|
my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets_'. |
my @tmp = &Apache::lonnet::dump('nohist_calculatedsheets_'. |
$ENV{'request.course.id'}, |
$ENV{'request.course.id'}, |
$current_domain,$current_name,undef); |
$current_domain,$current_name,undef); |
Line 635 spreadsheet only if necessary.
|
Line 732 spreadsheet only if necessary.
|
sub export_data { |
sub export_data { |
my $self = shift; |
my $self = shift; |
my $symb = $self->{'symb'}; |
my $symb = $self->{'symb'}; |
if (! exists($Exportrows{$symb}) || ! defined($Exportrows{$symb}) || |
if (! exists($ENV{'request.role.adv'}) || ! $ENV{'request.role.adv'} || |
|
! exists($Exportrows{$symb}) || ! defined($Exportrows{$symb}) || |
! $self->check_expiration_time($Exportrows{$symb}->{'time'}) || |
! $self->check_expiration_time($Exportrows{$symb}->{'time'}) || |
! exists($Exportrows{$symb}->{$self->{'filename'}}) || |
! exists($Exportrows{$symb}->{$self->{'filename'}}) || |
! defined($Exportrows{$symb}->{$self->{'filename'}})) { |
! defined($Exportrows{$symb}->{$self->{'filename'}}) || |
|
! ref($Exportrows{$symb}->{$self->{'filename'}}) |
|
) { |
$self->compute(); |
$self->compute(); |
} |
} |
my @Data = @{$Exportrows{$symb}->{$self->{'filename'}}}; |
my @Data = @{$Exportrows{$symb}->{$self->{'filename'}}}; |
Line 667 Writes the export data for this spreadsh
|
Line 767 Writes the export data for this spreadsh
|
############################################# |
############################################# |
sub save_export_data { |
sub save_export_data { |
my $self = shift; |
my $self = shift; |
|
return if ($self->temporary()); |
my $student = $self->{'name'}.':'.$self->{'domain'}; |
my $student = $self->{'name'}.':'.$self->{'domain'}; |
my $symb = $self->{'symb'}; |
my $symb = $self->{'symb'}; |
if (! exists($Exportrows{$symb}) || |
if (! exists($Exportrows{$symb}) || |