[LON-CAPA-cvs] cvs: loncom /interface lonpdfupload.pm
onken
lon-capa-cvs-allow@mail.lon-capa.org
Tue, 09 Sep 2008 13:56:44 -0000
This is a MIME encoded message
--onken1220968604
Content-Type: text/plain
onken Tue Sep 9 09:56:44 2008 EDT
Added files:
/loncom/interface lonpdfupload.pm
Log:
Uploadscript for PDF-Forms
Comments are current in german
--onken1220968604
Content-Type: text/plain
Content-Disposition: attachment; filename="onken-20080909095644.txt"
Index: loncom/interface/lonpdfupload.pm
+++ loncom/interface/lonpdfupload.pm
# The LearningOnline Network with CAPA
# Publication Handler
#
# $Id: lonpdfupload.pm,v 1.1 2008/09/09 13:56:44 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 strict;
sub handler() {
my $r = shift;
#Testen ob der Benutzer ein gültiges Cookie besitzt
if(!&checkpermission($r)) {
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'));
#lade die per POST gesendenten daten in env
&Apache::lonacc::get_posted_cgi($r);
if($env{'form.Uploaded'} && $env{'form.file'}) {
#Upload-Formular wurde gesendet
$r->print(&processPDF);
} else {
#erster Aufruf Upload-Formular wird ausgeben
$r->print(&get_javascripts);
$r->print(&get_uploadform);
}
#&dumpenv($r); #debug -> prints the environment
$r->print("<br /><a href='/adm/navmaps'>".&mt("Navigate Contents")."</a><br />");
$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 $result = ' <script type="text/javascript">';
# JavaScript prüft die Datei Endung der hochzuladenden Datei
$result .= <<END
function checkFilename(form) {
var fileExt = form.file.value;
fileExt = fileExt.match(/[.]pdf\$/g);
if(fileExt) {
return true;
}
alert("Bitte geben Sie nur ein PDF an.")
return false;
}
END
;
$result .= " </script>";
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ä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 = ();
my @pdfdata = ();
@pdfdata = &get_pdf_data;
if (scalar @pdfdata) {
$result .= &grade_pdf(@pdfdata);
} else {
$result .= "<h2>".&mt("reading PDF-formfields: failed")."</h2>";
}
}
sub get_pdf_data() {
my @data = ();
my $file_path = "/home/httpd/pdfspool/".time."_".
int(rand(100000)).".pdf";
my $file_data = $file_path;
$file_data =~ s/(.*)\..*/$1.data/;
# zwischenspeichern der hochgeladenen PDF
my $temp_file = Apache::File->new('>'.$file_path);
binmode($temp_file);
print $temp_file $env{'form.file'};
$temp_file->close;
#Java PDF-Auslese-Programm starten
my @command = ("java", "-jar",
"/home/httpd/pdfspool/dumpPDF.jar",
$file_path, $file_data);
system(@command);
#Einlesen der extrahierten Daten
$temp_file = new IO::File->new('<'.$file_data);
while (defined (my $line = $temp_file->getline())) {
push(@data, $line);
}
$temp_file->close;
undef($temp_file);
#zwischengespeicherte Dateien loeschen
if( -e $file_path) {
# unlink($file_path);
}
if( -e $file_data) {
# unlink($file_data);
}
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;
my ($label, $value) = split('\?', $entry);
my ($domain, $user) = split('&', $value);
$user =~ s/(.*)\n/$1/;
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) = split('\?', $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__
--onken1220968604--