--- loncom/interface/lonpdfupload.pm 2008/09/09 13:56:44 1.1 +++ loncom/interface/lonpdfupload.pm 2010/03/18 16:08:48 1.17 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA -# Publication Handler +# PDF Form Upload Handler # -# $Id: lonpdfupload.pm,v 1.1 2008/09/09 13:56:44 onken Exp $ +# $Id: lonpdfupload.pm,v 1.17 2010/03/18 16:08:48 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -29,233 +29,219 @@ 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; - - #Testen ob der Benutzer ein gültiges Cookie besitzt - if(!&checkpermission($r)) { - return OK; - } + my $r = shift; + &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'}; - $env{'request.uri'}=$r->uri; - - $r->content_type('text/html'); - $r->send_http_header(); - $r->print(&Apache::loncommon::start_page('Upload-PDF-Form')); - - #lade die per POST gesendenten daten in env - &Apache::lonacc::get_posted_cgi($r); - - if($env{'form.Uploaded'} && $env{'form.file'}) { - #Upload-Formular wurde gesendet - $r->print(&processPDF); - - } else { - #erster Aufruf Upload-Formular wird ausgeben - $r->print(&get_javascripts); - $r->print(&get_uploadform); - - } - - #&dumpenv($r); #debug -> prints the environment - $r->print("
".&mt("Navigate Contents")."
"); - $r->print(" \n\n"); - return OK; -} + # Breadcrumbs + my $brcrum = [{'href' => '/adm/pdfupload', + 'text' => 'Upload PDF Form'}]; + if ($env{'form.Uploaded'} && $env{'form.file'}) { + push(@{$brcrum},{'href' => '', + 'text' => 'PDF upload result'}); + } -sub checkpermission() { - my $r = shift; - if (! &LONCAPA::loncgi::check_cookie_and_load_env()) { - my $result = < -Bad Cookie - -Your cookie information is incorrect. - - -END -; - $r->print($result); - return 0; + $r->print(&Apache::loncommon::start_page('Upload PDF Form', + 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('

'. + &mt('Upload of PDF forms is not permitted for this course.'). + '

'. + &Apache::loncommon::end_page()); + return OK; + } } else { - return 1; + $r->print('

'. + &mt('Could not determine identity of this course. you may need to [_1]re-select[_2] the course.','',''). + '

'. + &Apache::loncommon::end_page()); + return OK; } -} + # if a file was upload + if($env{'form.Uploaded'} && $env{'form.file'}) { + 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('

' + .&mt("The uploaded file does not appear to be a PDF file.") + .'

'); + } + } else { + # print upload form + $r->print(&get_javascripts); + $r->print(&get_uploadform); + } + + #link to course-content + $r->print('
' + .'

'."\n" + .''."\n" + .&mt('Course Contents')."\n" + .''."\n" + .'

