Diff for /loncom/interface/lonpdfupload.pm between versions 1.1 and 1.2

version 1.1, 2008/09/09 13:56:44 version 1.2, 2009/04/03 15:40:17
Line 46  use Apache::lonmsg(); Line 46  use Apache::lonmsg();
 use Apache::lonhomework;  use Apache::lonhomework;
 use LONCAPA::Enrollment;  use LONCAPA::Enrollment;
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
   use CAM::PDF;
   
 use strict;  use strict;
   
 sub handler() {  sub handler() {
   my $r = shift;      my $r = shift;
   
   #Testen ob der Benutzer ein gültiges Cookie besitzt      # check user permissions 
   if(!&checkpermission($r)) {      if(!&checkpermission($r)) {
     return OK;          # stop processing 
   }          return OK;
       }
   
   $Apache::lonxml::request=$r;      $Apache::lonxml::request=$r;
   $Apache::lonxml::debug=$env{'user.debug'};      $Apache::lonxml::debug=$env{'user.debug'};
   $env{'request.uri'}=$r->uri;  
        $env{'request.uri'}=$r->uri;
   $r->content_type('text/html');      $r->content_type('text/html');
   $r->send_http_header();      $r->send_http_header();
   $r->print(&Apache::loncommon::start_page('Upload-PDF-Form'));      $r->print(&Apache::loncommon::start_page('Upload-PDF-Form'));
   
   #lade die per POST gesendenten daten in env      #load post data into environment
   &Apache::lonacc::get_posted_cgi($r);      &Apache::lonacc::get_posted_cgi($r);
   
   if($env{'form.Uploaded'} && $env{'form.file'}) {       # if a file was upload
     #Upload-Formular wurde gesendet      if($env{'form.Uploaded'} && $env{'form.file'}) {
     $r->print(&processPDF);          $r->print(&processPDF);
       } else { 
   } else {           # print upload form
     #erster Aufruf Upload-Formular wird ausgeben             $r->print(&get_javascripts);
     $r->print(&get_javascripts);          $r->print(&get_uploadform);
     $r->print(&get_uploadform);      }
   
   }      #link to course-content
       $r->print("    <br />\n    <a href='/adm/navmaps'>\n      ".&mt("Navigate Contents")."\n    </a>\n    <br />");
   #&dumpenv($r); #debug -> prints the environment  
   $r->print("<br /><a href='/adm/navmaps'>".&mt("Navigate Contents")."</a><br />");      #&dumpenv($r); #debug -> prints the environment
   $r->print("  </body>\n</html>\n");      $r->print("  </body> \n</html>\n");
   return OK;      return OK;
 }  }
   
   
 sub checkpermission() {  sub checkpermission() {
     my $r = shift;      my $r = shift;
     if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {      if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
Line 92  sub checkpermission() { Line 95  sub checkpermission() {
 Content-type: text/html  Content-type: text/html
   
 <html>  <html>
 <head><title>Bad Cookie</title></head>    <head>
 <body>      <title>
 Your cookie information is incorrect.        Bad Cookie
 </body>      </title>
     </head>
     <body>
       Your cookie information is incorrect.
     </body>
 </html>  </html>
 END  END
 ;  ;
Line 108  END Line 115  END
   
   
 sub get_javascripts() {  sub get_javascripts() {
     my $result = '  <script type="text/javascript">';      
       my $message = &mt('Please choose a PDF-File');
   
     # JavaScript prüft die Datei Endung der hochzuladenden Datei      # simple test if the upload ends with ".pdf"
     $result .= <<END      # it's only for giving a message to the user
       my $result .= <<END
     <script type="text/javascript">
     function checkFilename(form) {      function checkFilename(form) {
         var fileExt = form.file.value;          var fileExt = form.file.value;
         fileExt = fileExt.match(/[.]pdf\$/g);          fileExt = fileExt.match(/[.]pdf\$/g);
         if(fileExt) {          if(fileExt) {
             return true;              return true;
         }          }
         alert("Bitte geben Sie nur ein PDF an.")          alert("$message");
         return false;          return false;
     }      }
     </script>
 END  END
 ;  ;
     $result .= "  </script>";  
     return $result;       return $result; 
 }  }
   
   
 sub get_uploadform() {  sub get_uploadform() {
     my $result = <<END      my $result = <<END
     <p height='25'>       <p height='25'> 
Line 168  END Line 179  END
 }  }
   
 sub processPDF {  sub processPDF {
     my $result = ();      my $result = ();  # message for Browser
     my @pdfdata = ();      my @pdfdata = (); # answers from PDF-Forms
           
     @pdfdata = &get_pdf_data;      @pdfdata = &get_pdf_data(); # get answers from PDF-Form
           
     if (scalar @pdfdata) {          if (scalar @pdfdata) {    
         $result .= &grade_pdf(@pdfdata);          &grade_pdf(@pdfdata);
     } else {      } else {
         $result .= "<h2>".&mt("reading PDF-formfields: failed")."</h2>";          $result .= "<h2>".&mt("Can't find any valid PDF-formfields")."</h2>";
     }      }
 }  }
   
 sub get_pdf_data() {  sub get_pdf_data() {
     my @data = ();      my @data = ();
     my $file_path = "/home/httpd/pdfspool/".time."_".      my $pdf = CAM::PDF->new($env{'form.file'});
                     int(rand(100000)).".pdf";  
     my $file_data = $file_path;      my @formFields = $pdf->getFormFieldList(); #get names of formfields
        $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);  
           
       foreach my $field (@formFields) {
    my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary
   
     #Einlesen der extrahierten Daten          #
     $temp_file = new IO::File->new('<'.$file_data);          # this is nessesary 'cause CAM::PDF has a problem with formfieldnames which include a
     while (defined (my $line = $temp_file->getline())) {          # dot in fieldnames. So a fieldname like "i.am.aFormfield" will offer three fieldnames "i", "i.am" 
         push(@data, $line);          # and "i.am.aFormfield". The fragmentary names keep no values and will be ignored.
     }          if($dict->{'V'}) {
     $temp_file->close;              push(@data, $field."?". $dict->{'V'}{'value'}); #binding fieldname with value
     undef($temp_file);          }
       } 
     #zwischengespeicherte Dateien loeschen  
     if( -e $file_path) {  
 #        unlink($file_path);  
     }  
     if( -e $file_data) {  
 #        unlink($file_data);   
     }  
     return @data;      return @data;
 }  }
   
Line 232  sub grade_pdf { Line 225  sub grade_pdf {
     $result .= "<table width='80%'>\n";      $result .= "<table width='80%'>\n";
     foreach my $entry (sort(@pdfdata)) {      foreach my $entry (sort(@pdfdata)) {
         if ($entry =~ /^meta.*/) {          if ($entry =~ /^meta.*/) {
             $debug .= 'found: metadata -> '.$entry;              $debug .= 'found: metadata -> '.$entry . "<br />";
             my ($label, $value) = split('\?', $entry);              my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/);
             my ($domain, $user) = split('&', $value);              my ($domain, $user) = split('&', $value);
             $user =~ s/(.*)\n/$1/;              $user =~ s/(.*)\n/$1/; #TODO find an other way
                           
             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 "<pre>".&mt('Wrong username in PDF-File').": $user $domain -> $env{'user.domain'} $env{'user.name'} </pre>";    
Line 243  sub grade_pdf { Line 236  sub grade_pdf {
   
         } elsif($entry =~ /^upload.*/)  {          } elsif($entry =~ /^upload.*/)  {
             $debug .= 'found: a problem -> '.$entry;              $debug .= 'found: a problem -> '.$entry;
             my ($label, $value) = split('\?', $entry);              my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/);
             my ($symb, $part, $type, $HWVAL) = split('&', $label);              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);  
             $value =~ s/(.*)\n/$1/;               $value =~ s/(.*)\n/$1/; 
Line 268  sub grade_pdf { Line 261  sub grade_pdf {
             $debug .= 'found: -> '.$entry;              $debug .= 'found: -> '.$entry;
             next;              next;
         }          }
         #$result = $debug;  
     }      }
       $result .= $debug;
   
     foreach my $key (sort (keys %problems)) {      foreach my $key (sort (keys %problems)) {
         my %problem = %{$problems{$key}};          my %problem = %{$problems{$key}};

Removed from v.1.1  
changed lines
  Added in v.1.2


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>