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

# The LearningOnline Network with CAPA
# Publication Handler
#
# $Id: lonpdfupload.pm,v 1.2 2009/04/03 15:40:17 onken Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
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::loncommon();
use Apache::lonlocal;
use Apache::lonmsg();
use Apache::lonhomework;
use LONCAPA::Enrollment;
use LONCAPA::Configuration;
use CAM::PDF;

use strict;

sub handler() {
    my $r = shift;

    # check user permissions 
    if(!&checkpermission($r)) {
        # stop processing 
        return OK;
    }

    $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'));

    #load post data into environment
    &Apache::lonacc::get_posted_cgi($r);

    # if a file was upload
    if($env{'form.Uploaded'} && $env{'form.file'}) {
        $r->print(&processPDF);
    } else { 
        # print upload form
        $r->print(&get_javascripts);
        $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("  </body> \n</html>\n");
    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');

    # 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">
    function checkFilename(form) {
        var fileExt = form.file.value;
        fileExt = fileExt.match(/[.]pdf\$/g);
        if(fileExt) {
            return true;
        }
        alert("$message");
        return false;
    }
  </script>
END
;
    return $result; 
}


sub get_uploadform() {
    my $result = <<END
    <p height='25'> 
    </p>
    <form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);">
      <input type="hidden" name="type" value="upload">
      <div align="center">
        <table bgcolor="#000000" width="450" cellspacing="0" cellpadding="0" border="0">
          <tr>
            <td>
              <table cellspacing="1" cellpadding="2" border="0" width="100%">
                <tr>
                  <td colspan="2" bgcolor="#99EEEE">
                    <b>PDF-Formular einsenden</b>
                  </td>
                </tr>
                <tr>
                  <td bgcolor="#F8F8F8">
                      Datei ausw&auml;hlen
                  </td>
                  <td bgcolor="#F8F8F8">
                    <input type="file" name="file" id="filename">
                  </td>
                </tr>
                <tr>
                  <td bgcolor="#F8F8F8" colspan="2" align="right" style="margin-right: 30px;">
                    <input type="submit" name="Uploaded" value="Absenden" >
                  </td>
                </tr>
                </table>
              </td>
           </tr>
        </table>
      </div>
    </form>    
END
;
  return $result;
}

sub processPDF {
    my $result = ();  # message for Browser
    my @pdfdata = (); # answers from PDF-Forms
    
    @pdfdata = &get_pdf_data(); # get answers from PDF-Form
    
    if (scalar @pdfdata) {    
        &grade_pdf(@pdfdata);
    } else {
        $result .= "<h2>".&mt("Can't find any valid PDF-formfields")."</h2>";
    }
}

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

        #
        # 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
        }
    } 
    return @data;
}

sub grade_pdf {
    my $result = ();
    my @pdfdata = @_;
   
    my $meta = ();
    my %grades = ();
    my %problems = ();
        
    my $debug = ();

    $debug  .= "Found: ". scalar @pdfdata." Entries \n";
    $result .= "<table width='80%'>\n";
    foreach my $entry (sort(@pdfdata)) {
        if ($entry =~ /^meta.*/) {
            $debug .= 'found: metadata -> '.$entry . "<br />";
            my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/);
            my ($domain, $user) = split('&', $value);
            $user =~ s/(.*)\n/$1/; #TODO find an other way
            
            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>";    
            }

        } 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);  
            $value =~ s/(.*)\n/$1/; 

            #fehlerhafte Radiobuttons rausfiltern (Bug in CABAReT Stage)
            if($type eq 'radiobuttonresponse' && $value eq 'Off' ) {
                next;
            }
 
            my $submit = $part;
            $submit =~ s/part_(.*)/submit_$1/;
            if($problems{$symb.$part}) {
                 $problems{$symb.$part}{$HWVAL} = $value;
            } else {
                 $problems{$symb.$part} =  { 'resource' => $resource,
                                        'symb' => $symb,
                                        'submitted' => $part,
                                        $submit => 'Answer',
                                        $HWVAL => $value};
            }
        } else {
            $debug .= 'found: -> '.$entry;
            next;
        }
    }
    $result .= $debug;

    foreach my $key (sort (keys %problems)) {
        my %problem = %{$problems{$key}};
        my ($problemname, $grade) = &grade_problem(%problem);
        $result .= "<tr style='background-color: #EEF5F5;'><td>$problemname</td><td style='background-color: ";
        if($grade eq "EXACT_ANS") {
            $result .= "#DDFFDD";
        } else { 
            $result .= "#DD5555";
        }
        $result .= "'>$grade</td></tr>";

    }
    $result .= "\n</table>";

    return $result;        
}

sub grade_problem {
    my %problem = @_;

    my ($content) =  &Apache::loncommon::ssi_with_retries('/res/'.
            $problem{'resource'}, 5, %problem);

    $content =~ s/.*class="LC_current_location".*>(.*)<\/td>.*/$1/g;
    $content = $1;

    my $part = $problem{submitted};
    $part =~ s/part_(.*)/$1/;
    $content .= " - Part $part";
 
    my %problemhash = &Apache::lonnet::restore($problem{'symb'});
    my $grade = $problemhash{"resource.$part.award"};

    return ($content, $grade);    
}

sub dumpenv  {
    my $r = shift;

    $r->print ("<br />-------------------<br />");
    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)) {
        $r->print ("<br />$key -> $ENV{$key}");
    }
    $r->print ("<br />-------------------<br />");
    
}	

1;
__END__