--- loncom/interface/lonpdfupload.pm 2009/05/21 03:09:01 1.7
+++ loncom/interface/lonpdfupload.pm 2010/03/18 14:50:15 1.16
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
-# Publication Handler
+# PDF Form Upload Handler
#
-# $Id: lonpdfupload.pm,v 1.7 2009/05/21 03:09:01 onken Exp $
+# $Id: lonpdfupload.pm,v 1.16 2010/03/18 14:50:15 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -29,50 +29,73 @@ package Apache::lonpdfupload;
use lib '/home/httpd/lib/perl';
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::lonhtmlcommon();
use Apache::loncommon();
use Apache::lonlocal;
-use Apache::lonmsg();
-use Apache::lonhomework;
-use LONCAPA::Enrollment;
-use LONCAPA::Configuration;
+use File::MMagic;
use CAM::PDF;
use strict;
sub handler() {
my $r = shift;
-
- # check user permissions
- if(!&checkpermission($r)) {
- # stop processing
- return OK;
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+ return OK if $r->header_only;
+
+ # 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;
- $Apache::lonxml::debug=$env{'user.debug'};
+ # Breadcrumbs
+ my $brcrum = [{'href' => '/adm/pdfupload',
+ 'text' => 'Upload PDF Form'}];
+ if ($env{'form.Uploaded'} && $env{'form.file'}) {
+ push(@{$brcrum},{'href' => '',
+ 'text' => 'PDF upload result'});
+ }
- $env{'request.uri'}=$r->uri;
- $r->content_type('text/html');
- $r->send_http_header();
- $r->print(&Apache::loncommon::start_page(&mt('Upload PDF Form')));
+ $r->print(&Apache::loncommon::start_page('Upload PDF Form',
+ undef,
+ {'bread_crumbs' => $brcrum,})
+ );
- #load post data into environment
- &Apache::lonacc::get_posted_cgi($r);
+ 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($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 {
# print upload form
$r->print(&get_javascripts);
@@ -83,7 +106,7 @@ sub handler() {
$r->print('<hr />'
.'<p>'."\n"
.'<a href="/adm/navmaps">'."\n"
- .&mt("Navigate Contents")."\n"
+ .&mt('Course Contents')."\n"
.'</a>'."\n"
.'</p>'."\n"
);
@@ -93,33 +116,6 @@ sub handler() {
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() {
my $message = &mt('Please choose a PDF-File.');
@@ -164,7 +160,9 @@ sub get_uploadform() {
.'<input type="file" name="file" id="filename" />'
.&Apache::lonhtmlcommon::row_closure(1)
.&Apache::lonhtmlcommon::end_pick_box()
+ .'<p>'
.'<input type="submit" name="Uploaded" value="'.$lt{'submit'}.'" />'
+ .'</p>'
.'</form>'
.'<br />';
@@ -196,7 +194,7 @@ sub get_pdf_data() {
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"
# and "i.am.aFormfield". The fragmentary names keep no values and will be ignored.
if($dict->{'V'}) {
@@ -217,13 +215,6 @@ sub grade_pdf {
my $debug = ();
$debug .= "Found: ". scalar @pdfdata." Entries \n";
- $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 $entry (sort(@pdfdata)) {
if ($entry =~ /^meta.*/) {
@@ -233,7 +224,11 @@ sub grade_pdf {
$user =~ s/(.*)\n/$1/; #TODO is that equals to chomp?
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.*/) {
@@ -254,7 +249,7 @@ sub grade_pdf {
$problems{$symb.$part}{$HWVAL} = $value;
} else {
$problems{$symb.$part} = { 'resource' => $resource,
- 'symb' => &Apache::lonenc::encrypted($symb),
+ 'symb' => $symb,
'submitted' => $part,
$submit => 'Answer',
$HWVAL => $value};
@@ -266,17 +261,26 @@ sub grade_pdf {
}
#$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)) {
my %problem = %{$problems{$key}};
my ($problemname, $grade) = &grade_problem(%problem);
$result .= &Apache::loncommon::start_data_table_row();
$result .= "<td>$problemname</td><td class='";
- if($grade eq "EXACT_ANS") {
+ if($grade eq "EXACT_ANS" || $grade eq "APPROX_ANS") {
$result .= "LC_answer_correct";
} else {
$result .= "LC_answer_charged_try";
}
+ $grade = &parse_grade_answer($grade);
$result .= "'>$grade</span></td>";
$result .= &Apache::loncommon::end_data_table_row();
}
@@ -306,6 +310,23 @@ sub grade_problem {
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 {
my $r = shift;