--- loncom/interface/lonpdfupload.pm 2009/05/16 00:28:38 1.6 +++ loncom/interface/lonpdfupload.pm 2010/03/18 13:16:11 1.15 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA -# Publication Handler +# PDF Form Upload Handler # -# $Id: lonpdfupload.pm,v 1.6 2009/05/16 00:28:38 bisitz Exp $ +# $Id: lonpdfupload.pm,v 1.15 2010/03/18 13:16:11 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -29,46 +29,28 @@ package Apache::lonpdfupload; use lib '/home/httpd/lib/perl'; use Apache::Constants qw(:common :http); -use LONCAPA; -use LONCAPA::loncgi; -use File::Path; -use File::Basename; -use File::Copy; -use IO::File; -use Image::Magick; -use Apache::lonacc; -use Apache::lonxml; -use Apache::lonhtmlcommon(); use Apache::lonnet; +use Apache::lonhtmlcommon(); use Apache::loncommon(); use Apache::lonlocal; -use Apache::lonmsg(); -use Apache::lonhomework; -use LONCAPA::Enrollment; -use LONCAPA::Configuration; use CAM::PDF; use strict; sub handler() { my $r = shift; - - # check user permissions - if(!&checkpermission($r)) { - # stop processing - return OK; - } - - $Apache::lonxml::request=$r; - $Apache::lonxml::debug=$env{'user.debug'}; - - $env{'request.uri'}=$r->uri; - $r->content_type('text/html'); - $r->send_http_header(); - $r->print(&Apache::loncommon::start_page('Upload PDF Form')); - - #load post data into environment - &Apache::lonacc::get_posted_cgi($r); + &Apache::loncommon::content_type($r,'text/html'); + $r->send_http_header; + return OK if $r->header_only; + + # Breadcrumbs + my $brcrum = [{'href' => '/adm/pdfupload', + 'text' => 'Upload PDF Form'}]; + + $r->print(&Apache::loncommon::start_page('Upload PDF Form', + undef, + {'bread_crumbs' => $brcrum,}) + ); # if a file was upload if($env{'form.Uploaded'} && $env{'form.file'}) { @@ -83,43 +65,16 @@ sub handler() { $r->print('
' .'

'."\n" .''."\n" - .&mt("Navigate Contents")."\n" + .&mt('Course Contents')."\n" .''."\n" .'

'."\n" ); #&dumpenv($r); #debug -> prints the environment - $r->print(" \n\n"); + $r->print(&Apache::loncommon::end_page()); return OK; } - -sub checkpermission() { - my $r = shift; - if (! &LONCAPA::loncgi::check_cookie_and_load_env()) { - my $result = < - - - Bad Cookie - - - - Your cookie information is incorrect. - - -END -; - $r->print($result); - return 0; - } else { - return 1; - } -} - - sub get_javascripts() { my $message = &mt('Please choose a PDF-File.'); @@ -164,7 +119,9 @@ sub get_uploadform() { .'' .&Apache::lonhtmlcommon::row_closure(1) .&Apache::lonhtmlcommon::end_pick_box() + .'

' .'' + .'

' .'' .'
'; @@ -196,7 +153,7 @@ sub get_pdf_data() { my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary # - # this is nessesary 'cause CAM::PDF has a problem with formfieldnames which include a + # 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'}) { @@ -217,13 +174,6 @@ sub grade_pdf { my $debug = (); $debug .= "Found: ". scalar @pdfdata." Entries \n"; - $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 $entry (sort(@pdfdata)) { if ($entry =~ /^meta.*/) { @@ -233,7 +183,11 @@ sub grade_pdf { $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 in PDF-File').": $user $domain -> $env{'user.domain'} $env{'user.name'}
"; + return '

' + .&mt('Wrong username ([_1]) found in PDF file. Expected username: [_2]' + ,$user.':'.$domain + ,$env{'user.domain'}.':'.$env{'user.name'}) + .'

'; } } elsif($entry =~ /^upload.*/) { @@ -254,7 +208,7 @@ sub grade_pdf { $problems{$symb.$part}{$HWVAL} = $value; } else { $problems{$symb.$part} = { 'resource' => $resource, - 'symb' => &Apache::lonenc::encrypted($symb), + 'symb' => $symb, 'submitted' => $part, $submit => 'Answer', $HWVAL => $value}; @@ -266,19 +220,26 @@ 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); - $problemname =~ s/(.*)\s*-\sPart\s0/$1/; #cut part when there is only one part in problem - $result .= &Apache::loncommon::start_data_table_row(); $result .= "$problemname$grade"; $result .= &Apache::loncommon::end_data_table_row(); } @@ -290,25 +251,41 @@ sub grade_pdf { sub grade_problem { my %problem = @_; + my ($title, $part) = (); - my ($content) = &Apache::loncommon::ssi_with_retries('/res/'. - $problem{'resource'}, 5, %problem); - - #TODO ? filter html response can't be the answer - # ! find an other way to get a problemname and Part - $content =~ s/.*class="LC_current_location".*>(.*)<\/td>.*/$1/g; - $content = $1; + &Apache::loncommon::ssi_with_retries('/res/'.$problem{'resource'}, 5, %problem); - my $part = $problem{submitted}; + $title = &Apache::lonnet::gettitle($problem{'symb'}); + $part = $problem{submitted}; $part =~ s/part_(.*)/$1/; - $content .= " - Part $part"; + unless($part eq '0') { + #add information about part number + $title .= " - Part $part"; + } my %problemhash = &Apache::lonnet::restore($problem{'symb'}); my $grade = $problemhash{"resource.$part.award"}; - return ($content, $grade); + return ($title, $grade); } +sub parse_grade_answer { + my ($shortcut) = @_; + my %answerhash = ('EXACT_ANS' => &mt('You are correct.'), + 'APPROX_ANS' => &mt('You are correct.'), + 'INCORRECT' => &mt('You are incorrect'), + ); + + foreach my $key (keys %answerhash) { + if($shortcut eq $key) { + return $answerhash{$shortcut}; + } + } + return &mt('See course contents for further information.'); + +} + + sub dumpenv { my $r = shift;