version 1.4, 2009/05/15 17:53:06
|
version 1.16, 2010/03/18 14:50:15
|
Line 1
|
Line 1
|
# The LearningOnline Network with CAPA |
# The LearningOnline Network with CAPA |
# Publication Handler |
# PDF Form Upload Handler |
# |
# |
# $Id$ |
# $Id$ |
# |
# |
Line 29 package Apache::lonpdfupload;
|
Line 29 package Apache::lonpdfupload;
|
|
|
use lib '/home/httpd/lib/perl'; |
use lib '/home/httpd/lib/perl'; |
use Apache::Constants qw(:common :http); |
use Apache::Constants qw(:common :http); |
use LONCAPA; |
|
use LONCAPA::loncgi; |
|
use File::Path; |
|
use File::Basename; |
|
use File::Copy; |
|
use IO::File; |
|
use Image::Magick; |
|
use Apache::lonacc; |
|
use Apache::lonxml; |
|
use Apache::lonhtmlcommon(); |
|
use Apache::lonnet; |
use Apache::lonnet; |
|
use Apache::lonhtmlcommon(); |
use Apache::loncommon(); |
use Apache::loncommon(); |
use Apache::lonlocal; |
use Apache::lonlocal; |
use Apache::lonmsg(); |
use File::MMagic; |
use Apache::lonhomework; |
|
use LONCAPA::Enrollment; |
|
use LONCAPA::Configuration; |
|
use CAM::PDF; |
use CAM::PDF; |
|
|
use strict; |
use strict; |
|
|
sub handler() { |
sub handler() { |
my $r = shift; |
my $r = shift; |
|
&Apache::loncommon::content_type($r,'text/html'); |
# check user permissions |
$r->send_http_header; |
if(!&checkpermission($r)) { |
return OK if $r->header_only; |
# stop processing |
|
return OK; |
# Needs to be in a course |
|
if (!$env{'request.course.fn'}) { |
|
# Not in a course |
|
$env{'user.error.msg'}="/adm/pdfupload:bre:0:0:Cannot upload PDF forms unless in a course"; |
|
return HTTP_NOT_ACCEPTABLE; |
} |
} |
|
|
$Apache::lonxml::request=$r; |
# Breadcrumbs |
$Apache::lonxml::debug=$env{'user.debug'}; |
my $brcrum = [{'href' => '/adm/pdfupload', |
|
'text' => 'Upload PDF Form'}]; |
$env{'request.uri'}=$r->uri; |
if ($env{'form.Uploaded'} && $env{'form.file'}) { |
$r->content_type('text/html'); |
push(@{$brcrum},{'href' => '', |
$r->send_http_header(); |
'text' => 'PDF upload result'}); |
$r->print(&Apache::loncommon::start_page('Upload-PDF-Form')); |
} |
|
|
#load post data into environment |
$r->print(&Apache::loncommon::start_page('Upload PDF Form', |
&Apache::lonacc::get_posted_cgi($r); |
undef, |
|
{'bread_crumbs' => $brcrum,}) |
|
); |
|
|
|
if ($env{'request.course.id'}) { |
|
my $permission = $env{'course.'.$env{'request.course.id'}.'.canuse_pdfforms'}; |
|
if ($permission eq '') { |
|
my %domdefs = &Apache::lonnet::get_domain_defaults($env{'course.'.$env{'request.course.id'}.'.domain'}); |
|
$permission = $domdefs{'canuse_pdfforms'}; |
|
} |
|
unless ($permission) { |
|
$r->print('<p class="LC_warning">'. |
|
&mt('Upload of PDF forms is not permitted for this course.'). |
|
'</p>'. |
|
&Apache::loncommon::end_page()); |
|
return OK; |
|
} |
|
} else { |
|
$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>'). |
|
'</p>'. |
|
&Apache::loncommon::end_page()); |
|
return OK; |
|
} |
|
|
# if a file was upload |
# if a file was upload |
if($env{'form.Uploaded'} && $env{'form.file'}) { |
if($env{'form.Uploaded'} && $env{'form.file'}) { |
$r->print(&processPDF); |
my $mm = new File::MMagic; |
|
my $mime_type = $mm->checktype_contents($env{'form.file'}); |
|
if ($mime_type eq 'application/pdf') { |
|
$r->print(&processPDF); |
|
} else { |
|
$r->print('<p class="LC_error">' |
|
.&mt("The uploaded file does not appear to be a PDF file.") |
|
.'</p>'); |
|
} |
} else { |
} else { |
# print upload form |
# print upload form |
$r->print(&get_javascripts); |
$r->print(&get_javascripts); |
Line 80 sub handler() {
|
Line 103 sub handler() {
|
} |
} |
|
|
#link to course-content |
#link to course-content |
$r->print(" <br />\n <a href='/adm/navmaps'>\n ".&mt("Navigate Contents")."\n </a>\n <br />"); |
$r->print('<hr />' |
|
.'<p>'."\n" |
|
.'<a href="/adm/navmaps">'."\n" |
|
.&mt('Course Contents')."\n" |
|
.'</a>'."\n" |
|
.'</p>'."\n" |
|
); |
|
|
#&dumpenv($r); #debug -> prints the environment |
#&dumpenv($r); #debug -> prints the environment |
$r->print(" </body> \n</html>\n"); |
$r->print(&Apache::loncommon::end_page()); |
return OK; |
return OK; |
} |
} |
|
|
|
|
sub checkpermission() { |
|
my $r = shift; |
|
if (! &LONCAPA::loncgi::check_cookie_and_load_env()) { |
|
my $result = <<END |
|
Content-type: text/html |
|
|
|
<html> |
|
<head> |
|
<title> |
|
Bad Cookie |
|
</title> |
|
</head> |
|
<body> |
|
Your cookie information is incorrect. |
|
</body> |
|
</html> |
|
END |
|
; |
|
$r->print($result); |
|
return 0; |
|
} else { |
|
return 1; |
|
} |
|
} |
|
|
|
|
|
sub get_javascripts() { |
sub get_javascripts() { |
|
|
my $message = &mt('Please choose a PDF-File'); |
my $message = &mt('Please choose a PDF-File.'); |
|
|
# simple test if the upload ends with ".pdf" |
# simple test if the upload ends with ".pdf" |
# it's only for giving a message to the user |
# it's only for giving a message to the user |
Line 140 END
|
Line 142 END
|
|
|
sub get_uploadform() { |
sub get_uploadform() { |
|
|
#TODO use LON-CAPA routines like pick_box or like that |
|
my %lt = &Apache::lonlocal::texthash( |
my %lt = &Apache::lonlocal::texthash( |
'title'=>'Submit a PDF-Form with problems', |
'title' => 'Upload a PDF Form with filled Form Fields', |
'chFile' => 'Choose file:', |
'chFile' => 'File', |
'submit'=>'Submit' |
'submit' => 'Upload', |
); |
); |
|
|
my $result = <<END |
my $result = |
<form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);"> |
'<br />' |
<input type="hidden" name="type" value="upload" /> |
.'<form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);">' |
<br /> |
.'<input type="hidden" name="type" value="upload" />' |
<b>$lt{'title'}</b> |
.&Apache::lonhtmlcommon::start_pick_box() |
<table class="LC_pick_box"> |
.&Apache::lonhtmlcommon::row_headline() |
<tbody> |
.'<h2>'.$lt{'title'}.'</h2>' |
<tr class="LC_pick_box_row"> |
.&Apache::lonhtmlcommon::row_closure() |
<td class="LC_pick_box_title"> |
.&Apache::lonhtmlcommon::row_title($lt{'chFile'}) |
$lt{'chFile'} |
.'<input type="file" name="file" id="filename" />' |
</td> |
.&Apache::lonhtmlcommon::row_closure(1) |
<td class="LC_pick_box_value LC_odd_row"> |
.&Apache::lonhtmlcommon::end_pick_box() |
<input type="file" name="file" id="filename" /> |
.'<p>' |
</td> |
.'<input type="submit" name="Uploaded" value="'.$lt{'submit'}.'" />' |
</tr> |
.'</p>' |
</tbody> |
.'</form>' |
</table> |
.'<br />'; |
<br /> |
|
<input type="submit" name="Uploaded" value="$lt{'submit'}" /> |
|
</form> |
|
<br /> |
|
<hr /> |
|
END |
|
; |
|
return $result; |
return $result; |
} |
} |
|
|
Line 183 sub processPDF {
|
Line 178 sub processPDF {
|
if (scalar @pdfdata) { |
if (scalar @pdfdata) { |
&grade_pdf(@pdfdata); |
&grade_pdf(@pdfdata); |
} else { |
} else { |
$result .= "<h2>".&mt("Can't find any valid PDF-formfields")."</h2>"; |
$result .= '<p class="LC_error">' |
|
.&mt("Can't find any valid PDF formfields.") |
|
.'</p>'; |
} |
} |
} |
} |
|
|
Line 197 sub get_pdf_data() {
|
Line 194 sub get_pdf_data() {
|
my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary |
my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary |
|
|
# |
# |
# this is nessesary 'cause CAM::PDF has a problem with formfieldnames 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 "i", "i.am" |
# dot in fieldnames. So a fieldname like "i.am.aFormfield" will offer three fieldnames "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'}) { |
Line 218 sub grade_pdf {
|
Line 215 sub grade_pdf {
|
my $debug = (); |
my $debug = (); |
|
|
$debug .= "Found: ". scalar @pdfdata." Entries \n"; |
$debug .= "Found: ". scalar @pdfdata." Entries \n"; |
$result .= '<br />'; |
|
$result .= &Apache::loncommon::start_data_table(); |
|
$result .= &Apache::loncommon::start_data_table_header_row(); |
|
$result .= &mt('<b>Results of PDF-Form problems</b>'); |
|
$result .= &Apache::loncommon::end_data_table_header_row(); |
|
|
|
foreach my $entry (sort(@pdfdata)) { |
foreach my $entry (sort(@pdfdata)) { |
if ($entry =~ /^meta.*/) { |
if ($entry =~ /^meta.*/) { |
Line 232 sub grade_pdf {
|
Line 224 sub grade_pdf {
|
$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 "<pre>".&mt('Wrong username in PDF-File').": $user $domain -> $env{'user.domain'} $env{'user.name'} </pre>"; |
return '<p class="LC_error">' |
|
.&mt('Wrong username ([_1]) found in PDF file. Expected username: [_2]' |
|
,$user.':'.$domain |
|
,$env{'user.domain'}.':'.$env{'user.name'}) |
|
.'</p>'; |
} |
} |
|
|
} elsif($entry =~ /^upload.*/) { |
} elsif($entry =~ /^upload.*/) { |
Line 242 sub grade_pdf {
|
Line 238 sub grade_pdf {
|
my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb); |
my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb); |
$value =~ s/(.*)\n/$1/; |
$value =~ s/(.*)\n/$1/; |
|
|
#fehlerhafte Radiobuttons rausfiltern (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; |
} |
} |
Line 253 sub grade_pdf {
|
Line 249 sub grade_pdf {
|
$problems{$symb.$part}{$HWVAL} = $value; |
$problems{$symb.$part}{$HWVAL} = $value; |
} else { |
} else { |
$problems{$symb.$part} = { 'resource' => $resource, |
$problems{$symb.$part} = { 'resource' => $resource, |
'symb' => &Apache::lonenc::encrypted($symb), |
'symb' => $symb, |
'submitted' => $part, |
'submitted' => $part, |
$submit => 'Answer', |
$submit => 'Answer', |
$HWVAL => $value}; |
$HWVAL => $value}; |
Line 265 sub grade_pdf {
|
Line 261 sub grade_pdf {
|
} |
} |
#$result .= $debug; |
#$result .= $debug; |
|
|
|
$result .= '<h2>'.&mt('Results of PDF Form problems').'</h2>'; |
|
$result .= &Apache::loncommon::start_data_table() |
|
.&Apache::loncommon::start_data_table_header_row() |
|
.'<th>'.&mt('Problem Name').'</th>' |
|
.'<th>'.&mt('Grading').'</th>' |
|
.&Apache::loncommon::start_data_table_header_row() |
|
.&Apache::loncommon::end_data_table_header_row(); |
|
|
foreach my $key (sort (keys %problems)) { |
foreach my $key (sort (keys %problems)) { |
my %problem = %{$problems{$key}}; |
my %problem = %{$problems{$key}}; |
my ($problemname, $grade) = &grade_problem(%problem); |
my ($problemname, $grade) = &grade_problem(%problem); |
|
|
$problemname =~ s/(.*)\s*-\sPart\s0/$1/; #cut part when there is only one part in problem |
|
|
|
$result .= &Apache::loncommon::start_data_table_row(); |
$result .= &Apache::loncommon::start_data_table_row(); |
$result .= "<td>$problemname</td><td class='"; |
$result .= "<td>$problemname</td><td class='"; |
if($grade eq "EXACT_ANS") { |
if($grade eq "EXACT_ANS" || $grade eq "APPROX_ANS") { |
$result .= "LC_answer_correct"; |
$result .= "LC_answer_correct"; |
} else { |
} else { |
$result .= "LC_answer_charged_try"; |
$result .= "LC_answer_charged_try"; |
} |
} |
|
$grade = &parse_grade_answer($grade); |
$result .= "'>$grade</span></td>"; |
$result .= "'>$grade</span></td>"; |
$result .= &Apache::loncommon::end_data_table_row(); |
$result .= &Apache::loncommon::end_data_table_row(); |
} |
} |
#$result .= "\n</table>"; |
|
$result .= &Apache::loncommon::end_data_table(); |
$result .= &Apache::loncommon::end_data_table(); |
|
|
|
|
Line 290 sub grade_pdf {
|
Line 292 sub grade_pdf {
|
|
|
sub grade_problem { |
sub grade_problem { |
my %problem = @_; |
my %problem = @_; |
|
my ($title, $part) = (); |
|
|
my ($content) = &Apache::loncommon::ssi_with_retries('/res/'. |
&Apache::loncommon::ssi_with_retries('/res/'.$problem{'resource'}, 5, %problem); |
$problem{'resource'}, 5, %problem); |
|
|
|
#TODO ? filter html response can't be the answer |
|
# ! find an other way to get a problemname and Part |
|
$content =~ s/.*class="LC_current_location".*>(.*)<\/td>.*/$1/g; |
|
$content = $1; |
|
|
|
my $part = $problem{submitted}; |
$title = &Apache::lonnet::gettitle($problem{'symb'}); |
|
$part = $problem{submitted}; |
$part =~ s/part_(.*)/$1/; |
$part =~ s/part_(.*)/$1/; |
$content .= " - Part $part"; |
unless($part eq '0') { |
|
#add information about part number |
|
$title .= " - Part $part"; |
|
} |
|
|
my %problemhash = &Apache::lonnet::restore($problem{'symb'}); |
my %problemhash = &Apache::lonnet::restore($problem{'symb'}); |
my $grade = $problemhash{"resource.$part.award"}; |
my $grade = $problemhash{"resource.$part.award"}; |
|
|
return ($content, $grade); |
return ($title, $grade); |
|
} |
|
|
|
sub parse_grade_answer { |
|
my ($shortcut) = @_; |
|
my %answerhash = ('EXACT_ANS' => &mt('You are correct.'), |
|
'APPROX_ANS' => &mt('You are correct.'), |
|
'INCORRECT' => &mt('You are incorrect'), |
|
); |
|
|
|
foreach my $key (keys %answerhash) { |
|
if($shortcut eq $key) { |
|
return $answerhash{$shortcut}; |
|
} |
|
} |
|
return &mt('See course contents for further information.'); |
|
|
} |
} |
|
|
|
|
sub dumpenv { |
sub dumpenv { |
my $r = shift; |
my $r = shift; |
|
|