'."\n" + ); + + #&dumpenv($r); #debug -> prints the environment + $r->print(&Apache::loncommon::end_page()); + return OK; +} sub get_javascripts() { - my $result = ' END ; - $result .= " "; return $result; } + sub get_uploadform() { - my $result = < -

-
- -
- - - - -
- - - - - - - - - - - -
- PDF-Formular einsenden -
- Datei auswählen - - -
- -
-
-
-
-END -; + + my %lt = &Apache::lonlocal::texthash( + 'title' => 'Upload a PDF Form with filled Form Fields', + 'chFile' => 'File', + 'submit' => 'Upload', + ); + + my $result = + '
' + .'
' + .'' + .&Apache::lonhtmlcommon::start_pick_box() + .&Apache::lonhtmlcommon::row_headline() + .'

'.$lt{'title'}.'

' + .&Apache::lonhtmlcommon::row_closure() + .&Apache::lonhtmlcommon::row_title($lt{'chFile'}) + .'' + .&Apache::lonhtmlcommon::row_closure(1) + .&Apache::lonhtmlcommon::end_pick_box() + .'

' + .'' + .'

' + .'
' + .'
'; + return $result; } sub processPDF { - my $result = (); - my @pdfdata = (); + my $result = (); # message for Browser + my @pdfdata = (); # answers from PDF-Forms - @pdfdata = &get_pdf_data; + @pdfdata = &get_pdf_data(); # get answers from PDF-Form if (scalar @pdfdata) { - $result .= &grade_pdf(@pdfdata); + &grade_pdf(@pdfdata); } else { - $result .= "

".&mt("reading PDF-formfields: failed")."

"; + $result .= '

' + .&mt("Can't find any valid PDF formfields.") + .'

'; } } sub get_pdf_data() { my @data = (); - my $file_path = "/home/httpd/pdfspool/".time."_". - int(rand(100000)).".pdf"; - my $file_data = $file_path; - $file_data =~ s/(.*)\..*/$1.data/; - - # zwischenspeichern der hochgeladenen PDF - my $temp_file = Apache::File->new('>'.$file_path); - binmode($temp_file); - print $temp_file $env{'form.file'}; - $temp_file->close; - - #Java PDF-Auslese-Programm starten - my @command = ("java", "-jar", - "/home/httpd/pdfspool/dumpPDF.jar", - $file_path, $file_data); - system(@command); - + my $pdf = CAM::PDF->new($env{'form.file'}); - #Einlesen der extrahierten Daten - $temp_file = new IO::File->new('<'.$file_data); - while (defined (my $line = $temp_file->getline())) { - push(@data, $line); - } - $temp_file->close; - undef($temp_file); + my @formFields = $pdf->getFormFieldList(); #get names of formfields + + foreach my $field (@formFields) { + my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary - #zwischengespeicherte Dateien loeschen - if( -e $file_path) { -# unlink($file_path); - } - if( -e $file_data) { -# unlink($file_data); - } + # + # 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'}) { + push(@data, $field."?". $dict->{'V'}{'value'}); #binding fieldname with value + } + } return @data; } sub grade_pdf { my $result = (); my @pdfdata = @_; + my ($result,$meta,%grades,%problems,$debug); - my $meta = (); - my %grades = (); - my %problems = (); - - my $debug = (); - $debug .= "Found: ". scalar @pdfdata." Entries \n"; - $result .= "\n"; + foreach my $entry (sort(@pdfdata)) { if ($entry =~ /^meta.*/) { - $debug .= 'found: metadata -> '.$entry; - my ($label, $value) = split('\?', $entry); + $debug .= 'found: metadata -> '.$entry . "
"; + my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/); my ($domain, $user) = split('&', $value); - $user =~ s/(.*)\n/$1/; + $user =~ s/(.*)\n/$1/; #TODO is that equals to chomp? if($user ne $env{'user.name'} or $domain ne $env{'user.domain'}) { - return "
".&mt('Wrong username in PDF-File').": $user $domain -> $env{'user.domain'} $env{'user.name'}
"; + return '

' + .&mt('Wrong username ([_1]) found in PDF file. Expected username: [_2]' + ,$user.':'.$domain + ,$env{'user.domain'}.':'.$env{'user.name'}) + .'

'; } - } elsif($entry =~ /^upload.*/) { + } elsif ($entry =~ /^upload.*/) { $debug .= 'found: a problem -> '.$entry; - my ($label, $value) = split('\?', $entry); + my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/); 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); + next unless (&Apache::lonnet::is_on_map($resource)); $value =~ s/(.*)\n/$1/; - #fehlerhafte Radiobuttons rausfiltern (Bug in CABAReT Stage) - if($type eq 'radiobuttonresponse' && $value eq 'Off' ) { + #filter incorrect radiobuttons (Bug in CABAReT Stage) + if ($type eq 'radiobuttonresponse' && $value eq 'Off' ) { next; } my $submit = $part; $submit =~ s/part_(.*)/submit_$1/; - if($problems{$symb.$part}) { + if ($problems{$symb.$part}) { $problems{$symb.$part}{$HWVAL} = $value; } else { $problems{$symb.$part} = { 'resource' => $resource, @@ -268,45 +254,81 @@ sub grade_pdf { $debug .= 'found: -> '.$entry; next; } - #$result = $debug; } + #$result .= $debug; - foreach my $key (sort (keys %problems)) { - my %problem = %{$problems{$key}}; - my ($problemname, $grade) = &grade_problem(%problem); - $result .= ""; + $result .= '

'.&mt('Results of PDF Form problems').'

'; + if (keys(%problems) > 0) { + $result .= &Apache::loncommon::start_data_table() + .&Apache::loncommon::start_data_table_header_row() + .'' + .'' + .&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 .= ""; + $result .= &Apache::loncommon::end_data_table_row(); + } + $result .= &Apache::loncommon::end_data_table(); + } else { + $result .= '

'. + &mt('As no gradable form items were found, no submissions have been recorded.'). + '

'; } - $result .= "\n
$problemname$grade
'.&mt('Problem Name').''.&mt('Grading').'$problemname$grade
"; return $result; } sub grade_problem { my %problem = @_; + my ($title, $part) = (); - my ($content) = &Apache::loncommon::ssi_with_retries('/res/'. - $problem{'resource'}, 5, %problem); - - $content =~ s/.*class="LC_current_location".*>(.*)<\/td>.*/$1/g; - $content = $1; + &Apache::loncommon::ssi_with_retries('/res/'.$problem{'resource'}, 5, %problem); - my $part = $problem{submitted}; + $title = &Apache::lonnet::gettitle($problem{'symb'}); + $part = $problem{submitted}; $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 $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 { my $r = shift;