# The LearningOnline Network with CAPA # PDF Form Upload Handler # # $Id: lonpdfupload.pm,v 1.20 2010/03/22 15:39:37 onken Exp $ # # Copyright Michigan State University Board of Trustees # # This file is part of the LearningOnline Network with CAPA (LON-CAPA). # # LON-CAPA is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # LON-CAPA is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with LON-CAPA; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # /home/httpd/html/adm/gpl.txt # # http://www.lon-capa.org/ # package Apache::lonpdfupload; use lib '/home/httpd/lib/perl'; use Apache::Constants qw(:common :http); use Apache::lonnet; use Apache::lonhtmlcommon(); use Apache::loncommon(); use Apache::lonnavmaps(); use Apache::lonlocal; use File::MMagic; use CAM::PDF; use LONCAPA qw(:DEFAULT :match); use strict; sub handler() { 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; } # Breadcrumbs my $brcrum = [{'href' => '/adm/pdfupload', 'text' => 'Upload PDF Form'}]; if ($env{'form.Uploaded'} && $env{'form.file'}) { push(@{$brcrum},{'href' => '', 'text' => 'PDF upload result'}); } $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 { $r->print(''. &mt('Could not determine identity of this course.').' '. &mt('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 $message = &mt('Please choose a PDF-File.'); # simple test if the upload ends with ".pdf" # it's only for giving a message to the user my $result .= <' .&mt("Can't find any valid PDF formfields.") .'
'; } } sub get_pdf_data() { my @data = (); my $pdf = CAM::PDF->new($env{'form.file'}); if($pdf) { my @formFields = $pdf->getFormFieldList(); #get names of formfields foreach my $field (@formFields) { my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary # 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 @pdfdata = @_; my ($result,$meta,%grades,%problems,%foreigncourse,$debug); my $navmap = Apache::lonnavmaps::navmap->new(); if (!defined($navmap)) { $result = '' .&mt('Wrong username ([_1]) found in PDF file. Expected username: [_2]' ,$user.':'.$domain ,$env{'user.domain'}.':'.$env{'user.name'}) .'
'; } } elsif ($entry =~ /^upload.*/) { $debug .= 'found: a problem -> '.$entry; my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/); my ($symb, $part, $type, $HWVAL) = split('&', $label); 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/; #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}) { $problems{$symb.$part}{$HWVAL} = $value; } else { $problems{$symb.$part} = { 'resource' => $resource, 'symb' => $symb, 'submitted' => $part, $submit => 'Answer', $HWVAL => $value}; } } else { $debug .= 'found: -> '.$entry; next; } } #$result .= $debug; $result .= ''. &mt('As no gradable form items were found, no submissions have been recorded.'). '
'; } 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 .= '