version 1.16, 2010/03/18 14:50:15
|
version 1.24, 2014/12/12 14:21:22
|
Line 32 use Apache::Constants qw(:common :http);
|
Line 32 use Apache::Constants qw(:common :http);
|
use Apache::lonnet; |
use Apache::lonnet; |
use Apache::lonhtmlcommon(); |
use Apache::lonhtmlcommon(); |
use Apache::loncommon(); |
use Apache::loncommon(); |
|
use Apache::lonnavmaps(); |
use Apache::lonlocal; |
use Apache::lonlocal; |
use File::MMagic; |
use File::MMagic; |
use CAM::PDF; |
use CAM::PDF; |
|
use LONCAPA qw(:DEFAULT :match); |
|
|
use strict; |
use strict; |
|
|
Line 79 sub handler() {
|
Line 81 sub handler() {
|
} |
} |
} else { |
} else { |
$r->print('<p class="LC_warning">'. |
$r->print('<p class="LC_warning">'. |
&mt('Could not determine identity of this course. you may need to [_1]re-select[_2] the course.','<a href="/adm/roles">','</a>'). |
&mt('Could not determine identity of this course.').' '. |
|
&mt('You may need to [_1]re-select[_2] the course.','<a href="/adm/roles">','</a>'). |
'</p>'. |
'</p>'. |
&Apache::loncommon::end_page()); |
&Apache::loncommon::end_page()); |
return OK; |
return OK; |
Line 124 sub get_javascripts() {
|
Line 127 sub get_javascripts() {
|
# it's only for giving a message to the user |
# it's only for giving a message to the user |
my $result .= <<END |
my $result .= <<END |
<script type="text/javascript"> |
<script type="text/javascript"> |
|
// <![CDATA[ |
function checkFilename(form) { |
function checkFilename(form) { |
var fileExt = form.file.value; |
var fileExt = form.file.value; |
fileExt = fileExt.match(/[.]pdf\$/g); |
fileExt = fileExt.match(/[.]pdf\$/gi); |
if(fileExt) { |
if(fileExt) { |
return true; |
return true; |
} |
} |
alert("$message"); |
alert("$message"); |
return false; |
return false; |
} |
} |
|
// ]]> |
</script> |
</script> |
END |
END |
; |
; |
Line 150 sub get_uploadform() {
|
Line 155 sub get_uploadform() {
|
|
|
my $result = |
my $result = |
'<br />' |
'<br />' |
.'<form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);">' |
.'<form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);" action="">' |
.'<input type="hidden" name="type" value="upload" />' |
|
.&Apache::lonhtmlcommon::start_pick_box() |
.&Apache::lonhtmlcommon::start_pick_box() |
.&Apache::lonhtmlcommon::row_headline() |
.&Apache::lonhtmlcommon::row_headline() |
.'<h2>'.$lt{'title'}.'</h2>' |
.'<h2>'.$lt{'title'}.'</h2>' |
Line 179 sub processPDF {
|
Line 183 sub processPDF {
|
&grade_pdf(@pdfdata); |
&grade_pdf(@pdfdata); |
} else { |
} else { |
$result .= '<p class="LC_error">' |
$result .= '<p class="LC_error">' |
.&mt("Can't find any valid PDF formfields.") |
.&mt("Can't find any valid PDF form fields.") |
.'</p>'; |
.'</p>'; |
} |
} |
} |
} |
Line 188 sub get_pdf_data() {
|
Line 192 sub get_pdf_data() {
|
my @data = (); |
my @data = (); |
my $pdf = CAM::PDF->new($env{'form.file'}); |
my $pdf = CAM::PDF->new($env{'form.file'}); |
|
|
my @formFields = $pdf->getFormFieldList(); #get names of formfields |
if($pdf) { |
|
my @formFields = $pdf->getFormFieldList(); #get names of form fields |
foreach my $field (@formFields) { |
|
my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary |
foreach my $field (@formFields) { |
|
my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get form field dictonary |
|
|
# |
# this is necessary because CAM::PDF has a problem with form fieldnames which include a |
# this is necessary because CAM::PDF has a problem with formfieldnames which include a |
# dot in fieldnames. So a fieldname like "i.am.aFormfield" will offer three fieldnames |
# dot in fieldnames. So a fieldname like "i.am.aFormfield" will offer three fieldnames "i", "i.am" |
# "i", "i.am" and "i.am.aFormfield". The fragmentary names keep no values and will be ignored. |
# and "i.am.aFormfield". The fragmentary names keep no values and will be ignored. |
if($dict->{'V'}) { |
if($dict->{'V'}) { |
push(@data, $field."?". $dict->{'V'}{'value'}); #binding fieldname with value |
push(@data, $field."?". $dict->{'V'}{'value'}); #binding fieldname with value |
} |
} |
} |
} |
} |
return @data; |
return @data; |
} |
} |
|
|
sub grade_pdf { |
sub grade_pdf { |
my $result = (); |
|
my @pdfdata = @_; |
my @pdfdata = @_; |
|
my ($result,$meta,%grades,%problems,%foreigncourse,$debug); |
my $meta = (); |
|
my %grades = (); |
|
my %problems = (); |
|
|
|
my $debug = (); |
|
|
|
|
my $navmap = Apache::lonnavmaps::navmap->new(); |
|
if (!defined($navmap)) { |
|
$result = '<h3>'.&mt('Verification of PDF form items failed').'</h3>'. |
|
'<div class="LC_error">'. |
|
&mt('Unable to retrieve information about course contents').' '. |
|
&mt('You may need to [_1]re-select[_2] the course.','<a href="/adm/roles">','</a>'). |
|
'</div>'; |
|
return $result; |
|
} |
|
my %restitles; |
|
foreach my $res ($navmap->retrieveResources()) { |
|
my $symb = $res->symb; |
|
$restitles{$symb} = $res->compTitle(); |
|
} |
|
|
$debug .= "Found: ". scalar @pdfdata." Entries \n"; |
$debug .= "Found: ". scalar @pdfdata." Entries \n"; |
|
|
foreach my $entry (sort(@pdfdata)) { |
foreach my $entry (sort(@pdfdata)) { |
Line 222 sub grade_pdf {
|
Line 236 sub grade_pdf {
|
my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/); |
my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/); |
my ($domain, $user) = split('&', $value); |
my ($domain, $user) = split('&', $value); |
$user =~ s/(.*)\n/$1/; #TODO is that equals to chomp? |
$user =~ s/(.*)\n/$1/; #TODO is that equals to chomp? |
|
|
if($user ne $env{'user.name'} or $domain ne $env{'user.domain'}) { |
if($user ne $env{'user.name'} or $domain ne $env{'user.domain'}) { |
return '<p class="LC_error">' |
return '<p class="LC_error">' |
.&mt('Wrong username ([_1]) found in PDF file. Expected username: [_2]' |
.&mt('Wrong username ([_1]) found in PDF file. Expected username: [_2]' |
Line 231 sub grade_pdf {
|
Line 244 sub grade_pdf {
|
.'</p>'; |
.'</p>'; |
} |
} |
|
|
} elsif($entry =~ /^upload.*/) { |
} elsif ($entry =~ /^upload.*/) { |
$debug .= 'found: a problem -> '.$entry; |
$debug .= 'found: a problem -> '.$entry; |
my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/); |
my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/); |
my ($symb, $part, $type, $HWVAL) = split('&', $label); |
my ($symb, $part, $type, $HWVAL) = split('&', $label); |
my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb); |
my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb); |
|
if ($map =~ m{^uploaded/($match_domain)/($match_courseid)/default(_?\d*)\.(page|sequence)}) { |
|
my $mapcid = $1.'_'.$2; |
|
if ($mapcid ne $env{'request.course.id'}) { |
|
push(@{$foreigncourse{$mapcid}},$symb); |
|
} |
|
} |
|
next unless (exists($restitles{$symb})); |
$value =~ s/(.*)\n/$1/; |
$value =~ s/(.*)\n/$1/; |
|
|
#filter incorrect radiobuttons (Bug in CABAReT Stage) |
#filter incorrect radiobuttons (Bug in CABAReT Stage) |
if($type eq 'radiobuttonresponse' && $value eq 'Off' ) { |
if ($type eq 'radiobuttonresponse' && $value eq 'Off' ) { |
next; |
next; |
} |
} |
|
|
my $submit = $part; |
my $submit = $part; |
$submit =~ s/part_(.*)/submit_$1/; |
$submit =~ s/part_(.*)/submit_$1/; |
if($problems{$symb.$part}) { |
if ($problems{$symb.$part}) { |
$problems{$symb.$part}{$HWVAL} = $value; |
$problems{$symb.$part}{$HWVAL} = $value; |
} else { |
} else { |
$problems{$symb.$part} = { 'resource' => $resource, |
$problems{$symb.$part} = { 'resource' => $resource, |
Line 261 sub grade_pdf {
|
Line 281 sub grade_pdf {
|
} |
} |
#$result .= $debug; |
#$result .= $debug; |
|
|
$result .= '<h2>'.&mt('Results of PDF Form problems').'</h2>'; |
$result .= '<h3>'.&mt('Result of PDF Form upload').'</h3>'; |
$result .= &Apache::loncommon::start_data_table() |
|
.&Apache::loncommon::start_data_table_header_row() |
if (keys(%problems) > 0) { |
.'<th>'.&mt('Problem Name').'</th>' |
$result .= &Apache::loncommon::start_data_table() |
.'<th>'.&mt('Grading').'</th>' |
.&Apache::loncommon::start_data_table_header_row() |
.&Apache::loncommon::start_data_table_header_row() |
.'<th>'.&mt('Problem Name').'</th>' |
.&Apache::loncommon::end_data_table_header_row(); |
.'<th>'.&mt('Grading').'</th>' |
|
.&Apache::loncommon::start_data_table_header_row() |
foreach my $key (sort (keys %problems)) { |
.&Apache::loncommon::end_data_table_header_row(); |
my %problem = %{$problems{$key}}; |
|
my ($problemname, $grade) = &grade_problem(%problem); |
foreach my $key (sort(keys(%problems))) { |
|
my %problem = %{$problems{$key}}; |
$result .= &Apache::loncommon::start_data_table_row(); |
my ($problemname, $grade) = &grade_problem(%problem); |
$result .= "<td>$problemname</td><td class='"; |
|
if($grade eq "EXACT_ANS" || $grade eq "APPROX_ANS") { |
$result .= &Apache::loncommon::start_data_table_row(); |
$result .= "LC_answer_correct"; |
$result .= '<td><a href="/res/'.$problem{'resource'}. |
} else { |
'?symb='. |
$result .= "LC_answer_charged_try"; |
&HTML::Entities::encode($problem{'symb'},'"&<>'). |
|
'">'.$problemname.'</a></td><td><span class="'; |
|
if ($grade eq "EXACT_ANS" || $grade eq "APPROX_ANS") { |
|
$result .= 'LC_answer_correct'; |
|
} elsif ($grade eq "DRAFT") { |
|
$result .= 'LC_answer_not_charged_try'; |
|
} else { |
|
$result .= 'LC_answer_charged_try'; |
|
} |
|
$result .= '">'; |
|
$grade = &parse_grade_answer($grade); |
|
$result .= $grade.'</span></td>'; |
|
$result .= &Apache::loncommon::end_data_table_row(); |
|
} |
|
$result .= &Apache::loncommon::end_data_table(); |
|
} else { |
|
$result .= '<p class="LC_warning">'. |
|
&mt('As no gradable form items were found, no submissions have been recorded.'). |
|
'</p>'; |
|
} |
|
if (keys(%foreigncourse)) { |
|
my ($numother,$othercrsmsg); |
|
foreach my $cid (sort(keys(%foreigncourse))) { |
|
my %coursehash = &Apache::lonnet::coursedescription($cid, |
|
{'one_time' => 1}); |
|
if (ref($foreigncourse{$cid}) eq 'ARRAY') { |
|
if ($numother) { |
|
$othercrsmsg .= '</li><li>'; |
|
} |
|
$othercrsmsg .= '<b>'.$coursehash{'description'}.'</b><ul>'."\n"; |
|
foreach my $symb (@{$foreigncourse{$cid}}) { |
|
my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb); |
|
$othercrsmsg .= '<li>'.$resource.'</li>'; |
|
} |
|
$othercrsmsg .= '</ul>'; |
|
$numother ++; |
|
} |
|
} |
|
if ($numother) { |
|
$result .= '<div class="LC_warning">'; |
|
if ($numother > 1) { |
|
$result .= &mt('Your uploaded PDF form contained the following resource(s) from [_1] different courses:','<b>'.$numother.'</b>')."\n".'<ul><li>'. |
|
$othercrsmsg.'</li></ul>'; |
|
} else { |
|
$result .= &mt('Your uploaded PDF form contained the following resource(s) from a different course:').' '.$othercrsmsg. |
|
&mt('Did you download the PDF form from another course and upload it to the wrong course?'); |
|
} |
|
$result .= '</div>'; |
} |
} |
$grade = &parse_grade_answer($grade); |
|
$result .= "'>$grade</span></td>"; |
|
$result .= &Apache::loncommon::end_data_table_row(); |
|
} |
} |
$result .= &Apache::loncommon::end_data_table(); |
|
|
|
|
|
return $result; |
return $result; |
} |
} |
|
|
sub grade_problem { |
sub grade_problem { |
Line 315 sub parse_grade_answer {
|
Line 377 sub parse_grade_answer {
|
my %answerhash = ('EXACT_ANS' => &mt('You are correct.'), |
my %answerhash = ('EXACT_ANS' => &mt('You are correct.'), |
'APPROX_ANS' => &mt('You are correct.'), |
'APPROX_ANS' => &mt('You are correct.'), |
'INCORRECT' => &mt('You are incorrect'), |
'INCORRECT' => &mt('You are incorrect'), |
|
'DRAFT' => &mt('Copy saved but not submitted.'), |
); |
); |
|
|
foreach my $key (keys %answerhash) { |
foreach my $key (keys(%answerhash)) { |
if($shortcut eq $key) { |
if($shortcut eq $key) { |
return $answerhash{$shortcut}; |
return $answerhash{$shortcut}; |
} |
} |
Line 331 sub dumpenv {
|
Line 394 sub dumpenv {
|
my $r = shift; |
my $r = shift; |
|
|
$r->print ("<br />-------------------<br />"); |
$r->print ("<br />-------------------<br />"); |
foreach my $key (sort (keys %env)) { |
foreach my $key (sort(keys(%env))) { |
$r->print ("<br />$key -> $env{$key}"); |
$r->print ("<br />$key -> $env{$key}"); |
} |
} |
$r->print ("<br />-------------------<br />"); |
$r->print ("<br />-------------------<br />"); |
$r->print ("<br />-------------------<br />"); |
$r->print ("<br />-------------------<br />"); |
foreach my $key (sort (keys %ENV)) { |
foreach my $key (sort(keys(%ENV))) { |
$r->print ("<br />$key -> $ENV{$key}"); |
$r->print ("<br />$key -> $ENV{$key}"); |
} |
} |
$r->print ("<br />-------------------<br />"); |
$r->print ("<br />-------------------<br />"); |