File:
[LON-CAPA] /
loncom /
interface /
lonpdfupload.pm
Revision
1.25:
download - view:
text,
annotated -
select for diffs
Tue Jun 9 21:22:57 2015 UTC (9 years, 2 months ago) by
damieng
Branches:
MAIN
CVS tags:
version_2_12_X,
version_2_11_X,
version_2_11_5_msu,
version_2_11_5,
version_2_11_4_uiuc,
version_2_11_4_msu,
version_2_11_4,
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_uiuc,
version_2_11_2_msu,
version_2_11_2_educog,
version_2_11_2,
HEAD
fixed bug 6782, and escaped most localized messages used in Javascript blocks to make sure bugs like that do not happen again
1: # The LearningOnline Network with CAPA
2: # PDF Form Upload Handler
3: #
4: # $Id: lonpdfupload.pm,v 1.25 2015/06/09 21:22:57 damieng 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 Apache::lonnet;
33: use Apache::lonhtmlcommon();
34: use Apache::loncommon();
35: use Apache::lonnavmaps();
36: use Apache::lonlocal;
37: use File::MMagic;
38: use CAM::PDF;
39: use LONCAPA qw(:DEFAULT :match);
40:
41: use strict;
42:
43: sub handler() {
44: my $r = shift;
45: &Apache::loncommon::content_type($r,'text/html');
46: $r->send_http_header;
47: return OK if $r->header_only;
48:
49: # Needs to be in a course
50: if (!$env{'request.course.fn'}) {
51: # Not in a course
52: $env{'user.error.msg'}="/adm/pdfupload:bre:0:0:Cannot upload PDF forms unless in a course";
53: return HTTP_NOT_ACCEPTABLE;
54: }
55:
56: # Breadcrumbs
57: my $brcrum = [{'href' => '/adm/pdfupload',
58: 'text' => 'Upload PDF Form'}];
59: if ($env{'form.Uploaded'} && $env{'form.file'}) {
60: push(@{$brcrum},{'href' => '',
61: 'text' => 'PDF upload result'});
62: }
63:
64: $r->print(&Apache::loncommon::start_page('Upload PDF Form',
65: undef,
66: {'bread_crumbs' => $brcrum,})
67: );
68:
69: if ($env{'request.course.id'}) {
70: my $permission = $env{'course.'.$env{'request.course.id'}.'.canuse_pdfforms'};
71: if ($permission eq '') {
72: my %domdefs = &Apache::lonnet::get_domain_defaults($env{'course.'.$env{'request.course.id'}.'.domain'});
73: $permission = $domdefs{'canuse_pdfforms'};
74: }
75: unless ($permission) {
76: $r->print('<p class="LC_warning">'.
77: &mt('Upload of PDF forms is not permitted for this course.').
78: '</p>'.
79: &Apache::loncommon::end_page());
80: return OK;
81: }
82: } else {
83: $r->print('<p class="LC_warning">'.
84: &mt('Could not determine identity of this course.').' '.
85: &mt('You may need to [_1]re-select[_2] the course.','<a href="/adm/roles">','</a>').
86: '</p>'.
87: &Apache::loncommon::end_page());
88: return OK;
89: }
90:
91: # if a file was upload
92: if($env{'form.Uploaded'} && $env{'form.file'}) {
93: my $mm = new File::MMagic;
94: my $mime_type = $mm->checktype_contents($env{'form.file'});
95: if ($mime_type eq 'application/pdf') {
96: $r->print(&processPDF);
97: } else {
98: $r->print('<p class="LC_error">'
99: .&mt("The uploaded file does not appear to be a PDF file.")
100: .'</p>');
101: }
102: } else {
103: # print upload form
104: $r->print(&get_javascripts);
105: $r->print(&get_uploadform);
106: }
107:
108: #link to course-content
109: $r->print('<hr />'
110: .'<p>'."\n"
111: .'<a href="/adm/navmaps">'."\n"
112: .&mt('Course Contents')."\n"
113: .'</a>'."\n"
114: .'</p>'."\n"
115: );
116:
117: #&dumpenv($r); #debug -> prints the environment
118: $r->print(&Apache::loncommon::end_page());
119: return OK;
120: }
121:
122: sub get_javascripts() {
123:
124: my $message = &mt('Please choose a PDF-File.');
125: &js_escape(\$message);
126:
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">
131: // <![CDATA[
132: function checkFilename(form) {
133: var fileExt = form.file.value;
134: fileExt = fileExt.match(/[.]pdf\$/gi);
135: if(fileExt) {
136: return true;
137: }
138: alert("$message");
139: return false;
140: }
141: // ]]>
142: </script>
143: END
144: ;
145: return $result;
146: }
147:
148:
149: sub get_uploadform() {
150:
151: my %lt = &Apache::lonlocal::texthash(
152: 'title' => 'Upload a PDF Form with filled Form Fields',
153: 'chFile' => 'File',
154: 'submit' => 'Upload',
155: );
156:
157: my $result =
158: '<br />'
159: .'<form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);" action="">'
160: .&Apache::lonhtmlcommon::start_pick_box()
161: .&Apache::lonhtmlcommon::row_headline()
162: .'<h2>'.$lt{'title'}.'</h2>'
163: .&Apache::lonhtmlcommon::row_closure()
164: .&Apache::lonhtmlcommon::row_title($lt{'chFile'})
165: .'<input type="file" name="file" id="filename" />'
166: .&Apache::lonhtmlcommon::row_closure(1)
167: .&Apache::lonhtmlcommon::end_pick_box()
168: .'<p>'
169: .'<input type="submit" name="Uploaded" value="'.$lt{'submit'}.'" />'
170: .'</p>'
171: .'</form>'
172: .'<br />';
173:
174: return $result;
175: }
176:
177: sub processPDF {
178: my $result = (); # message for Browser
179: my @pdfdata = (); # answers from PDF-Forms
180:
181: @pdfdata = &get_pdf_data(); # get answers from PDF-Form
182:
183: if (scalar @pdfdata) {
184: &grade_pdf(@pdfdata);
185: } else {
186: $result .= '<p class="LC_error">'
187: .&mt("Can't find any valid PDF form fields.")
188: .'</p>';
189: }
190: }
191:
192: sub get_pdf_data() {
193: my @data = ();
194: my $pdf = CAM::PDF->new($env{'form.file'});
195:
196: if($pdf) {
197: my @formFields = $pdf->getFormFieldList(); #get names of form fields
198:
199: foreach my $field (@formFields) {
200: my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get form field dictonary
201:
202: # this is necessary because CAM::PDF has a problem with form fieldnames which include a
203: # dot in fieldnames. So a fieldname like "i.am.aFormfield" will offer three fieldnames
204: # "i", "i.am" and "i.am.aFormfield". The fragmentary names keep no values and will be ignored.
205: if($dict->{'V'}) {
206: push(@data, $field."?". $dict->{'V'}{'value'}); #binding fieldname with value
207: }
208: }
209: }
210: return @data;
211: }
212:
213: sub grade_pdf {
214: my @pdfdata = @_;
215: my ($result,$meta,%grades,%problems,%foreigncourse,$debug);
216:
217: my $navmap = Apache::lonnavmaps::navmap->new();
218: if (!defined($navmap)) {
219: $result = '<h3>'.&mt('Verification of PDF form items failed').'</h3>'.
220: '<div class="LC_error">'.
221: &mt('Unable to retrieve information about course contents').' '.
222: &mt('You may need to [_1]re-select[_2] the course.','<a href="/adm/roles">','</a>').
223: '</div>';
224: return $result;
225: }
226: my %restitles;
227: foreach my $res ($navmap->retrieveResources()) {
228: my $symb = $res->symb;
229: $restitles{$symb} = $res->compTitle();
230: }
231:
232: $debug .= "Found: ". scalar @pdfdata." Entries \n";
233:
234: foreach my $entry (sort(@pdfdata)) {
235: if ($entry =~ /^meta.*/) {
236: $debug .= 'found: metadata -> '.$entry . "<br />";
237: my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/);
238: my ($domain, $user) = split('&', $value);
239: $user =~ s/(.*)\n/$1/; #TODO is that equals to chomp?
240: if($user ne $env{'user.name'} or $domain ne $env{'user.domain'}) {
241: return '<p class="LC_error">'
242: .&mt('Wrong username ([_1]) found in PDF file. Expected username: [_2]'
243: ,$user.':'.$domain
244: ,$env{'user.domain'}.':'.$env{'user.name'})
245: .'</p>';
246: }
247:
248: } elsif ($entry =~ /^upload.*/) {
249: $debug .= 'found: a problem -> '.$entry;
250: my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/);
251: my ($symb, $part, $type, $HWVAL) = split('&', $label);
252: my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb);
253: if ($map =~ m{^uploaded/($match_domain)/($match_courseid)/default(_?\d*)\.(page|sequence)}) {
254: my $mapcid = $1.'_'.$2;
255: if ($mapcid ne $env{'request.course.id'}) {
256: push(@{$foreigncourse{$mapcid}},$symb);
257: }
258: }
259: next unless (exists($restitles{$symb}));
260: $value =~ s/(.*)\n/$1/;
261:
262: #filter incorrect radiobuttons (Bug in CABAReT Stage)
263: if ($type eq 'radiobuttonresponse' && $value eq 'Off' ) {
264: next;
265: }
266:
267: my $submit = $part;
268: $submit =~ s/part_(.*)/submit_$1/;
269: if ($problems{$symb.$part}) {
270: $problems{$symb.$part}{$HWVAL} = $value;
271: } else {
272: $problems{$symb.$part} = { 'resource' => $resource,
273: 'symb' => $symb,
274: 'submitted' => $part,
275: $submit => 'Answer',
276: $HWVAL => $value};
277: }
278: } else {
279: $debug .= 'found: -> '.$entry;
280: next;
281: }
282: }
283: #$result .= $debug;
284:
285: $result .= '<h3>'.&mt('Result of PDF Form upload').'</h3>';
286:
287: if (keys(%problems) > 0) {
288: $result .= &Apache::loncommon::start_data_table()
289: .&Apache::loncommon::start_data_table_header_row()
290: .'<th>'.&mt('Problem Name').'</th>'
291: .'<th>'.&mt('Grading').'</th>'
292: .&Apache::loncommon::start_data_table_header_row()
293: .&Apache::loncommon::end_data_table_header_row();
294:
295: foreach my $key (sort(keys(%problems))) {
296: my %problem = %{$problems{$key}};
297: my ($problemname, $grade) = &grade_problem(%problem);
298:
299: $result .= &Apache::loncommon::start_data_table_row();
300: $result .= '<td><a href="/res/'.$problem{'resource'}.
301: '?symb='.
302: &HTML::Entities::encode($problem{'symb'},'"&<>').
303: '">'.$problemname.'</a></td><td><span class="';
304: if ($grade eq "EXACT_ANS" || $grade eq "APPROX_ANS") {
305: $result .= 'LC_answer_correct';
306: } elsif ($grade eq "DRAFT") {
307: $result .= 'LC_answer_not_charged_try';
308: } else {
309: $result .= 'LC_answer_charged_try';
310: }
311: $result .= '">';
312: $grade = &parse_grade_answer($grade);
313: $result .= $grade.'</span></td>';
314: $result .= &Apache::loncommon::end_data_table_row();
315: }
316: $result .= &Apache::loncommon::end_data_table();
317: } else {
318: $result .= '<p class="LC_warning">'.
319: &mt('As no gradable form items were found, no submissions have been recorded.').
320: '</p>';
321: }
322: if (keys(%foreigncourse)) {
323: my ($numother,$othercrsmsg);
324: foreach my $cid (sort(keys(%foreigncourse))) {
325: my %coursehash = &Apache::lonnet::coursedescription($cid,
326: {'one_time' => 1});
327: if (ref($foreigncourse{$cid}) eq 'ARRAY') {
328: if ($numother) {
329: $othercrsmsg .= '</li><li>';
330: }
331: $othercrsmsg .= '<b>'.$coursehash{'description'}.'</b><ul>'."\n";
332: foreach my $symb (@{$foreigncourse{$cid}}) {
333: my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb);
334: $othercrsmsg .= '<li>'.$resource.'</li>';
335: }
336: $othercrsmsg .= '</ul>';
337: $numother ++;
338: }
339: }
340: if ($numother) {
341: $result .= '<div class="LC_warning">';
342: if ($numother > 1) {
343: $result .= &mt('Your uploaded PDF form contained the following resource(s) from [_1] different courses:','<b>'.$numother.'</b>')."\n".'<ul><li>'.
344: $othercrsmsg.'</li></ul>';
345: } else {
346: $result .= &mt('Your uploaded PDF form contained the following resource(s) from a different course:').' '.$othercrsmsg.
347: &mt('Did you download the PDF form from another course and upload it to the wrong course?');
348: }
349: $result .= '</div>';
350: }
351: }
352:
353: return $result;
354: }
355:
356: sub grade_problem {
357: my %problem = @_;
358: my ($title, $part) = ();
359:
360: &Apache::loncommon::ssi_with_retries('/res/'.$problem{'resource'}, 5, %problem);
361:
362: $title = &Apache::lonnet::gettitle($problem{'symb'});
363: $part = $problem{submitted};
364: $part =~ s/part_(.*)/$1/;
365: unless($part eq '0') {
366: #add information about part number
367: $title .= " - Part $part";
368: }
369:
370: my %problemhash = &Apache::lonnet::restore($problem{'symb'});
371: my $grade = $problemhash{"resource.$part.award"};
372:
373: return ($title, $grade);
374: }
375:
376: sub parse_grade_answer {
377: my ($shortcut) = @_;
378: my %answerhash = ('EXACT_ANS' => &mt('You are correct.'),
379: 'APPROX_ANS' => &mt('You are correct.'),
380: 'INCORRECT' => &mt('You are incorrect'),
381: 'DRAFT' => &mt('Copy saved but not submitted.'),
382: );
383:
384: foreach my $key (keys(%answerhash)) {
385: if($shortcut eq $key) {
386: return $answerhash{$shortcut};
387: }
388: }
389: return &mt('See course contents for further information.');
390:
391: }
392:
393:
394: sub dumpenv {
395: my $r = shift;
396:
397: $r->print ("<br />-------------------<br />");
398: foreach my $key (sort(keys(%env))) {
399: $r->print ("<br />$key -> $env{$key}");
400: }
401: $r->print ("<br />-------------------<br />");
402: $r->print ("<br />-------------------<br />");
403: foreach my $key (sort(keys(%ENV))) {
404: $r->print ("<br />$key -> $ENV{$key}");
405: }
406: $r->print ("<br />-------------------<br />");
407:
408: }
409:
410: 1;
411: __END__
412:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>