--- loncom/interface/lonpdfupload.pm 2010/03/18 14:50:15 1.16 +++ loncom/interface/lonpdfupload.pm 2014/02/28 19:20:06 1.23 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # PDF Form Upload Handler # -# $Id: lonpdfupload.pm,v 1.16 2010/03/18 14:50:15 raeburn Exp $ +# $Id: lonpdfupload.pm,v 1.23 2014/02/28 19:20:06 bisitz Exp $ # # Copyright Michigan State University Board of Trustees # @@ -32,9 +32,11 @@ use Apache::Constants qw(:common :http); use Apache::lonnet; use Apache::lonhtmlcommon(); use Apache::loncommon(); +use Apache::lonnavmaps(); use Apache::lonlocal; use File::MMagic; use CAM::PDF; +use LONCAPA qw(:DEFAULT :match); use strict; @@ -79,7 +81,8 @@ sub handler() { } } else { $r->print('

'. - &mt('Could not determine identity of this course. you may need to [_1]re-select[_2] the course.','',''). + &mt('Could not determine identity of this course.').' '. + &mt('You may need to [_1]re-select[_2] the course.','',''). '

'. &Apache::loncommon::end_page()); return OK; @@ -124,15 +127,17 @@ sub get_javascripts() { # it's only for giving a message to the user my $result .= < +// END ; @@ -150,8 +155,7 @@ sub get_uploadform() { my $result = '
' - .'
' - .'' + .'' .&Apache::lonhtmlcommon::start_pick_box() .&Apache::lonhtmlcommon::row_headline() .'

'.$lt{'title'}.'

' @@ -179,7 +183,7 @@ sub processPDF { &grade_pdf(@pdfdata); } else { $result .= '

' - .&mt("Can't find any valid PDF formfields.") + .&mt("Can't find any valid PDF form fields.") .'

'; } } @@ -188,32 +192,42 @@ sub get_pdf_data() { my @data = (); my $pdf = CAM::PDF->new($env{'form.file'}); - my @formFields = $pdf->getFormFieldList(); #get names of formfields - - foreach my $field (@formFields) { - my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary + if($pdf) { + my @formFields = $pdf->getFormFieldList(); #get names of form fields + + foreach my $field (@formFields) { + my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get form field dictonary - # - # this is necessary because CAM::PDF has a problem with formfieldnames which include a - # dot in fieldnames. So a fieldname like "i.am.aFormfield" will offer three fieldnames "i", "i.am" - # and "i.am.aFormfield". The fragmentary names keep no values and will be ignored. - if($dict->{'V'}) { - push(@data, $field."?". $dict->{'V'}{'value'}); #binding fieldname with value + # this is necessary because CAM::PDF has a problem with form fieldnames which include a + # dot in fieldnames. So a fieldname like "i.am.aFormfield" will offer three fieldnames + # "i", "i.am" and "i.am.aFormfield". The fragmentary names keep no values and will be ignored. + if($dict->{'V'}) { + push(@data, $field."?". $dict->{'V'}{'value'}); #binding fieldname with value + } } - } + } return @data; } sub grade_pdf { - my $result = (); my @pdfdata = @_; - - my $meta = (); - my %grades = (); - my %problems = (); - - my $debug = (); + my ($result,$meta,%grades,%problems,%foreigncourse,$debug); + my $navmap = Apache::lonnavmaps::navmap->new(); + if (!defined($navmap)) { + $result = '

'.&mt('Verification of PDF form items failed').'

'. + '
'. + &mt('Unable to retrieve information about course contents').' '. + &mt('You may need to [_1]re-select[_2] the course.','',''). + '
'; + return $result; + } + my %restitles; + foreach my $res ($navmap->retrieveResources()) { + my $symb = $res->symb; + $restitles{$symb} = $res->compTitle(); + } + $debug .= "Found: ". scalar @pdfdata." Entries \n"; foreach my $entry (sort(@pdfdata)) { @@ -222,7 +236,6 @@ sub grade_pdf { my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/); my ($domain, $user) = split('&', $value); $user =~ s/(.*)\n/$1/; #TODO is that equals to chomp? - if($user ne $env{'user.name'} or $domain ne $env{'user.domain'}) { return '

