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