--- loncom/interface/lonpdfupload.pm 2008/09/09 13:56:44 1.1 +++ loncom/interface/lonpdfupload.pm 2009/05/23 04:07:09 1.10 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpdfupload.pm,v 1.1 2008/09/09 13:56:44 onken Exp $ +# $Id: lonpdfupload.pm,v 1.10 2009/05/23 04:07:09 onken Exp $ # # Copyright Michigan State University Board of Trustees # @@ -46,45 +46,54 @@ use Apache::lonmsg(); use Apache::lonhomework; use LONCAPA::Enrollment; use LONCAPA::Configuration; +use CAM::PDF; use strict; sub handler() { - my $r = shift; + my $r = shift; - #Testen ob der Benutzer ein gültiges Cookie besitzt - if(!&checkpermission($r)) { - return OK; - } + # check user permissions + if(!&checkpermission($r)) { + # stop processing + return OK; + } - $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; + $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')); + + #load post data into environment + &Apache::lonacc::get_posted_cgi($r); + + # if a file was upload + if($env{'form.Uploaded'} && $env{'form.file'}) { + $r->print(&processPDF); + } else { + # print upload form + $r->print(&get_javascripts); + $r->print(&get_uploadform); + } + + #link to course-content + $r->print('
' + .'

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

'."\n" + ); + + #&dumpenv($r); #debug -> prints the environment + $r->print(&Apache::loncommon::end_page()); + return OK; } + sub checkpermission() { my $r = shift; if (! &LONCAPA::loncgi::check_cookie_and_load_env()) { @@ -92,10 +101,14 @@ sub checkpermission() { Content-type: text/html -Bad Cookie - -Your cookie information is incorrect. - + + + Bad Cookie + + + + Your cookie information is incorrect. + END ; @@ -108,113 +121,88 @@ END 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 nessesary 'cause 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; } @@ -229,13 +217,20 @@ sub grade_pdf { my $debug = (); $debug .= "Found: ". scalar @pdfdata." Entries \n"; - $result .= "\n"; + $result .= '

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

'; + $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 $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'}
"; @@ -243,12 +238,12 @@ sub grade_pdf { } 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); $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' ) { next; } @@ -259,7 +254,7 @@ sub grade_pdf { $problems{$symb.$part}{$HWVAL} = $value; } else { $problems{$symb.$part} = { 'resource' => $resource, - 'symb' => $symb, + 'symb' => &Apache::lonenc::encrypted($symb), 'submitted' => $part, $submit => 'Answer', $HWVAL => $value}; @@ -268,45 +263,67 @@ 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 .= "
'.&mt('Problem Name').''.&mt('Grading').'
$problemname(.*)<\/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;