' .&mt('Wrong username ([_1]) found in PDF file. Expected username: [_2]' @@ -231,21 +244,28 @@ sub grade_pdf { .'

'; } - } elsif($entry =~ /^upload.*/) { + } elsif ($entry =~ /^upload.*/) { $debug .= 'found: a problem -> '.$entry; my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/); 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); + if ($map =~ m{^uploaded/($match_domain)/($match_courseid)/default(_?\d*)\.(page|sequence)}) { + my $mapcid = $1.'_'.$2; + if ($mapcid ne $env{'request.course.id'}) { + push(@{$foreigncourse{$mapcid}},$symb); + } + } + next unless (exists($restitles{$symb})); $value =~ s/(.*)\n/$1/; #filter incorrect radiobuttons (Bug in CABAReT Stage) - if($type eq 'radiobuttonresponse' && $value eq 'Off' ) { + if ($type eq 'radiobuttonresponse' && $value eq 'Off' ) { next; } my $submit = $part; $submit =~ s/part_(.*)/submit_$1/; - if($problems{$symb.$part}) { + if ($problems{$symb.$part}) { $problems{$symb.$part}{$HWVAL} = $value; } else { $problems{$symb.$part} = { 'resource' => $resource, @@ -261,33 +281,75 @@ sub grade_pdf { } #$result .= $debug; - $result .= '

'.&mt('Results of PDF Form problems').'

'; - $result .= &Apache::loncommon::start_data_table() - .&Apache::loncommon::start_data_table_header_row() - .''.&mt('Problem Name').'' - .''.&mt('Grading').'' - .&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 .= "$problemname'.&mt('Result of PDF Form upload').''; + + if (keys(%problems) > 0) { + $result .= &Apache::loncommon::start_data_table() + .&Apache::loncommon::start_data_table_header_row() + .''.&mt('Problem Name').'' + .''.&mt('Grading').'' + .&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 .= ''). + '">'.$problemname.''; + $result .= &Apache::loncommon::end_data_table_row(); + } + $result .= &Apache::loncommon::end_data_table(); + } else { + $result .= '

'. + &mt('As no gradable form items were found, no submissions have been recorded.'). + '

'; + } + if (keys(%foreigncourse)) { + my ($numother,$othercrsmsg); + foreach my $cid (sort(keys(%foreigncourse))) { + my %coursehash = &Apache::lonnet::coursedescription($cid, + {'one_time' => 1}); + if (ref($foreigncourse{$cid}) eq 'ARRAY') { + if ($numother) { + $othercrsmsg .= '
  • '; + } + $othercrsmsg .= ''.$coursehash{'description'}.'
      '."\n"; + foreach my $symb (@{$foreigncourse{$cid}}) { + my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb); + $othercrsmsg .= '
    • '.$resource.'
      • '; + } + $othercrsmsg .= '
    '; + $numother ++; + } + } + if ($numother) { + $result .= '
    '; + if ($numother > 1) { + $result .= &mt('Your uploaded PDF form contained the following resource(s) from [_1] different courses:',''.$numother.'')."\n".'
    • '. + $othercrsmsg.'
    '; + } else { + $result .= &mt('Your uploaded PDF form contained the following resource(s) from a different course:').' '.$othercrsmsg. + &mt('Did you download the PDF form from another course and upload it to the wrong course?'); + } + $result .= '
    '; } - $grade = &parse_grade_answer($grade); - $result .= "'>$grade"; - $result .= &Apache::loncommon::end_data_table_row(); } - $result .= &Apache::loncommon::end_data_table(); - - return $result; + return $result; } sub grade_problem { @@ -315,6 +377,7 @@ sub parse_grade_answer { my %answerhash = ('EXACT_ANS' => &mt('You are correct.'), 'APPROX_ANS' => &mt('You are correct.'), 'INCORRECT' => &mt('You are incorrect'), + 'DRAFT' => &mt('Copy saved but not submitted.'), ); foreach my $key (keys %answerhash) {