[BACK]Return to lonpdfupload.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonpdfupload.pm between versions 1.4 and 1.15

version 1.4, 2009/05/15 17:53:06 version 1.15, 2010/03/18 13:16:11
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # Publication Handler  # PDF Form Upload Handler
 #  #
 # $Id$  # $Id$
 #  #
Line 29  package Apache::lonpdfupload; Line 29  package Apache::lonpdfupload;
   
 use lib '/home/httpd/lib/perl';  use lib '/home/httpd/lib/perl';
 use Apache::Constants qw(:common :http);  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::lonnet;
   use Apache::lonhtmlcommon();
 use Apache::loncommon();  use Apache::loncommon();
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::lonmsg();  
 use Apache::lonhomework;  
 use LONCAPA::Enrollment;  
 use LONCAPA::Configuration;  
 use CAM::PDF;  use CAM::PDF;
   
 use strict;  use strict;
   
 sub handler() {  sub handler() {
     my $r = shift;      my $r = shift;
       &Apache::loncommon::content_type($r,'text/html');
     # check user permissions       $r->send_http_header;
     if(!&checkpermission($r)) {      return OK if $r->header_only;
         # stop processing   
         return OK;      # Breadcrumbs
     }      my $brcrum = [{'href' => '/adm/pdfupload',
                      'text' => 'Upload PDF Form'}];
     $Apache::lonxml::request=$r;  
     $Apache::lonxml::debug=$env{'user.debug'};      $r->print(&Apache::loncommon::start_page('Upload PDF Form',
                                                undef,
     $env{'request.uri'}=$r->uri;                                               {'bread_crumbs' => $brcrum,})
     $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 a file was upload
     if($env{'form.Uploaded'} && $env{'form.file'}) {      if($env{'form.Uploaded'} && $env{'form.file'}) {
Line 80  sub handler() { Line 62  sub handler() {
     }      }
   
     #link to course-content      #link to course-content
     $r->print("    <br />\n    <a href='/adm/navmaps'>\n      ".&mt("Navigate Contents")."\n    </a>\n    <br />");      $r->print('<hr />'
                .'<p>'."\n"
                .'<a href="/adm/navmaps">'."\n"
                .&mt('Course Contents')."\n"
                .'</a>'."\n"
                .'</p>'."\n"
       );
   
     #&dumpenv($r); #debug -> prints the environment      #&dumpenv($r); #debug -> prints the environment
     $r->print("  </body> \n</html>\n");      $r->print(&Apache::loncommon::end_page());
     return OK;      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() {  sub get_javascripts() {
           
     my $message = &mt('Please choose a PDF-File');      my $message = &mt('Please choose a PDF-File.');
   
     # simple test if the upload ends with ".pdf"      # simple test if the upload ends with ".pdf"
     # it's only for giving a message to the user      # it's only for giving a message to the user
Line 140  END Line 101  END
   
 sub get_uploadform() {  sub get_uploadform() {
           
     #TODO use LON-CAPA routines like pick_box or like that    
     my %lt = &Apache::lonlocal::texthash(      my %lt = &Apache::lonlocal::texthash(
                  'title'=>'Submit a PDF-Form with problems',                    'title'  => 'Upload a PDF Form with filled Form Fields', 
                  'chFile' => 'Choose file:',                   'chFile' => 'File',
                  'submit'=>'Submit'                   'submit' => 'Upload',
              );               );
   
     my $result = <<END      my $result = 
     <form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);">          '<br />'
       <input type="hidden" name="type" value="upload" />         .'<form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);">'
       <br />         .'<input type="hidden" name="type" value="upload" />'
       <b>$lt{'title'}</b>         .&Apache::lonhtmlcommon::start_pick_box()
       <table class="LC_pick_box">          .&Apache::lonhtmlcommon::row_headline()
         <tbody>         .'<h2>'.$lt{'title'}.'</h2>'
           <tr class="LC_pick_box_row">         .&Apache::lonhtmlcommon::row_closure()
             <td class="LC_pick_box_title">         .&Apache::lonhtmlcommon::row_title($lt{'chFile'})
               $lt{'chFile'}         .'<input type="file" name="file" id="filename" />'
             </td>         .&Apache::lonhtmlcommon::row_closure(1)
             <td class="LC_pick_box_value LC_odd_row">         .&Apache::lonhtmlcommon::end_pick_box()
               <input type="file" name="file" id="filename" />         .'<p>'
             </td>         .'<input type="submit" name="Uploaded" value="'.$lt{'submit'}.'" />'
           </tr>         .'</p>'
         </tbody>         .'</form>'
       </table>         .'<br />';
       <br />  
       <input type="submit" name="Uploaded" value="$lt{'submit'}" />  
     </form>  
     <br />  
     <hr />      
 END  
 ;  
   return $result;    return $result;
 }  }
   
Line 183  sub processPDF { Line 137  sub processPDF {
     if (scalar @pdfdata) {          if (scalar @pdfdata) {    
         &grade_pdf(@pdfdata);          &grade_pdf(@pdfdata);
     } else {      } else {
         $result .= "<h2>".&mt("Can't find any valid PDF-formfields")."</h2>";          $result .= '<p class="LC_error">'
                     .&mt("Can't find any valid PDF formfields.")
                     .'</p>';
     }      }
 }  }
   
Line 197  sub get_pdf_data() { Line 153  sub get_pdf_data() {
  my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary   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"           # 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.          # and "i.am.aFormfield". The fragmentary names keep no values and will be ignored.
         if($dict->{'V'}) {          if($dict->{'V'}) {
Line 218  sub grade_pdf { Line 174  sub grade_pdf {
     my $debug = ();      my $debug = ();
   
     $debug  .= "Found: ". scalar @pdfdata." Entries \n";      $debug  .= "Found: ". scalar @pdfdata." Entries \n";
     $result .= '<br />';  
     $result .= &Apache::loncommon::start_data_table();  
     $result .= &Apache::loncommon::start_data_table_header_row();  
     $result .= &mt('<b>Results of PDF-Form problems</b>');  
     $result .= &Apache::loncommon::end_data_table_header_row();  
   
     foreach my $entry (sort(@pdfdata)) {      foreach my $entry (sort(@pdfdata)) {
         if ($entry =~ /^meta.*/) {          if ($entry =~ /^meta.*/) {
Line 232  sub grade_pdf { Line 183  sub grade_pdf {
             $user =~ s/(.*)\n/$1/; #TODO is that equals to chomp?              $user =~ s/(.*)\n/$1/; #TODO is that equals to chomp?
                           
             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 '<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.*/)  {          } elsif($entry =~ /^upload.*/)  {
Line 242  sub grade_pdf { Line 197  sub grade_pdf {
             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/; 
   
             #fehlerhafte Radiobuttons rausfiltern (Bug in CABAReT Stage)              #filter incorrect radiobuttons (Bug in CABAReT Stage)
             if($type eq 'radiobuttonresponse' && $value eq 'Off' ) {              if($type eq 'radiobuttonresponse' && $value eq 'Off' ) {
                 next;                  next;
             }              }
Line 253  sub grade_pdf { Line 208  sub grade_pdf {
                  $problems{$symb.$part}{$HWVAL} = $value;                   $problems{$symb.$part}{$HWVAL} = $value;
             } else {              } else {
                  $problems{$symb.$part} =  { 'resource' => $resource,                   $problems{$symb.$part} =  { 'resource' => $resource,
                                         'symb' => &Apache::lonenc::encrypted($symb),                                          'symb' => $symb,
                                         'submitted' => $part,                                          'submitted' => $part,
                                         $submit => 'Answer',                                          $submit => 'Answer',
                                         $HWVAL => $value};                                          $HWVAL => $value};
Line 265  sub grade_pdf { Line 220  sub grade_pdf {
     }      }
     #$result .= $debug;      #$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)) {      foreach my $key (sort (keys %problems)) {
         my %problem = %{$problems{$key}};          my %problem = %{$problems{$key}};
         my ($problemname, $grade) = &grade_problem(%problem);          my ($problemname, $grade) = &grade_problem(%problem);
   
         $problemname =~ s/(.*)\s*-\sPart\s0/$1/; #cut part when there is only one part in problem  
   
         $result .= &Apache::loncommon::start_data_table_row();          $result .= &Apache::loncommon::start_data_table_row();
         $result .= "<td>$problemname</td><td class='";          $result .= "<td>$problemname</td><td class='";
         if($grade eq "EXACT_ANS") {          if($grade eq "EXACT_ANS" || $grade eq "APPROX_ANS") {
             $result .= "LC_answer_correct";              $result .= "LC_answer_correct";
         } else {           } else { 
             $result .= "LC_answer_charged_try";              $result .= "LC_answer_charged_try";
         }          }
           $grade = &parse_grade_answer($grade);
         $result .= "'>$grade</span></td>";          $result .= "'>$grade</span></td>";
         $result .= &Apache::loncommon::end_data_table_row();          $result .= &Apache::loncommon::end_data_table_row();
     }      }
     #$result .= "\n</table>";  
     $result .= &Apache::loncommon::end_data_table();      $result .= &Apache::loncommon::end_data_table();
   
   
Line 290  sub grade_pdf { Line 251  sub grade_pdf {
   
 sub grade_problem {  sub grade_problem {
     my %problem = @_;      my %problem = @_;
       my ($title, $part) = ();
   
     my ($content) =  &Apache::loncommon::ssi_with_retries('/res/'.      &Apache::loncommon::ssi_with_retries('/res/'.$problem{'resource'}, 5, %problem);
             $problem{'resource'}, 5, %problem);  
       
     #TODO ? filter html response can't be the answer   
     #     ! find an other way to get a problemname and Part  
     $content =~ s/.*class="LC_current_location".*>(.*)<\/td>.*/$1/g;  
     $content = $1;  
   
     my $part = $problem{submitted};      $title = &Apache::lonnet::gettitle($problem{'symb'});    
       $part = $problem{submitted};
     $part =~ s/part_(.*)/$1/;      $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 %problemhash = &Apache::lonnet::restore($problem{'symb'});
     my $grade = $problemhash{"resource.$part.award"};      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  {  sub dumpenv  {
     my $r = shift;      my $r = shift;
   
Removed from v.1.4  
changed lines
  Added in v.1.15

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