version 1.15, 2010/03/18 13:16:11
|
version 1.17, 2010/03/18 16:08:48
|
Line 33 use Apache::lonnet;
|
Line 33 use Apache::lonnet;
|
use Apache::lonhtmlcommon(); |
use Apache::lonhtmlcommon(); |
use Apache::loncommon(); |
use Apache::loncommon(); |
use Apache::lonlocal; |
use Apache::lonlocal; |
|
use File::MMagic; |
use CAM::PDF; |
use CAM::PDF; |
|
|
use strict; |
use strict; |
Line 43 sub handler() {
|
Line 44 sub handler() {
|
$r->send_http_header; |
$r->send_http_header; |
return OK if $r->header_only; |
return OK if $r->header_only; |
|
|
|
# Needs to be in a course |
|
if (!$env{'request.course.fn'}) { |
|
# Not in a course |
|
$env{'user.error.msg'}="/adm/pdfupload:bre:0:0:Cannot upload PDF forms unless in a course"; |
|
return HTTP_NOT_ACCEPTABLE; |
|
} |
|
|
# Breadcrumbs |
# Breadcrumbs |
my $brcrum = [{'href' => '/adm/pdfupload', |
my $brcrum = [{'href' => '/adm/pdfupload', |
'text' => 'Upload PDF Form'}]; |
'text' => 'Upload PDF Form'}]; |
|
if ($env{'form.Uploaded'} && $env{'form.file'}) { |
|
push(@{$brcrum},{'href' => '', |
|
'text' => 'PDF upload result'}); |
|
} |
|
|
$r->print(&Apache::loncommon::start_page('Upload PDF Form', |
$r->print(&Apache::loncommon::start_page('Upload PDF Form', |
undef, |
undef, |
{'bread_crumbs' => $brcrum,}) |
{'bread_crumbs' => $brcrum,}) |
); |
); |
|
|
|
if ($env{'request.course.id'}) { |
|
my $permission = $env{'course.'.$env{'request.course.id'}.'.canuse_pdfforms'}; |
|
if ($permission eq '') { |
|
my %domdefs = &Apache::lonnet::get_domain_defaults($env{'course.'.$env{'request.course.id'}.'.domain'}); |
|
$permission = $domdefs{'canuse_pdfforms'}; |
|
} |
|
unless ($permission) { |
|
$r->print('<p class="LC_warning">'. |
|
&mt('Upload of PDF forms is not permitted for this course.'). |
|
'</p>'. |
|
&Apache::loncommon::end_page()); |
|
return OK; |
|
} |
|
} else { |
|
$r->print('<p class="LC_warning">'. |
|
&mt('Could not determine identity of this course. you may need to [_1]re-select[_2] the course.','<a href="/adm/roles">','</a>'). |
|
'</p>'. |
|
&Apache::loncommon::end_page()); |
|
return OK; |
|
} |
|
|
# if a file was upload |
# if a file was upload |
if($env{'form.Uploaded'} && $env{'form.file'}) { |
if($env{'form.Uploaded'} && $env{'form.file'}) { |
$r->print(&processPDF); |
my $mm = new File::MMagic; |
|
my $mime_type = $mm->checktype_contents($env{'form.file'}); |
|
if ($mime_type eq 'application/pdf') { |
|
$r->print(&processPDF); |
|
} else { |
|
$r->print('<p class="LC_error">' |
|
.&mt("The uploaded file does not appear to be a PDF file.") |
|
.'</p>'); |
|
} |
} else { |
} else { |
# print upload form |
# print upload form |
$r->print(&get_javascripts); |
$r->print(&get_javascripts); |
Line 166 sub get_pdf_data() {
|
Line 207 sub get_pdf_data() {
|
sub grade_pdf { |
sub grade_pdf { |
my $result = (); |
my $result = (); |
my @pdfdata = @_; |
my @pdfdata = @_; |
|
my ($result,$meta,%grades,%problems,$debug); |
|
|
my $meta = (); |
|
my %grades = (); |
|
my %problems = (); |
|
|
|
my $debug = (); |
|
|
|
$debug .= "Found: ". scalar @pdfdata." Entries \n"; |
$debug .= "Found: ". scalar @pdfdata." Entries \n"; |
|
|
foreach my $entry (sort(@pdfdata)) { |
foreach my $entry (sort(@pdfdata)) { |
Line 190 sub grade_pdf {
|
Line 226 sub grade_pdf {
|
.'</p>'; |
.'</p>'; |
} |
} |
|
|
} elsif($entry =~ /^upload.*/) { |
} elsif ($entry =~ /^upload.*/) { |
$debug .= 'found: a problem -> '.$entry; |
$debug .= 'found: a problem -> '.$entry; |
my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/); |
my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/); |
my ($symb, $part, $type, $HWVAL) = split('&', $label); |
my ($symb, $part, $type, $HWVAL) = split('&', $label); |
my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb); |
my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb); |
|
next unless (&Apache::lonnet::is_on_map($resource)); |
$value =~ s/(.*)\n/$1/; |
$value =~ s/(.*)\n/$1/; |
|
|
#filter incorrect radiobuttons (Bug in CABAReT Stage) |
#filter incorrect radiobuttons (Bug in CABAReT Stage) |
if($type eq 'radiobuttonresponse' && $value eq 'Off' ) { |
if ($type eq 'radiobuttonresponse' && $value eq 'Off' ) { |
next; |
next; |
} |
} |
|
|
my $submit = $part; |
my $submit = $part; |
$submit =~ s/part_(.*)/submit_$1/; |
$submit =~ s/part_(.*)/submit_$1/; |
if($problems{$symb.$part}) { |
if ($problems{$symb.$part}) { |
$problems{$symb.$part}{$HWVAL} = $value; |
$problems{$symb.$part}{$HWVAL} = $value; |
} else { |
} else { |
$problems{$symb.$part} = { 'resource' => $resource, |
$problems{$symb.$part} = { 'resource' => $resource, |
Line 221 sub grade_pdf {
|
Line 258 sub grade_pdf {
|
#$result .= $debug; |
#$result .= $debug; |
|
|
$result .= '<h2>'.&mt('Results of PDF Form problems').'</h2>'; |
$result .= '<h2>'.&mt('Results of PDF Form problems').'</h2>'; |
$result .= &Apache::loncommon::start_data_table() |
|
.&Apache::loncommon::start_data_table_header_row() |
|
.'<th>'.&mt('Problem Name').'</th>' |
|
.'<th>'.&mt('Grading').'</th>' |
|
.&Apache::loncommon::start_data_table_header_row() |
|
.&Apache::loncommon::end_data_table_header_row(); |
|
|
|
foreach my $key (sort (keys %problems)) { |
|
my %problem = %{$problems{$key}}; |
|
my ($problemname, $grade) = &grade_problem(%problem); |
|
|
|
$result .= &Apache::loncommon::start_data_table_row(); |
|
$result .= "<td>$problemname</td><td class='"; |
|
if($grade eq "EXACT_ANS" || $grade eq "APPROX_ANS") { |
|
$result .= "LC_answer_correct"; |
|
} else { |
|
$result .= "LC_answer_charged_try"; |
|
} |
|
$grade = &parse_grade_answer($grade); |
|
$result .= "'>$grade</span></td>"; |
|
$result .= &Apache::loncommon::end_data_table_row(); |
|
} |
|
$result .= &Apache::loncommon::end_data_table(); |
|
|
|
|
if (keys(%problems) > 0) { |
|
$result .= &Apache::loncommon::start_data_table() |
|
.&Apache::loncommon::start_data_table_header_row() |
|
.'<th>'.&mt('Problem Name').'</th>' |
|
.'<th>'.&mt('Grading').'</th>' |
|
.&Apache::loncommon::start_data_table_header_row() |
|
.&Apache::loncommon::end_data_table_header_row(); |
|
|
|
foreach my $key (sort(keys(%problems))) { |
|
my %problem = %{$problems{$key}}; |
|
my ($problemname, $grade) = &grade_problem(%problem); |
|
|
|
$result .= &Apache::loncommon::start_data_table_row(); |
|
$result .= "<td>$problemname</td><td class='"; |
|
if ($grade eq "EXACT_ANS" || $grade eq "APPROX_ANS") { |
|
$result .= "LC_answer_correct"; |
|
} else { |
|
$result .= "LC_answer_charged_try"; |
|
} |
|
$grade = &parse_grade_answer($grade); |
|
$result .= "'>$grade</span></td>"; |
|
$result .= &Apache::loncommon::end_data_table_row(); |
|
} |
|
$result .= &Apache::loncommon::end_data_table(); |
|
} else { |
|
$result .= '<p class="LC_warning">'. |
|
&mt('As no gradable form items were found, no submissions have been recorded.'). |
|
'</p>'; |
|
} |
|
|
return $result; |
return $result; |
} |
} |