--- loncom/interface/lonpdfupload.pm	2009/05/15 17:53:06	1.4
+++ loncom/interface/lonpdfupload.pm	2015/06/09 21:22:57	1.25
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
-# Publication Handler
+# PDF Form Upload Handler
 #
-# $Id: lonpdfupload.pm,v 1.4 2009/05/15 17:53:06 onken Exp $
+# $Id: lonpdfupload.pm,v 1.25 2015/06/09 21:22:57 damieng Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -29,50 +29,76 @@ package Apache::lonpdfupload;
 
 use lib '/home/httpd/lib/perl';
 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::lonhtmlcommon();
 use Apache::loncommon();
+use Apache::lonnavmaps();
 use Apache::lonlocal;
-use Apache::lonmsg();
-use Apache::lonhomework;
-use LONCAPA::Enrollment;
-use LONCAPA::Configuration;
+use File::MMagic;
 use CAM::PDF;
+use LONCAPA qw(:DEFAULT :match);
 
 use strict;
 
 sub handler() {
     my $r = shift;
-
-    # check user permissions 
-    if(!&checkpermission($r)) {
-        # stop processing 
-        return OK;
+    &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;
     }
 
-    $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'));
+    # Breadcrumbs
+    my $brcrum = [{'href' => '/adm/pdfupload',
+                   'text' => 'Upload PDF Form'}];
+    if ($env{'form.Uploaded'} && $env{'form.file'}) {
+        push(@{$brcrum},{'href'  => '',
+                         'text'  => 'PDF upload result'});
+    }
 
-    #load post data into environment
-    &Apache::lonacc::get_posted_cgi($r);
+    $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('<p class="LC_warning">'.
+                      &mt('Upload of PDF forms is not permitted for this course.').
+                      '</p>'.
+                      &Apache::loncommon::end_page());
+            return OK;
+        }
+    } else {
+        $r->print('<p class="LC_warning">'.
+                  &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>'.
+                  &Apache::loncommon::end_page());
+        return OK;
+    }
 
     # if a file was upload
     if($env{'form.Uploaded'} && $env{'form.file'}) {
-        $r->print(&processPDF);
+        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('<p class="LC_error">'
+                     .&mt("The uploaded file does not appear to be a PDF file.")
+                     .'</p>');
+        }
     } else { 
         # print upload form
         $r->print(&get_javascripts);
@@ -80,57 +106,39 @@ sub handler() {
     }
 
     #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
-    $r->print("  </body> \n</html>\n");
+    $r->print(&Apache::loncommon::end_page());
     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() {
     
-    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"
     # it's only for giving a message to the user
     my $result .= <<END
   <script type="text/javascript">
+// <![CDATA[
     function checkFilename(form) {
         var fileExt = form.file.value;
-        fileExt = fileExt.match(/[.]pdf\$/g);
+        fileExt = fileExt.match(/[.]pdf\$/gi);
         if(fileExt) {
             return true;
         }
         alert("$message");
         return false;
     }
+// ]]>
   </script>
 END
 ;
@@ -140,37 +148,29 @@ END
 
 sub get_uploadform() {
     
-    #TODO use LON-CAPA routines like pick_box or like that  
     my %lt = &Apache::lonlocal::texthash(
-                 'title'=>'Submit a PDF-Form with problems', 
-                 'chFile' => 'Choose file:',
-                 'submit'=>'Submit'
+                 'title'  => 'Upload a PDF Form with filled Form Fields', 
+                 'chFile' => 'File',
+                 'submit' => 'Upload',
              );
 
-    my $result = <<END
-    <form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);">
-      <input type="hidden" name="type" value="upload" />
-      <br />
-      <b>$lt{'title'}</b>
-      <table class="LC_pick_box"> 
-        <tbody>
-          <tr class="LC_pick_box_row">
-            <td class="LC_pick_box_title">
-              $lt{'chFile'}
-            </td>
-            <td class="LC_pick_box_value LC_odd_row">
-              <input type="file" name="file" id="filename" />
-            </td>
-          </tr>
-        </tbody>
-      </table>
-      <br />
-      <input type="submit" name="Uploaded" value="$lt{'submit'}" />
-    </form>
-    <br />
-    <hr />    
-END
-;
+    my $result = 
+        '<br />'
+       .'<form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);" action="">'
+       .&Apache::lonhtmlcommon::start_pick_box()
+       .&Apache::lonhtmlcommon::row_headline()
+       .'<h2>'.$lt{'title'}.'</h2>'
+       .&Apache::lonhtmlcommon::row_closure()
+       .&Apache::lonhtmlcommon::row_title($lt{'chFile'})
+       .'<input type="file" name="file" id="filename" />'
+       .&Apache::lonhtmlcommon::row_closure(1)
+       .&Apache::lonhtmlcommon::end_pick_box()
+       .'<p>'
+       .'<input type="submit" name="Uploaded" value="'.$lt{'submit'}.'" />'
+       .'</p>'
+       .'</form>'
+       .'<br />';
+
   return $result;
 }
 
@@ -183,7 +183,9 @@ sub processPDF {
     if (scalar @pdfdata) {    
         &grade_pdf(@pdfdata);
     } else {
-        $result .= "<h2>".&mt("Can't find any valid PDF-formfields")."</h2>";
+        $result .= '<p class="LC_error">'
+                  .&mt("Can't find any valid PDF form fields.")
+                  .'</p>';
     }
 }
 
@@ -191,38 +193,43 @@ sub get_pdf_data() {
     my @data = ();
     my $pdf = CAM::PDF->new($env{'form.file'});
 
-    my @formFields = $pdf->getFormFieldList(); #get names of formfields
-    
-    foreach my $field (@formFields) {
-	my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary
+    if($pdf) {
+        my @formFields = $pdf->getFormFieldList(); #get names of form fields
 
-        #
-        # 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
+        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
+            # 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 $result = ();
     my @pdfdata = @_;
-   
-    my $meta = ();
-    my %grades = ();
-    my %problems = ();
-        
-    my $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";
-    $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)) {
         if ($entry =~ /^meta.*/) {
@@ -230,30 +237,40 @@ sub grade_pdf {
             my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/);
             my ($domain, $user) = split('&', $value);
             $user =~ s/(.*)\n/$1/; #TODO is that equals to chomp?
-            
             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.*/)  {
             $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);  
+            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/; 
 
-            #fehlerhafte Radiobuttons rausfiltern (Bug in CABAReT Stage)
-            if($type eq 'radiobuttonresponse' && $value eq 'Off' ) {
+            #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}) {
+            if ($problems{$symb.$part}) {
                  $problems{$symb.$part}{$HWVAL} = $value;
             } else {
                  $problems{$symb.$part} =  { 'resource' => $resource,
-                                        'symb' => &Apache::lonenc::encrypted($symb),
+                                        'symb' => $symb,
                                         'submitted' => $part,
                                         $submit => 'Answer',
                                         $HWVAL => $value};
@@ -265,60 +282,125 @@ sub grade_pdf {
     }
     #$result .= $debug;
 
-    foreach my $key (sort (keys %problems)) {
-        my %problem = %{$problems{$key}};
-        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 .= "<td>$problemname</td><td class='";
-        if($grade eq "EXACT_ANS") {
-            $result .= "LC_answer_correct";
-        } else { 
-            $result .= "LC_answer_charged_try";
+    $result .= '<h3>'.&mt('Result of PDF Form upload').'</h3>';
+
+    if (keys(%problems) > 0) {
+        $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))) {
+            my %problem = %{$problems{$key}};
+            my ($problemname, $grade) = &grade_problem(%problem);
+
+            $result .= &Apache::loncommon::start_data_table_row();
+            $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") {
+                $result .= 'LC_answer_correct';
+            } elsif ($grade eq "DRAFT") {
+                $result .= 'LC_answer_not_charged_try';
+            } else {
+                $result .= 'LC_answer_charged_try';
+            }
+            $result .= '">';
+            $grade = &parse_grade_answer($grade);
+            $result .= $grade.'</span></td>';
+            $result .= &Apache::loncommon::end_data_table_row();
+        }
+        $result .= &Apache::loncommon::end_data_table();
+    } else {
+        $result .= '<p class="LC_warning">'.
+                   &mt('As no gradable form items were found, no submissions have been recorded.').
+                   '</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>';
         }
-        $result .= "'>$grade</span></td>";
-        $result .= &Apache::loncommon::end_data_table_row();
     }
-    #$result .= "\n</table>";
-    $result .= &Apache::loncommon::end_data_table();
-
 
-    return $result;        
+    return $result;
 }
 
 sub grade_problem {
     my %problem = @_;
+    my ($title, $part) = ();
 
-    my ($content) =  &Apache::loncommon::ssi_with_retries('/res/'.
-            $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;
+    &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'),
+                       'DRAFT' => &mt('Copy saved but not submitted.'),
+     );
+
+    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;
 
     $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 />-------------------<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 />-------------------<br />");