Annotation of loncom/interface/lonpdfupload.pm, revision 1.1
1.1 ! onken 1: # The LearningOnline Network with CAPA
! 2: # Publication Handler
! 3: #
! 4: # $Id: lonpdfupload.pm,v 1.0 2008/09/09 18:11:19 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:
! 50: use strict;
! 51:
! 52: sub handler() {
! 53: my $r = shift;
! 54:
! 55: #Testen ob der Benutzer ein gültiges Cookie besitzt
! 56: if(!&checkpermission($r)) {
! 57: return OK;
! 58: }
! 59:
! 60: $Apache::lonxml::request=$r;
! 61: $Apache::lonxml::debug=$env{'user.debug'};
! 62: $env{'request.uri'}=$r->uri;
! 63:
! 64: $r->content_type('text/html');
! 65: $r->send_http_header();
! 66: $r->print(&Apache::loncommon::start_page('Upload-PDF-Form'));
! 67:
! 68: #lade die per POST gesendenten daten in env
! 69: &Apache::lonacc::get_posted_cgi($r);
! 70:
! 71: if($env{'form.Uploaded'} && $env{'form.file'}) {
! 72: #Upload-Formular wurde gesendet
! 73: $r->print(&processPDF);
! 74:
! 75: } else {
! 76: #erster Aufruf Upload-Formular wird ausgeben
! 77: $r->print(&get_javascripts);
! 78: $r->print(&get_uploadform);
! 79:
! 80: }
! 81:
! 82: #&dumpenv($r); #debug -> prints the environment
! 83: $r->print("<br /><a href='/adm/navmaps'>".&mt("Navigate Contents")."</a><br />");
! 84: $r->print(" </body>\n</html>\n");
! 85: return OK;
! 86: }
! 87:
! 88: sub checkpermission() {
! 89: my $r = shift;
! 90: if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
! 91: my $result = <<END
! 92: Content-type: text/html
! 93:
! 94: <html>
! 95: <head><title>Bad Cookie</title></head>
! 96: <body>
! 97: Your cookie information is incorrect.
! 98: </body>
! 99: </html>
! 100: END
! 101: ;
! 102: $r->print($result);
! 103: return 0;
! 104: } else {
! 105: return 1;
! 106: }
! 107: }
! 108:
! 109:
! 110: sub get_javascripts() {
! 111: my $result = ' <script type="text/javascript">';
! 112:
! 113: # JavaScript prüft die Datei Endung der hochzuladenden Datei
! 114: $result .= <<END
! 115: function checkFilename(form) {
! 116: var fileExt = form.file.value;
! 117: fileExt = fileExt.match(/[.]pdf\$/g);
! 118: if(fileExt) {
! 119: return true;
! 120: }
! 121: alert("Bitte geben Sie nur ein PDF an.")
! 122: return false;
! 123: }
! 124: END
! 125: ;
! 126: $result .= " </script>";
! 127: return $result;
! 128: }
! 129:
! 130: sub get_uploadform() {
! 131: my $result = <<END
! 132: <p height='25'>
! 133: </p>
! 134: <form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);">
! 135: <input type="hidden" name="type" value="upload">
! 136: <div align="center">
! 137: <table bgcolor="#000000" width="450" cellspacing="0" cellpadding="0" border="0">
! 138: <tr>
! 139: <td>
! 140: <table cellspacing="1" cellpadding="2" border="0" width="100%">
! 141: <tr>
! 142: <td colspan="2" bgcolor="#99EEEE">
! 143: <b>PDF-Formular einsenden</b>
! 144: </td>
! 145: </tr>
! 146: <tr>
! 147: <td bgcolor="#F8F8F8">
! 148: Datei auswählen
! 149: </td>
! 150: <td bgcolor="#F8F8F8">
! 151: <input type="file" name="file" id="filename">
! 152: </td>
! 153: </tr>
! 154: <tr>
! 155: <td bgcolor="#F8F8F8" colspan="2" align="right" style="margin-right: 30px;">
! 156: <input type="submit" name="Uploaded" value="Absenden" >
! 157: </td>
! 158: </tr>
! 159: </table>
! 160: </td>
! 161: </tr>
! 162: </table>
! 163: </div>
! 164: </form>
! 165: END
! 166: ;
! 167: return $result;
! 168: }
! 169:
! 170: sub processPDF {
! 171: my $result = ();
! 172: my @pdfdata = ();
! 173:
! 174: @pdfdata = &get_pdf_data;
! 175:
! 176: if (scalar @pdfdata) {
! 177: $result .= &grade_pdf(@pdfdata);
! 178: } else {
! 179: $result .= "<h2>".&mt("reading PDF-formfields: failed")."</h2>";
! 180: }
! 181: }
! 182:
! 183: sub get_pdf_data() {
! 184: my @data = ();
! 185: my $file_path = "/home/httpd/pdfspool/".time."_".
! 186: int(rand(100000)).".pdf";
! 187: my $file_data = $file_path;
! 188: $file_data =~ s/(.*)\..*/$1.data/;
! 189:
! 190: # zwischenspeichern der hochgeladenen PDF
! 191: my $temp_file = Apache::File->new('>'.$file_path);
! 192: binmode($temp_file);
! 193: print $temp_file $env{'form.file'};
! 194: $temp_file->close;
! 195:
! 196: #Java PDF-Auslese-Programm starten
! 197: my @command = ("java", "-jar",
! 198: "/home/httpd/pdfspool/dumpPDF.jar",
! 199: $file_path, $file_data);
! 200: system(@command);
! 201:
! 202:
! 203: #Einlesen der extrahierten Daten
! 204: $temp_file = new IO::File->new('<'.$file_data);
! 205: while (defined (my $line = $temp_file->getline())) {
! 206: push(@data, $line);
! 207: }
! 208: $temp_file->close;
! 209: undef($temp_file);
! 210:
! 211: #zwischengespeicherte Dateien loeschen
! 212: if( -e $file_path) {
! 213: # unlink($file_path);
! 214: }
! 215: if( -e $file_data) {
! 216: # unlink($file_data);
! 217: }
! 218: return @data;
! 219: }
! 220:
! 221: sub grade_pdf {
! 222: my $result = ();
! 223: my @pdfdata = @_;
! 224:
! 225: my $meta = ();
! 226: my %grades = ();
! 227: my %problems = ();
! 228:
! 229: my $debug = ();
! 230:
! 231: $debug .= "Found: ". scalar @pdfdata." Entries \n";
! 232: $result .= "<table width='80%'>\n";
! 233: foreach my $entry (sort(@pdfdata)) {
! 234: if ($entry =~ /^meta.*/) {
! 235: $debug .= 'found: metadata -> '.$entry;
! 236: my ($label, $value) = split('\?', $entry);
! 237: my ($domain, $user) = split('&', $value);
! 238: $user =~ s/(.*)\n/$1/;
! 239:
! 240: if($user ne $env{'user.name'} or $domain ne $env{'user.domain'}) {
! 241: return "<pre>".&mt('Wrong username in PDF-File').": $user $domain -> $env{'user.domain'} $env{'user.name'} </pre>";
! 242: }
! 243:
! 244: } elsif($entry =~ /^upload.*/) {
! 245: $debug .= 'found: a problem -> '.$entry;
! 246: my ($label, $value) = split('\?', $entry);
! 247: my ($symb, $part, $type, $HWVAL) = split('&', $label);
! 248: my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb);
! 249: $value =~ s/(.*)\n/$1/;
! 250:
! 251: #fehlerhafte Radiobuttons rausfiltern (Bug in CABAReT Stage)
! 252: if($type eq 'radiobuttonresponse' && $value eq 'Off' ) {
! 253: next;
! 254: }
! 255:
! 256: my $submit = $part;
! 257: $submit =~ s/part_(.*)/submit_$1/;
! 258: if($problems{$symb.$part}) {
! 259: $problems{$symb.$part}{$HWVAL} = $value;
! 260: } else {
! 261: $problems{$symb.$part} = { 'resource' => $resource,
! 262: 'symb' => $symb,
! 263: 'submitted' => $part,
! 264: $submit => 'Answer',
! 265: $HWVAL => $value};
! 266: }
! 267: } else {
! 268: $debug .= 'found: -> '.$entry;
! 269: next;
! 270: }
! 271: #$result = $debug;
! 272: }
! 273:
! 274: foreach my $key (sort (keys %problems)) {
! 275: my %problem = %{$problems{$key}};
! 276: my ($problemname, $grade) = &grade_problem(%problem);
! 277: $result .= "<tr style='background-color: #EEF5F5;'><td>$problemname</td><td style='background-color: ";
! 278: if($grade eq "EXACT_ANS") {
! 279: $result .= "#DDFFDD";
! 280: } else {
! 281: $result .= "#DD5555";
! 282: }
! 283: $result .= "'>$grade</td></tr>";
! 284:
! 285: }
! 286: $result .= "\n</table>";
! 287:
! 288: return $result;
! 289: }
! 290:
! 291: sub grade_problem {
! 292: my %problem = @_;
! 293:
! 294: my ($content) = &Apache::loncommon::ssi_with_retries('/res/'.
! 295: $problem{'resource'}, 5, %problem);
! 296:
! 297: $content =~ s/.*class="LC_current_location".*>(.*)<\/td>.*/$1/g;
! 298: $content = $1;
! 299:
! 300: my $part = $problem{submitted};
! 301: $part =~ s/part_(.*)/$1/;
! 302: $content .= " - Part $part";
! 303:
! 304: my %problemhash = &Apache::lonnet::restore($problem{'symb'});
! 305: my $grade = $problemhash{"resource.$part.award"};
! 306:
! 307: return ($content, $grade);
! 308: }
! 309:
! 310: sub dumpenv {
! 311: my $r = shift;
! 312:
! 313: $r->print ("<br />-------------------<br />");
! 314: foreach my $key (sort (keys %env)) {
! 315: $r->print ("<br />$key -> $env{$key}");
! 316: }
! 317: $r->print ("<br />-------------------<br />");
! 318: $r->print ("<br />-------------------<br />");
! 319: foreach my $key (sort (keys %ENV)) {
! 320: $r->print ("<br />$key -> $ENV{$key}");
! 321: }
! 322: $r->print ("<br />-------------------<br />");
! 323:
! 324: }
! 325:
! 326: 1;
! 327: __END__
! 328:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonpdfupload.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface