Return to lonpdfupload.pm CVS log

Up to [LON-CAPA] / loncom / interface

Upgrade for PDF-Forms.

Now only perl is used to read out PDF-Formdata. Before you copy lonpdfupload.pm in to your Apache-folder check the needed Steps below.

----------

Enable PDF-Forms in LON-CAPA

First you need to install the AcroTeX-education bundle from ctan.

Get the package and unzip it:

    [root@loncapa ]# wget http://tug.ctan.org/get/macros/latex/contrib/acrotex.zip
    [root@loncapa ]# unzip acrotex.zip

go into the acrotex-folder and install

    [root@loncapa ]# cd acrotex
    [root@loncapa acrotex]# latex acrotex.ins

Now move the folder acrotex file into the latex path. You can easy find it by searching for "cite.sty" or some other tex-packages.

    [root@loncapa /]# locate cite.sty
    /usr/share/texmf/tex/latex/cite/cite.sty
    /usr/share/texmf/tex/latex/cite/drftcite.sty
    /usr/share/texmf/tex/latex/cite/overcite.sty
    On CentOS the latex path is: /usr/share/texmf/tex/latex/ (perhaps there is different to

    [root@loncapa acrotex]# cd ..
    [root@loncapa ]# mv acrotex /usr/share/texmf/tex/latex/

Remove the acrotex.zip

    [root@loncapa]# rm acrotex.zip

After that you must rehash tex:

    [root@loncapa ]# texhash

Now you are able to print PDF with Forms (Radiobutton-, Comboboxes-, Textfield based problems).

The second thing to do is to enable the Upload-script lonpdfupload.pm. Before you can use it you have to install CAM::PDF for perl. It is available on CPAN so you can use the perl –MCPAN -eshell.

    [root@loncapa ~]# perl -MCPAN -eshell

    cpan shell -- CPAN exploration and modules installation (v1.7602)
    ReadLine support enabled

    cpan>install CAM::PDF
    (…follow installation and also install the dependencies)
    cpan>exit

Next you need to copy the upload-script from CVS to the LON-CAPA Apache folder.

    [root@loncapa ~]# cp [your-cvs-folder]/loncom/interface/lonpdfupload.pm /home/httpd/lib/perl/Apache/

Now restart httpd:
    [root@loncapa ~]# /etc/init.d/httpd restart

    1: # The LearningOnline Network with CAPA
    2: # Publication Handler
    3: #
    4: # $Id: lonpdfupload.pm,v 1.2 2009/04/03 15:40:17 onken Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: package Apache::lonpdfupload;
   29: 
   30: use lib '/home/httpd/lib/perl';
   31: use Apache::Constants qw(:common :http);
   32: use LONCAPA;
   33: use LONCAPA::loncgi;
   34: use File::Path;
   35: use File::Basename;
   36: use File::Copy;
   37: use IO::File;
   38: use Image::Magick;
   39: use Apache::lonacc;
   40: use Apache::lonxml;
   41: use Apache::lonhtmlcommon();
   42: use Apache::lonnet;
   43: use Apache::loncommon();
   44: use Apache::lonlocal;
   45: use Apache::lonmsg();
   46: use Apache::lonhomework;
   47: use LONCAPA::Enrollment;
   48: use LONCAPA::Configuration;
   49: use CAM::PDF;
   50: 
   51: use strict;
   52: 
   53: sub handler() {
   54:     my $r = shift;
   55: 
   56:     # check user permissions 
   57:     if(!&checkpermission($r)) {
   58:         # stop processing 
   59:         return OK;
   60:     }
   61: 
   62:     $Apache::lonxml::request=$r;
   63:     $Apache::lonxml::debug=$env{'user.debug'};
   64: 
   65:     $env{'request.uri'}=$r->uri;
   66:     $r->content_type('text/html');
   67:     $r->send_http_header();
   68:     $r->print(&Apache::loncommon::start_page('Upload-PDF-Form'));
   69: 
   70:     #load post data into environment
   71:     &Apache::lonacc::get_posted_cgi($r);
   72: 
   73:     # if a file was upload
   74:     if($env{'form.Uploaded'} && $env{'form.file'}) {
   75:         $r->print(&processPDF);
   76:     } else { 
   77:         # print upload form
   78:         $r->print(&get_javascripts);
   79:         $r->print(&get_uploadform);
   80:     }
   81: 
   82:     #link to course-content
   83:     $r->print("    <br />\n    <a href='/adm/navmaps'>\n      ".&mt("Navigate Contents")."\n    </a>\n    <br />");
   84: 
   85:     #&dumpenv($r); #debug -> prints the environment
   86:     $r->print("  </body> \n</html>\n");
   87:     return OK;
   88: }
   89: 
   90: 
   91: sub checkpermission() {
   92:     my $r = shift;
   93:     if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
   94:         my $result  = <<END
   95: Content-type: text/html
   96: 
   97: <html>
   98:   <head>
   99:     <title>
  100:       Bad Cookie
  101:     </title>
  102:   </head>
  103:   <body>
  104:     Your cookie information is incorrect.
  105:   </body>
  106: </html>
  107: END
  108: ;
  109:         $r->print($result);
  110:         return 0;
  111:     } else {
  112:         return 1;
  113:     }
  114: }
  115: 
  116: 
  117: sub get_javascripts() {
  118:     
  119:     my $message = &mt('Please choose a PDF-File');
  120: 
  121:     # simple test if the upload ends with ".pdf"
  122:     # it's only for giving a message to the user
  123:     my $result .= <<END
  124:   <script type="text/javascript">
  125:     function checkFilename(form) {
  126:         var fileExt = form.file.value;
  127:         fileExt = fileExt.match(/[.]pdf\$/g);
  128:         if(fileExt) {
  129:             return true;
  130:         }
  131:         alert("$message");
  132:         return false;
  133:     }
  134:   </script>
  135: END
  136: ;
  137:     return $result; 
  138: }
  139: 
  140: 
  141: sub get_uploadform() {
  142:     my $result = <<END
  143:     <p height='25'> 
  144:     </p>
  145:     <form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);">
  146:       <input type="hidden" name="type" value="upload">
  147:       <div align="center">
  148:         <table bgcolor="#000000" width="450" cellspacing="0" cellpadding="0" border="0">
  149:           <tr>
  150:             <td>
  151:               <table cellspacing="1" cellpadding="2" border="0" width="100%">
  152:                 <tr>
  153:                   <td colspan="2" bgcolor="#99EEEE">
  154:                     <b>PDF-Formular einsenden</b>
  155:                   </td>
  156:                 </tr>
  157:                 <tr>
  158:                   <td bgcolor="#F8F8F8">
  159:                       Datei ausw&auml;hlen
  160:                   </td>
  161:                   <td bgcolor="#F8F8F8">
  162:                     <input type="file" name="file" id="filename">
  163:                   </td>
  164:                 </tr>
  165:                 <tr>
  166:                   <td bgcolor="#F8F8F8" colspan="2" align="right" style="margin-right: 30px;">
  167:                     <input type="submit" name="Uploaded" value="Absenden" >
  168:                   </td>
  169:                 </tr>
  170:                 </table>
  171:               </td>
  172:            </tr>
  173:         </table>
  174:       </div>
  175:     </form>    
  176: END
  177: ;
  178:   return $result;
  179: }
  180: 
  181: sub processPDF {
  182:     my $result = ();  # message for Browser
  183:     my @pdfdata = (); # answers from PDF-Forms
  184:     
  185:     @pdfdata = &get_pdf_data(); # get answers from PDF-Form
  186:     
  187:     if (scalar @pdfdata) {    
  188:         &grade_pdf(@pdfdata);
  189:     } else {
  190:         $result .= "<h2>".&mt("Can't find any valid PDF-formfields")."</h2>";
  191:     }
  192: }
  193: 
  194: sub get_pdf_data() {
  195:     my @data = ();
  196:     my $pdf = CAM::PDF->new($env{'form.file'});
  197: 
  198:     my @formFields = $pdf->getFormFieldList(); #get names of formfields
  199:     
  200:     foreach my $field (@formFields) {
  201: 	my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary
  202: 
  203:         #
  204:         # this is nessesary 'cause CAM::PDF has a problem with formfieldnames which include a
  205:         # dot in fieldnames. So a fieldname like "i.am.aFormfield" will offer three fieldnames "i", "i.am" 
  206:         # and "i.am.aFormfield". The fragmentary names keep no values and will be ignored.
  207:         if($dict->{'V'}) {
  208:             push(@data, $field."?". $dict->{'V'}{'value'}); #binding fieldname with value
  209:         }
  210:     } 
  211:     return @data;
  212: }
  213: 
  214: sub grade_pdf {
  215:     my $result = ();
  216:     my @pdfdata = @_;
  217:    
  218:     my $meta = ();
  219:     my %grades = ();
  220:     my %problems = ();
  221:         
  222:     my $debug = ();
  223: 
  224:     $debug  .= "Found: ". scalar @pdfdata." Entries \n";
  225:     $result .= "<table width='80%'>\n";
  226:     foreach my $entry (sort(@pdfdata)) {
  227:         if ($entry =~ /^meta.*/) {
  228:             $debug .= 'found: metadata -> '.$entry . "<br />";
  229:             my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/);
  230:             my ($domain, $user) = split('&', $value);
  231:             $user =~ s/(.*)\n/$1/; #TODO find an other way
  232:             
  233:             if($user ne $env{'user.name'} or  $domain ne $env{'user.domain'}) {
  234:                 return "<pre>".&mt('Wrong username in PDF-File').": $user $domain -> $env{'user.domain'} $env{'user.name'} </pre>";    
  235:             }
  236: 
  237:         } elsif($entry =~ /^upload.*/)  {
  238:             $debug .= 'found: a problem -> '.$entry;
  239:             my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/);
  240:             my ($symb, $part, $type, $HWVAL) = split('&', $label);
  241:             my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb);  
  242:             $value =~ s/(.*)\n/$1/; 
  243: 
  244:             #fehlerhafte Radiobuttons rausfiltern (Bug in CABAReT Stage)
  245:             if($type eq 'radiobuttonresponse' && $value eq 'Off' ) {
  246:                 next;
  247:             }
  248:  
  249:             my $submit = $part;
  250:             $submit =~ s/part_(.*)/submit_$1/;
  251:             if($problems{$symb.$part}) {
  252:                  $problems{$symb.$part}{$HWVAL} = $value;
  253:             } else {
  254:                  $problems{$symb.$part} =  { 'resource' => $resource,
  255:                                         'symb' => $symb,
  256:                                         'submitted' => $part,
  257:                                         $submit => 'Answer',
  258:                                         $HWVAL => $value};
  259:             }
  260:         } else {
  261:             $debug .= 'found: -> '.$entry;
  262:             next;
  263:         }
  264:     }
  265:     $result .= $debug;
  266: 
  267:     foreach my $key (sort (keys %problems)) {
  268:         my %problem = %{$problems{$key}};
  269:         my ($problemname, $grade) = &grade_problem(%problem);
  270:         $result .= "<tr style='background-color: #EEF5F5;'><td>$problemname</td><td style='background-color: ";
  271:         if($grade eq "EXACT_ANS") {
  272:             $result .= "#DDFFDD";
  273:         } else { 
  274:             $result .= "#DD5555";
  275:         }
  276:         $result .= "'>$grade</td></tr>";
  277: 
  278:     }
  279:     $result .= "\n</table>";
  280: 
  281:     return $result;        
  282: }
  283: 
  284: sub grade_problem {
  285:     my %problem = @_;
  286: 
  287:     my ($content) =  &Apache::loncommon::ssi_with_retries('/res/'.
  288:             $problem{'resource'}, 5, %problem);
  289: 
  290:     $content =~ s/.*class="LC_current_location".*>(.*)<\/td>.*/$1/g;
  291:     $content = $1;
  292: 
  293:     my $part = $problem{submitted};
  294:     $part =~ s/part_(.*)/$1/;
  295:     $content .= " - Part $part";
  296:  
  297:     my %problemhash = &Apache::lonnet::restore($problem{'symb'});
  298:     my $grade = $problemhash{"resource.$part.award"};
  299: 
  300:     return ($content, $grade);    
  301: }
  302: 
  303: sub dumpenv  {
  304:     my $r = shift;
  305: 
  306:     $r->print ("<br />-------------------<br />");
  307:     foreach my $key (sort (keys %env)) {
  308:         $r->print ("<br />$key -> $env{$key}");
  309:     }
  310:     $r->print ("<br />-------------------<br />");
  311:     $r->print ("<br />-------------------<br />");
  312:     foreach my $key (sort (keys %ENV)) {
  313:         $r->print ("<br />$key -> $ENV{$key}");
  314:     }
  315:     $r->print ("<br />-------------------<br />");
  316:     
  317: }	
  318: 
  319: 1;
  320: __END__
  321: