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