Annotation of loncom/interface/lonpdfupload.pm, revision 1.10
1.1 onken 1: # The LearningOnline Network with CAPA
2: # Publication Handler
3: #
1.10 ! onken 4: # $Id: lonpdfupload.pm,v 1.9 2009/05/21 05:57:50 raeburn Exp $
1.1 onken 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;
1.2 onken 49: use CAM::PDF;
1.1 onken 50:
51: use strict;
52:
53: sub handler() {
1.2 onken 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();
1.9 raeburn 68: $r->print(&Apache::loncommon::start_page('Upload PDF Form'));
1.2 onken 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
1.6 bisitz 83: $r->print('<hr />'
84: .'<p>'."\n"
1.5 bisitz 85: .'<a href="/adm/navmaps">'."\n"
86: .&mt("Navigate Contents")."\n"
87: .'</a>'."\n"
88: .'</p>'."\n"
89: );
1.1 onken 90:
1.2 onken 91: #&dumpenv($r); #debug -> prints the environment
1.7 onken 92: $r->print(&Apache::loncommon::end_page());
1.1 onken 93: return OK;
1.2 onken 94: }
1.1 onken 95:
96:
97: sub checkpermission() {
98: my $r = shift;
99: if (! &LONCAPA::loncgi::check_cookie_and_load_env()) {
100: my $result = <<END
101: Content-type: text/html
102:
103: <html>
1.2 onken 104: <head>
105: <title>
106: Bad Cookie
107: </title>
108: </head>
109: <body>
110: Your cookie information is incorrect.
111: </body>
1.1 onken 112: </html>
113: END
114: ;
115: $r->print($result);
116: return 0;
117: } else {
118: return 1;
119: }
120: }
121:
122:
123: sub get_javascripts() {
1.2 onken 124:
1.6 bisitz 125: my $message = &mt('Please choose a PDF-File.');
1.1 onken 126:
1.2 onken 127: # simple test if the upload ends with ".pdf"
128: # it's only for giving a message to the user
129: my $result .= <<END
130: <script type="text/javascript">
1.1 onken 131: function checkFilename(form) {
132: var fileExt = form.file.value;
133: fileExt = fileExt.match(/[.]pdf\$/g);
134: if(fileExt) {
135: return true;
136: }
1.2 onken 137: alert("$message");
1.1 onken 138: return false;
139: }
1.2 onken 140: </script>
1.1 onken 141: END
142: ;
143: return $result;
144: }
145:
1.2 onken 146:
1.1 onken 147: sub get_uploadform() {
1.4 onken 148:
149: my %lt = &Apache::lonlocal::texthash(
1.6 bisitz 150: 'title' => 'Upload a PDF Form with filled Form Fields',
151: 'chFile' => 'File',
152: 'submit' => 'Upload',
1.4 onken 153: );
154:
1.5 bisitz 155: my $result =
156: '<br />'
157: .'<form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);">'
158: .'<input type="hidden" name="type" value="upload" />'
159: .&Apache::lonhtmlcommon::start_pick_box()
160: .&Apache::lonhtmlcommon::row_headline()
161: .'<h2>'.$lt{'title'}.'</h2>'
162: .&Apache::lonhtmlcommon::row_closure()
163: .&Apache::lonhtmlcommon::row_title($lt{'chFile'})
164: .'<input type="file" name="file" id="filename" />'
165: .&Apache::lonhtmlcommon::row_closure(1)
166: .&Apache::lonhtmlcommon::end_pick_box()
167: .'<input type="submit" name="Uploaded" value="'.$lt{'submit'}.'" />'
168: .'</form>'
1.6 bisitz 169: .'<br />';
1.5 bisitz 170:
1.1 onken 171: return $result;
172: }
173:
174: sub processPDF {
1.2 onken 175: my $result = (); # message for Browser
176: my @pdfdata = (); # answers from PDF-Forms
1.1 onken 177:
1.2 onken 178: @pdfdata = &get_pdf_data(); # get answers from PDF-Form
1.1 onken 179:
180: if (scalar @pdfdata) {
1.2 onken 181: &grade_pdf(@pdfdata);
1.1 onken 182: } else {
1.6 bisitz 183: $result .= '<p class="LC_error">'
184: .&mt("Can't find any valid PDF formfields.")
185: .'</p>';
1.1 onken 186: }
187: }
188:
189: sub get_pdf_data() {
190: my @data = ();
1.2 onken 191: my $pdf = CAM::PDF->new($env{'form.file'});
192:
193: my @formFields = $pdf->getFormFieldList(); #get names of formfields
1.1 onken 194:
1.2 onken 195: foreach my $field (@formFields) {
196: my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary
1.1 onken 197:
1.2 onken 198: #
199: # this is nessesary 'cause CAM::PDF has a problem with formfieldnames which include a
200: # dot in fieldnames. So a fieldname like "i.am.aFormfield" will offer three fieldnames "i", "i.am"
201: # and "i.am.aFormfield". The fragmentary names keep no values and will be ignored.
202: if($dict->{'V'}) {
203: push(@data, $field."?". $dict->{'V'}{'value'}); #binding fieldname with value
204: }
205: }
1.1 onken 206: return @data;
207: }
208:
209: sub grade_pdf {
210: my $result = ();
211: my @pdfdata = @_;
212:
213: my $meta = ();
214: my %grades = ();
215: my %problems = ();
216:
217: my $debug = ();
218:
219: $debug .= "Found: ". scalar @pdfdata." Entries \n";
1.6 bisitz 220: $result .= '<h2>'.&mt('Results of PDF Form problems').'</h2>';
221: $result .= &Apache::loncommon::start_data_table()
222: .&Apache::loncommon::start_data_table_header_row()
223: .'<th>'.&mt('Problem Name').'</th>'
224: .'<th>'.&mt('Grading').'</th>'
225: .&Apache::loncommon::start_data_table_header_row()
226: .&Apache::loncommon::end_data_table_header_row();
1.4 onken 227:
1.1 onken 228: foreach my $entry (sort(@pdfdata)) {
229: if ($entry =~ /^meta.*/) {
1.2 onken 230: $debug .= 'found: metadata -> '.$entry . "<br />";
231: my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/);
1.1 onken 232: my ($domain, $user) = split('&', $value);
1.4 onken 233: $user =~ s/(.*)\n/$1/; #TODO is that equals to chomp?
1.1 onken 234:
235: if($user ne $env{'user.name'} or $domain ne $env{'user.domain'}) {
236: return "<pre>".&mt('Wrong username in PDF-File').": $user $domain -> $env{'user.domain'} $env{'user.name'} </pre>";
237: }
238:
239: } elsif($entry =~ /^upload.*/) {
240: $debug .= 'found: a problem -> '.$entry;
1.2 onken 241: my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/);
1.1 onken 242: my ($symb, $part, $type, $HWVAL) = split('&', $label);
243: my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb);
244: $value =~ s/(.*)\n/$1/;
245:
1.6 bisitz 246: #filter incorrect radiobuttons (Bug in CABAReT Stage)
1.1 onken 247: if($type eq 'radiobuttonresponse' && $value eq 'Off' ) {
248: next;
249: }
250:
251: my $submit = $part;
252: $submit =~ s/part_(.*)/submit_$1/;
253: if($problems{$symb.$part}) {
254: $problems{$symb.$part}{$HWVAL} = $value;
255: } else {
256: $problems{$symb.$part} = { 'resource' => $resource,
1.4 onken 257: 'symb' => &Apache::lonenc::encrypted($symb),
1.1 onken 258: 'submitted' => $part,
259: $submit => 'Answer',
260: $HWVAL => $value};
261: }
262: } else {
263: $debug .= 'found: -> '.$entry;
264: next;
265: }
266: }
1.4 onken 267: #$result .= $debug;
1.1 onken 268:
269: foreach my $key (sort (keys %problems)) {
270: my %problem = %{$problems{$key}};
271: my ($problemname, $grade) = &grade_problem(%problem);
1.4 onken 272:
273: $result .= &Apache::loncommon::start_data_table_row();
274: $result .= "<td>$problemname</td><td class='";
1.8 onken 275: if($grade eq "EXACT_ANS" || $grade eq "APPROX_ANS") {
1.4 onken 276: $result .= "LC_answer_correct";
1.1 onken 277: } else {
1.4 onken 278: $result .= "LC_answer_charged_try";
1.1 onken 279: }
1.8 onken 280: $grade = &parse_grade_answer($grade);
1.4 onken 281: $result .= "'>$grade</span></td>";
282: $result .= &Apache::loncommon::end_data_table_row();
283: }
284: $result .= &Apache::loncommon::end_data_table();
1.1 onken 285:
286:
287: return $result;
288: }
289:
290: sub grade_problem {
291: my %problem = @_;
1.7 onken 292: my ($title, $part) = ();
1.1 onken 293:
1.7 onken 294: &Apache::loncommon::ssi_with_retries('/res/'.$problem{'resource'}, 5, %problem);
1.1 onken 295:
1.7 onken 296: $title = &Apache::lonnet::gettitle($problem{'symb'});
297: $part = $problem{submitted};
1.1 onken 298: $part =~ s/part_(.*)/$1/;
1.7 onken 299: unless($part eq '0') {
300: #add information about part number
301: $title .= " - Part $part";
302: }
1.1 onken 303:
304: my %problemhash = &Apache::lonnet::restore($problem{'symb'});
305: my $grade = $problemhash{"resource.$part.award"};
306:
1.7 onken 307: return ($title, $grade);
1.1 onken 308: }
309:
1.8 onken 310: sub parse_grade_answer {
311: my ($shortcut) = @_;
312: my %answerhash = ('EXACT_ANS' => &mt('You are correct.'),
1.10 ! onken 313: 'APPROX_ANS' => &mt('You are correct.'),
1.8 onken 314: 'INCORRECT' => &mt('You are incorrect'),
315: );
316:
317: foreach my $key (keys %answerhash) {
318: if($shortcut eq $key) {
319: return $answerhash{$shortcut};
320: }
321: }
322: return &mt('See course contents for further information.');
323:
324: }
325:
326:
1.1 onken 327: sub dumpenv {
328: my $r = shift;
329:
330: $r->print ("<br />-------------------<br />");
331: foreach my $key (sort (keys %env)) {
332: $r->print ("<br />$key -> $env{$key}");
333: }
334: $r->print ("<br />-------------------<br />");
335: $r->print ("<br />-------------------<br />");
336: foreach my $key (sort (keys %ENV)) {
337: $r->print ("<br />$key -> $ENV{$key}");
338: }
339: $r->print ("<br />-------------------<br />");
340:
341: }
342:
343: 1;
344: __END__
345:
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