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

Diff for /loncom/interface/lonpdfupload.pm between versions 1.17 and 1.25

version 1.17, 2010/03/18 16:08:48 version 1.25, 2015/06/09 21:22:57
Line 32  use Apache::Constants qw(:common :http); Line 32  use Apache::Constants qw(:common :http);
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::lonhtmlcommon();  use Apache::lonhtmlcommon();
 use Apache::loncommon();  use Apache::loncommon();
   use Apache::lonnavmaps();
 use Apache::lonlocal;  use Apache::lonlocal;
 use File::MMagic;  use File::MMagic;
 use CAM::PDF;  use CAM::PDF;
   use LONCAPA qw(:DEFAULT :match);
   
 use strict;  use strict;
   
Line 79  sub handler() { Line 81  sub handler() {
         }          }
     } else {      } else {
         $r->print('<p class="LC_warning">'.          $r->print('<p class="LC_warning">'.
                   &mt('Could not determine identity of this course. you may need to [_1]re-select[_2] the course.','<a href="/adm/roles">','</a>').                    &mt('Could not determine identity of this course.').' '.
                     &mt('You may need to [_1]re-select[_2] the course.','<a href="/adm/roles">','</a>').
                   '</p>'.                    '</p>'.
                   &Apache::loncommon::end_page());                    &Apache::loncommon::end_page());
         return OK;          return OK;
Line 119  sub handler() { Line 122  sub handler() {
 sub get_javascripts() {  sub get_javascripts() {
           
     my $message = &mt('Please choose a PDF-File.');      my $message = &mt('Please choose a PDF-File.');
       &js_escape(\$message);
   
     # 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
     my $result .= <<END      my $result .= <<END
   <script type="text/javascript">    <script type="text/javascript">
   // <![CDATA[
     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\$/gi);
         if(fileExt) {          if(fileExt) {
             return true;              return true;
         }          }
         alert("$message");          alert("$message");
         return false;          return false;
     }      }
   // ]]>
   </script>    </script>
 END  END
 ;  ;
Line 150  sub get_uploadform() { Line 156  sub get_uploadform() {
   
     my $result =       my $result = 
         '<br />'          '<br />'
        .'<form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);">'         .'<form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);" action="">'
        .'<input type="hidden" name="type" value="upload" />'  
        .&Apache::lonhtmlcommon::start_pick_box()         .&Apache::lonhtmlcommon::start_pick_box()
        .&Apache::lonhtmlcommon::row_headline()         .&Apache::lonhtmlcommon::row_headline()
        .'<h2>'.$lt{'title'}.'</h2>'         .'<h2>'.$lt{'title'}.'</h2>'
Line 179  sub processPDF { Line 184  sub processPDF {
         &grade_pdf(@pdfdata);          &grade_pdf(@pdfdata);
     } else {      } else {
         $result .= '<p class="LC_error">'          $result .= '<p class="LC_error">'
                   .&mt("Can't find any valid PDF formfields.")                    .&mt("Can't find any valid PDF form fields.")
                   .'</p>';                    .'</p>';
     }      }
 }  }
Line 188  sub get_pdf_data() { Line 193  sub get_pdf_data() {
     my @data = ();      my @data = ();
     my $pdf = CAM::PDF->new($env{'form.file'});      my $pdf = CAM::PDF->new($env{'form.file'});
   
     my @formFields = $pdf->getFormFieldList(); #get names of formfields      if($pdf) {
               my @formFields = $pdf->getFormFieldList(); #get names of form fields
     foreach my $field (@formFields) {  
  my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary          foreach my $field (@formFields) {
               my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get form field dictonary
   
         #              # this is necessary because CAM::PDF has a problem with form fieldnames 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
         # dot in fieldnames. So a fieldname like "i.am.aFormfield" will offer three fieldnames "i", "i.am"               # "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'}) {                  push(@data, $field."?". $dict->{'V'}{'value'}); #binding fieldname with value
             push(@data, $field."?". $dict->{'V'}{'value'}); #binding fieldname with value              }
         }          }
     }       }
     return @data;      return @data;
 }  }
   
 sub grade_pdf {  sub grade_pdf {
     my $result = ();  
     my @pdfdata = @_;      my @pdfdata = @_;
     my ($result,$meta,%grades,%problems,$debug);         my ($result,$meta,%grades,%problems,%foreigncourse,$debug);
   
       my $navmap = Apache::lonnavmaps::navmap->new();
       if (!defined($navmap)) {
           $result = '<h3>'.&mt('Verification of PDF form items failed').'</h3>'.
                     '<div class="LC_error">'.
                     &mt('Unable to retrieve information about course contents').' '.
                     &mt('You may need to [_1]re-select[_2] the course.','<a href="/adm/roles">','</a>').
                     '</div>';
           return $result;
       }
       my %restitles;
       foreach my $res ($navmap->retrieveResources()) {
           my $symb = $res->symb; 
           $restitles{$symb} = $res->compTitle();
       }
         
     $debug  .= "Found: ". scalar @pdfdata." Entries \n";      $debug  .= "Found: ". scalar @pdfdata." Entries \n";
   
Line 217  sub grade_pdf { Line 237  sub grade_pdf {
             my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/);              my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/);
             my ($domain, $user) = split('&', $value);              my ($domain, $user) = split('&', $value);
             $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 '<p class="LC_error">'                  return '<p class="LC_error">'
                       .&mt('Wrong username ([_1]) found in PDF file. Expected username: [_2]'                        .&mt('Wrong username ([_1]) found in PDF file. Expected username: [_2]'
Line 231  sub grade_pdf { Line 250  sub grade_pdf {
             my ($label, $value) = ($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);
             next unless (&Apache::lonnet::is_on_map($resource));              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/;               $value =~ s/(.*)\n/$1/; 
   
             #filter incorrect radiobuttons (Bug in CABAReT Stage)              #filter incorrect radiobuttons (Bug in CABAReT Stage)
Line 257  sub grade_pdf { Line 282  sub grade_pdf {
     }      }
     #$result .= $debug;      #$result .= $debug;
   
     $result .= '<h2>'.&mt('Results of PDF Form problems').'</h2>';      $result .= '<h3>'.&mt('Result of PDF Form upload').'</h3>';
   
     if (keys(%problems) > 0) {      if (keys(%problems) > 0) {
         $result .= &Apache::loncommon::start_data_table()          $result .= &Apache::loncommon::start_data_table()
Line 272  sub grade_pdf { Line 297  sub grade_pdf {
             my ($problemname, $grade) = &grade_problem(%problem);              my ($problemname, $grade) = &grade_problem(%problem);
   
             $result .= &Apache::loncommon::start_data_table_row();              $result .= &Apache::loncommon::start_data_table_row();
             $result .= "<td>$problemname</td><td class='";              $result .= '<td><a href="/res/'.$problem{'resource'}.
                          '?symb='.
                          &HTML::Entities::encode($problem{'symb'},'"&<>').
                          '">'.$problemname.'</a></td><td><span class="';
             if ($grade eq "EXACT_ANS" || $grade eq "APPROX_ANS") {              if ($grade eq "EXACT_ANS" || $grade eq "APPROX_ANS") {
                 $result .= "LC_answer_correct";                  $result .= 'LC_answer_correct';
             } else {               } elsif ($grade eq "DRAFT") {
                 $result .= "LC_answer_charged_try";                  $result .= 'LC_answer_not_charged_try';
               } else {
                   $result .= 'LC_answer_charged_try';
             }              }
               $result .= '">';
             $grade = &parse_grade_answer($grade);              $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 .= &Apache::loncommon::end_data_table();          $result .= &Apache::loncommon::end_data_table();
Line 288  sub grade_pdf { Line 319  sub grade_pdf {
                    &mt('As no gradable form items were found, no submissions have been recorded.').                     &mt('As no gradable form items were found, no submissions have been recorded.').
                    '</p>';                     '</p>';
     }      }
       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 .= '</li><li>';
                   }
                   $othercrsmsg .= '<b>'.$coursehash{'description'}.'</b><ul>'."\n";
                   foreach my $symb (@{$foreigncourse{$cid}}) {
                       my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb);
                       $othercrsmsg .= '<li>'.$resource.'</li>';
                   }
                   $othercrsmsg .= '</ul>';
                   $numother ++;
               }
           }
           if ($numother) {
               $result .= '<div class="LC_warning">';
               if ($numother > 1) {
                   $result .= &mt('Your uploaded PDF form contained the following resource(s) from [_1] different courses:','<b>'.$numother.'</b>')."\n".'<ul><li>'.
                              $othercrsmsg.'</li></ul>';
               } else {
                   $result .= &mt('Your uploaded PDF form contained the following resource(s) from a different course:').' '.$othercrsmsg.
                              &mt('Did you download the PDF form from another course and upload it to the wrong course?'); 
               }
               $result .= '</div>';
           }
       }
   
     return $result;              return $result;
 }  }
   
 sub grade_problem {  sub grade_problem {
Line 317  sub parse_grade_answer { Line 378  sub parse_grade_answer {
      my %answerhash = ('EXACT_ANS' => &mt('You are correct.'),       my %answerhash = ('EXACT_ANS' => &mt('You are correct.'),
                        'APPROX_ANS' => &mt('You are correct.'),                         'APPROX_ANS' => &mt('You are correct.'),
                        'INCORRECT' => &mt('You are incorrect'),                         'INCORRECT' => &mt('You are incorrect'),
                          'DRAFT' => &mt('Copy saved but not submitted.'),
      );       );
   
     foreach my $key (keys %answerhash) {      foreach my $key (keys(%answerhash)) {
         if($shortcut eq $key) {          if($shortcut eq $key) {
             return $answerhash{$shortcut};              return $answerhash{$shortcut};
         }            }  
Line 333  sub dumpenv  { Line 395  sub dumpenv  {
     my $r = shift;      my $r = shift;
   
     $r->print ("<br />-------------------<br />");      $r->print ("<br />-------------------<br />");
     foreach my $key (sort (keys %env)) {      foreach my $key (sort(keys(%env))) {
         $r->print ("<br />$key -> $env{$key}");          $r->print ("<br />$key -> $env{$key}");
     }      }
     $r->print ("<br />-------------------<br />");      $r->print ("<br />-------------------<br />");
     $r->print ("<br />-------------------<br />");      $r->print ("<br />-------------------<br />");
     foreach my $key (sort (keys %ENV)) {      foreach my $key (sort(keys(%ENV))) {
         $r->print ("<br />$key -> $ENV{$key}");          $r->print ("<br />$key -> $ENV{$key}");
     }      }
     $r->print ("<br />-------------------<br />");      $r->print ("<br />-------------------<br />");
Removed from v.1.17  
changed lines
  Added in v.1.25

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