Annotation of loncom/interface/lonpdfupload.pm, revision 1.17
1.1 onken 1: # The LearningOnline Network with CAPA
1.12 bisitz 2: # PDF Form Upload Handler
1.1 onken 3: #
1.17 ! raeburn 4: # $Id: lonpdfupload.pm,v 1.16 2010/03/18 14:50:15 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);
1.15 raeburn 32: use Apache::lonnet;
1.1 onken 33: use Apache::lonhtmlcommon();
34: use Apache::loncommon();
35: use Apache::lonlocal;
1.16 raeburn 36: use File::MMagic;
1.2 onken 37: use CAM::PDF;
1.1 onken 38:
39: use strict;
40:
41: sub handler() {
1.2 onken 42: my $r = shift;
1.15 raeburn 43: &Apache::loncommon::content_type($r,'text/html');
44: $r->send_http_header;
45: return OK if $r->header_only;
1.13 bisitz 46:
1.16 raeburn 47: # Needs to be in a course
48: if (!$env{'request.course.fn'}) {
49: # Not in a course
50: $env{'user.error.msg'}="/adm/pdfupload:bre:0:0:Cannot upload PDF forms unless in a course";
51: return HTTP_NOT_ACCEPTABLE;
52: }
53:
1.13 bisitz 54: # Breadcrumbs
1.15 raeburn 55: my $brcrum = [{'href' => '/adm/pdfupload',
1.13 bisitz 56: 'text' => 'Upload PDF Form'}];
1.16 raeburn 57: if ($env{'form.Uploaded'} && $env{'form.file'}) {
58: push(@{$brcrum},{'href' => '',
59: 'text' => 'PDF upload result'});
60: }
1.13 bisitz 61:
62: $r->print(&Apache::loncommon::start_page('Upload PDF Form',
63: undef,
64: {'bread_crumbs' => $brcrum,})
65: );
1.2 onken 66:
1.16 raeburn 67: if ($env{'request.course.id'}) {
68: my $permission = $env{'course.'.$env{'request.course.id'}.'.canuse_pdfforms'};
69: if ($permission eq '') {
70: my %domdefs = &Apache::lonnet::get_domain_defaults($env{'course.'.$env{'request.course.id'}.'.domain'});
71: $permission = $domdefs{'canuse_pdfforms'};
72: }
73: unless ($permission) {
74: $r->print('<p class="LC_warning">'.
75: &mt('Upload of PDF forms is not permitted for this course.').
76: '</p>'.
77: &Apache::loncommon::end_page());
78: return OK;
79: }
80: } else {
81: $r->print('<p class="LC_warning">'.
82: &mt('Could not determine identity of this course. you may need to [_1]re-select[_2] the course.','<a href="/adm/roles">','</a>').
83: '</p>'.
84: &Apache::loncommon::end_page());
85: return OK;
86: }
87:
1.2 onken 88: # if a file was upload
89: if($env{'form.Uploaded'} && $env{'form.file'}) {
1.16 raeburn 90: my $mm = new File::MMagic;
91: my $mime_type = $mm->checktype_contents($env{'form.file'});
92: if ($mime_type eq 'application/pdf') {
93: $r->print(&processPDF);
94: } else {
95: $r->print('<p class="LC_error">'
96: .&mt("The uploaded file does not appear to be a PDF file.")
97: .'</p>');
98: }
1.2 onken 99: } else {
100: # print upload form
101: $r->print(&get_javascripts);
102: $r->print(&get_uploadform);
103: }
104:
105: #link to course-content
1.6 bisitz 106: $r->print('<hr />'
107: .'<p>'."\n"
1.5 bisitz 108: .'<a href="/adm/navmaps">'."\n"
1.14 raeburn 109: .&mt('Course Contents')."\n"
1.5 bisitz 110: .'</a>'."\n"
111: .'</p>'."\n"
112: );
1.1 onken 113:
1.2 onken 114: #&dumpenv($r); #debug -> prints the environment
1.7 onken 115: $r->print(&Apache::loncommon::end_page());
1.1 onken 116: return OK;
1.2 onken 117: }
1.1 onken 118:
119: sub get_javascripts() {
1.2 onken 120:
1.6 bisitz 121: my $message = &mt('Please choose a PDF-File.');
1.1 onken 122:
1.2 onken 123: # simple test if the upload ends with ".pdf"
124: # it's only for giving a message to the user
125: my $result .= <<END
126: <script type="text/javascript">
1.1 onken 127: function checkFilename(form) {
128: var fileExt = form.file.value;
129: fileExt = fileExt.match(/[.]pdf\$/g);
130: if(fileExt) {
131: return true;
132: }
1.2 onken 133: alert("$message");
1.1 onken 134: return false;
135: }
1.2 onken 136: </script>
1.1 onken 137: END
138: ;
139: return $result;
140: }
141:
1.2 onken 142:
1.1 onken 143: sub get_uploadform() {
1.4 onken 144:
145: my %lt = &Apache::lonlocal::texthash(
1.6 bisitz 146: 'title' => 'Upload a PDF Form with filled Form Fields',
147: 'chFile' => 'File',
148: 'submit' => 'Upload',
1.4 onken 149: );
150:
1.5 bisitz 151: my $result =
152: '<br />'
153: .'<form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);">'
154: .'<input type="hidden" name="type" value="upload" />'
155: .&Apache::lonhtmlcommon::start_pick_box()
156: .&Apache::lonhtmlcommon::row_headline()
157: .'<h2>'.$lt{'title'}.'</h2>'
158: .&Apache::lonhtmlcommon::row_closure()
159: .&Apache::lonhtmlcommon::row_title($lt{'chFile'})
160: .'<input type="file" name="file" id="filename" />'
161: .&Apache::lonhtmlcommon::row_closure(1)
162: .&Apache::lonhtmlcommon::end_pick_box()
1.13 bisitz 163: .'<p>'
1.5 bisitz 164: .'<input type="submit" name="Uploaded" value="'.$lt{'submit'}.'" />'
1.13 bisitz 165: .'</p>'
1.5 bisitz 166: .'</form>'
1.6 bisitz 167: .'<br />';
1.5 bisitz 168:
1.1 onken 169: return $result;
170: }
171:
172: sub processPDF {
1.2 onken 173: my $result = (); # message for Browser
174: my @pdfdata = (); # answers from PDF-Forms
1.1 onken 175:
1.2 onken 176: @pdfdata = &get_pdf_data(); # get answers from PDF-Form
1.1 onken 177:
178: if (scalar @pdfdata) {
1.2 onken 179: &grade_pdf(@pdfdata);
1.1 onken 180: } else {
1.6 bisitz 181: $result .= '<p class="LC_error">'
182: .&mt("Can't find any valid PDF formfields.")
183: .'</p>';
1.1 onken 184: }
185: }
186:
187: sub get_pdf_data() {
188: my @data = ();
1.2 onken 189: my $pdf = CAM::PDF->new($env{'form.file'});
190:
191: my @formFields = $pdf->getFormFieldList(); #get names of formfields
1.1 onken 192:
1.2 onken 193: foreach my $field (@formFields) {
194: my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary
1.1 onken 195:
1.2 onken 196: #
1.15 raeburn 197: # this is necessary because CAM::PDF has a problem with formfieldnames which include a
1.2 onken 198: # dot in fieldnames. So a fieldname like "i.am.aFormfield" will offer three fieldnames "i", "i.am"
199: # and "i.am.aFormfield". The fragmentary names keep no values and will be ignored.
200: if($dict->{'V'}) {
201: push(@data, $field."?". $dict->{'V'}{'value'}); #binding fieldname with value
202: }
203: }
1.1 onken 204: return @data;
205: }
206:
207: sub grade_pdf {
208: my $result = ();
209: my @pdfdata = @_;
1.17 ! raeburn 210: my ($result,$meta,%grades,%problems,$debug);
1.1 onken 211:
212: $debug .= "Found: ". scalar @pdfdata." Entries \n";
1.4 onken 213:
1.1 onken 214: foreach my $entry (sort(@pdfdata)) {
215: if ($entry =~ /^meta.*/) {
1.2 onken 216: $debug .= 'found: metadata -> '.$entry . "<br />";
217: my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/);
1.1 onken 218: my ($domain, $user) = split('&', $value);
1.4 onken 219: $user =~ s/(.*)\n/$1/; #TODO is that equals to chomp?
1.1 onken 220:
221: if($user ne $env{'user.name'} or $domain ne $env{'user.domain'}) {
1.12 bisitz 222: return '<p class="LC_error">'
223: .&mt('Wrong username ([_1]) found in PDF file. Expected username: [_2]'
224: ,$user.':'.$domain
225: ,$env{'user.domain'}.':'.$env{'user.name'})
226: .'</p>';
1.1 onken 227: }
228:
1.17 ! raeburn 229: } elsif ($entry =~ /^upload.*/) {
1.1 onken 230: $debug .= 'found: a problem -> '.$entry;
1.2 onken 231: my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/);
1.1 onken 232: my ($symb, $part, $type, $HWVAL) = split('&', $label);
1.17 ! raeburn 233: my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb);
! 234: next unless (&Apache::lonnet::is_on_map($resource));
1.1 onken 235: $value =~ s/(.*)\n/$1/;
236:
1.6 bisitz 237: #filter incorrect radiobuttons (Bug in CABAReT Stage)
1.17 ! raeburn 238: if ($type eq 'radiobuttonresponse' && $value eq 'Off' ) {
1.1 onken 239: next;
240: }
241:
242: my $submit = $part;
243: $submit =~ s/part_(.*)/submit_$1/;
1.17 ! raeburn 244: if ($problems{$symb.$part}) {
1.1 onken 245: $problems{$symb.$part}{$HWVAL} = $value;
246: } else {
247: $problems{$symb.$part} = { 'resource' => $resource,
1.11 onken 248: 'symb' => $symb,
1.1 onken 249: 'submitted' => $part,
250: $submit => 'Answer',
251: $HWVAL => $value};
252: }
253: } else {
254: $debug .= 'found: -> '.$entry;
255: next;
256: }
257: }
1.4 onken 258: #$result .= $debug;
1.1 onken 259:
1.12 bisitz 260: $result .= '<h2>'.&mt('Results of PDF Form problems').'</h2>';
1.17 ! raeburn 261:
! 262: if (keys(%problems) > 0) {
! 263: $result .= &Apache::loncommon::start_data_table()
! 264: .&Apache::loncommon::start_data_table_header_row()
! 265: .'<th>'.&mt('Problem Name').'</th>'
! 266: .'<th>'.&mt('Grading').'</th>'
! 267: .&Apache::loncommon::start_data_table_header_row()
! 268: .&Apache::loncommon::end_data_table_header_row();
! 269:
! 270: foreach my $key (sort(keys(%problems))) {
! 271: my %problem = %{$problems{$key}};
! 272: my ($problemname, $grade) = &grade_problem(%problem);
! 273:
! 274: $result .= &Apache::loncommon::start_data_table_row();
! 275: $result .= "<td>$problemname</td><td class='";
! 276: if ($grade eq "EXACT_ANS" || $grade eq "APPROX_ANS") {
! 277: $result .= "LC_answer_correct";
! 278: } else {
! 279: $result .= "LC_answer_charged_try";
! 280: }
! 281: $grade = &parse_grade_answer($grade);
! 282: $result .= "'>$grade</span></td>";
! 283: $result .= &Apache::loncommon::end_data_table_row();
1.1 onken 284: }
1.17 ! raeburn 285: $result .= &Apache::loncommon::end_data_table();
! 286: } else {
! 287: $result .= '<p class="LC_warning">'.
! 288: &mt('As no gradable form items were found, no submissions have been recorded.').
! 289: '</p>';
1.4 onken 290: }
1.1 onken 291:
292: return $result;
293: }
294:
295: sub grade_problem {
296: my %problem = @_;
1.7 onken 297: my ($title, $part) = ();
1.1 onken 298:
1.7 onken 299: &Apache::loncommon::ssi_with_retries('/res/'.$problem{'resource'}, 5, %problem);
1.1 onken 300:
1.7 onken 301: $title = &Apache::lonnet::gettitle($problem{'symb'});
302: $part = $problem{submitted};
1.1 onken 303: $part =~ s/part_(.*)/$1/;
1.7 onken 304: unless($part eq '0') {
305: #add information about part number
306: $title .= " - Part $part";
307: }
1.1 onken 308:
309: my %problemhash = &Apache::lonnet::restore($problem{'symb'});
310: my $grade = $problemhash{"resource.$part.award"};
311:
1.7 onken 312: return ($title, $grade);
1.1 onken 313: }
314:
1.8 onken 315: sub parse_grade_answer {
316: my ($shortcut) = @_;
317: my %answerhash = ('EXACT_ANS' => &mt('You are correct.'),
1.10 onken 318: 'APPROX_ANS' => &mt('You are correct.'),
1.8 onken 319: 'INCORRECT' => &mt('You are incorrect'),
320: );
321:
322: foreach my $key (keys %answerhash) {
323: if($shortcut eq $key) {
324: return $answerhash{$shortcut};
325: }
326: }
327: return &mt('See course contents for further information.');
328:
329: }
330:
331:
1.1 onken 332: sub dumpenv {
333: my $r = shift;
334:
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: $r->print ("<br />-------------------<br />");
341: foreach my $key (sort (keys %ENV)) {
342: $r->print ("<br />$key -> $ENV{$key}");
343: }
344: $r->print ("<br />-------------------<br />");
345:
346: }
347:
348: 1;
349: __END__
350:
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