version 1.1, 2008/09/09 13:56:44
|
version 1.4, 2009/05/15 17:53:06
|
Line 46 use Apache::lonmsg();
|
Line 46 use Apache::lonmsg();
|
use Apache::lonhomework; |
use Apache::lonhomework; |
use LONCAPA::Enrollment; |
use LONCAPA::Enrollment; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
|
use CAM::PDF; |
|
|
use strict; |
use strict; |
|
|
sub handler() { |
sub handler() { |
my $r = shift; |
my $r = shift; |
|
|
#Testen ob der Benutzer ein gültiges Cookie besitzt |
# check user permissions |
if(!&checkpermission($r)) { |
if(!&checkpermission($r)) { |
return OK; |
# stop processing |
} |
return OK; |
|
} |
|
|
$Apache::lonxml::request=$r; |
$Apache::lonxml::request=$r; |
$Apache::lonxml::debug=$env{'user.debug'}; |
$Apache::lonxml::debug=$env{'user.debug'}; |
$env{'request.uri'}=$r->uri; |
|
|
$env{'request.uri'}=$r->uri; |
$r->content_type('text/html'); |
$r->content_type('text/html'); |
$r->send_http_header(); |
$r->send_http_header(); |
$r->print(&Apache::loncommon::start_page('Upload-PDF-Form')); |
$r->print(&Apache::loncommon::start_page('Upload-PDF-Form')); |
|
|
#lade die per POST gesendenten daten in env |
#load post data into environment |
&Apache::lonacc::get_posted_cgi($r); |
&Apache::lonacc::get_posted_cgi($r); |
|
|
if($env{'form.Uploaded'} && $env{'form.file'}) { |
# if a file was upload |
#Upload-Formular wurde gesendet |
if($env{'form.Uploaded'} && $env{'form.file'}) { |
$r->print(&processPDF); |
$r->print(&processPDF); |
|
} else { |
} else { |
# print upload form |
#erster Aufruf Upload-Formular wird ausgeben |
$r->print(&get_javascripts); |
$r->print(&get_javascripts); |
$r->print(&get_uploadform); |
$r->print(&get_uploadform); |
} |
|
|
} |
#link to course-content |
|
$r->print(" <br />\n <a href='/adm/navmaps'>\n ".&mt("Navigate Contents")."\n </a>\n <br />"); |
#&dumpenv($r); #debug -> prints the environment |
|
$r->print("<br /><a href='/adm/navmaps'>".&mt("Navigate Contents")."</a><br />"); |
#&dumpenv($r); #debug -> prints the environment |
$r->print(" </body>\n</html>\n"); |
$r->print(" </body> \n</html>\n"); |
return OK; |
return OK; |
} |
} |
|
|
|
|
sub checkpermission() { |
sub checkpermission() { |
my $r = shift; |
my $r = shift; |
if (! &LONCAPA::loncgi::check_cookie_and_load_env()) { |
if (! &LONCAPA::loncgi::check_cookie_and_load_env()) { |
Line 92 sub checkpermission() {
|
Line 95 sub checkpermission() {
|
Content-type: text/html |
Content-type: text/html |
|
|
<html> |
<html> |
<head><title>Bad Cookie</title></head> |
<head> |
<body> |
<title> |
Your cookie information is incorrect. |
Bad Cookie |
</body> |
</title> |
|
</head> |
|
<body> |
|
Your cookie information is incorrect. |
|
</body> |
</html> |
</html> |
END |
END |
; |
; |
Line 108 END
|
Line 115 END
|
|
|
|
|
sub get_javascripts() { |
sub get_javascripts() { |
my $result = ' <script type="text/javascript">'; |
|
|
my $message = &mt('Please choose a PDF-File'); |
|
|
# JavaScript prüft die Datei Endung der hochzuladenden Datei |
# simple test if the upload ends with ".pdf" |
$result .= <<END |
# it's only for giving a message to the user |
|
my $result .= <<END |
|
<script type="text/javascript"> |
function checkFilename(form) { |
function checkFilename(form) { |
var fileExt = form.file.value; |
var fileExt = form.file.value; |
fileExt = fileExt.match(/[.]pdf\$/g); |
fileExt = fileExt.match(/[.]pdf\$/g); |
if(fileExt) { |
if(fileExt) { |
return true; |
return true; |
} |
} |
alert("Bitte geben Sie nur ein PDF an.") |
alert("$message"); |
return false; |
return false; |
} |
} |
|
</script> |
END |
END |
; |
; |
$result .= " </script>"; |
|
return $result; |
return $result; |
} |
} |
|
|
|
|
sub get_uploadform() { |
sub get_uploadform() { |
|
|
|
#TODO use LON-CAPA routines like pick_box or like that |
|
my %lt = &Apache::lonlocal::texthash( |
|
'title'=>'Submit a PDF-Form with problems', |
|
'chFile' => 'Choose file:', |
|
'submit'=>'Submit' |
|
); |
|
|
my $result = <<END |
my $result = <<END |
<p height='25'> |
|
</p> |
|
<form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);"> |
<form method="post" enctype="multipart/form-data" onsubmit="return checkFilename(this);"> |
<input type="hidden" name="type" value="upload"> |
<input type="hidden" name="type" value="upload" /> |
<div align="center"> |
<br /> |
<table bgcolor="#000000" width="450" cellspacing="0" cellpadding="0" border="0"> |
<b>$lt{'title'}</b> |
<tr> |
<table class="LC_pick_box"> |
<td> |
<tbody> |
<table cellspacing="1" cellpadding="2" border="0" width="100%"> |
<tr class="LC_pick_box_row"> |
<tr> |
<td class="LC_pick_box_title"> |
<td colspan="2" bgcolor="#99EEEE"> |
$lt{'chFile'} |
<b>PDF-Formular einsenden</b> |
</td> |
</td> |
<td class="LC_pick_box_value LC_odd_row"> |
</tr> |
<input type="file" name="file" id="filename" /> |
<tr> |
</td> |
<td bgcolor="#F8F8F8"> |
</tr> |
Datei auswählen |
</tbody> |
</td> |
</table> |
<td bgcolor="#F8F8F8"> |
<br /> |
<input type="file" name="file" id="filename"> |
<input type="submit" name="Uploaded" value="$lt{'submit'}" /> |
</td> |
</form> |
</tr> |
<br /> |
<tr> |
<hr /> |
<td bgcolor="#F8F8F8" colspan="2" align="right" style="margin-right: 30px;"> |
|
<input type="submit" name="Uploaded" value="Absenden" > |
|
</td> |
|
</tr> |
|
</table> |
|
</td> |
|
</tr> |
|
</table> |
|
</div> |
|
</form> |
|
END |
END |
; |
; |
return $result; |
return $result; |
} |
} |
|
|
sub processPDF { |
sub processPDF { |
my $result = (); |
my $result = (); # message for Browser |
my @pdfdata = (); |
my @pdfdata = (); # answers from PDF-Forms |
|
|
@pdfdata = &get_pdf_data; |
@pdfdata = &get_pdf_data(); # get answers from PDF-Form |
|
|
if (scalar @pdfdata) { |
if (scalar @pdfdata) { |
$result .= &grade_pdf(@pdfdata); |
&grade_pdf(@pdfdata); |
} else { |
} else { |
$result .= "<h2>".&mt("reading PDF-formfields: failed")."</h2>"; |
$result .= "<h2>".&mt("Can't find any valid PDF-formfields")."</h2>"; |
} |
} |
} |
} |
|
|
sub get_pdf_data() { |
sub get_pdf_data() { |
my @data = (); |
my @data = (); |
my $file_path = "/home/httpd/pdfspool/".time."_". |
my $pdf = CAM::PDF->new($env{'form.file'}); |
int(rand(100000)).".pdf"; |
|
my $file_data = $file_path; |
my @formFields = $pdf->getFormFieldList(); #get names of formfields |
$file_data =~ s/(.*)\..*/$1.data/; |
|
|
foreach my $field (@formFields) { |
# zwischenspeichern der hochgeladenen PDF |
my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get formfield dictonary |
my $temp_file = Apache::File->new('>'.$file_path); |
|
binmode($temp_file); |
# |
print $temp_file $env{'form.file'}; |
# this is nessesary 'cause CAM::PDF has a problem with formfieldnames which include a |
$temp_file->close; |
# 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. |
#Java PDF-Auslese-Programm starten |
if($dict->{'V'}) { |
my @command = ("java", "-jar", |
push(@data, $field."?". $dict->{'V'}{'value'}); #binding fieldname with value |
"/home/httpd/pdfspool/dumpPDF.jar", |
} |
$file_path, $file_data); |
} |
system(@command); |
|
|
|
|
|
#Einlesen der extrahierten Daten |
|
$temp_file = new IO::File->new('<'.$file_data); |
|
while (defined (my $line = $temp_file->getline())) { |
|
push(@data, $line); |
|
} |
|
$temp_file->close; |
|
undef($temp_file); |
|
|
|
#zwischengespeicherte Dateien loeschen |
|
if( -e $file_path) { |
|
# unlink($file_path); |
|
} |
|
if( -e $file_data) { |
|
# unlink($file_data); |
|
} |
|
return @data; |
return @data; |
} |
} |
|
|
Line 229 sub grade_pdf {
|
Line 218 sub grade_pdf {
|
my $debug = (); |
my $debug = (); |
|
|
$debug .= "Found: ". scalar @pdfdata." Entries \n"; |
$debug .= "Found: ". scalar @pdfdata." Entries \n"; |
$result .= "<table width='80%'>\n"; |
$result .= '<br />'; |
|
$result .= &Apache::loncommon::start_data_table(); |
|
$result .= &Apache::loncommon::start_data_table_header_row(); |
|
$result .= &mt('<b>Results of PDF-Form problems</b>'); |
|
$result .= &Apache::loncommon::end_data_table_header_row(); |
|
|
foreach my $entry (sort(@pdfdata)) { |
foreach my $entry (sort(@pdfdata)) { |
if ($entry =~ /^meta.*/) { |
if ($entry =~ /^meta.*/) { |
$debug .= 'found: metadata -> '.$entry; |
$debug .= 'found: metadata -> '.$entry . "<br />"; |
my ($label, $value) = split('\?', $entry); |
my ($label, $value) = ($entry =~ /^([^?]*)\?(.*)/); |
my ($domain, $user) = split('&', $value); |
my ($domain, $user) = split('&', $value); |
$user =~ s/(.*)\n/$1/; |
$user =~ s/(.*)\n/$1/; #TODO is that equals to chomp? |
|
|
if($user ne $env{'user.name'} or $domain ne $env{'user.domain'}) { |
if($user ne $env{'user.name'} or $domain ne $env{'user.domain'}) { |
return "<pre>".&mt('Wrong username in PDF-File').": $user $domain -> $env{'user.domain'} $env{'user.name'} </pre>"; |
return "<pre>".&mt('Wrong username in PDF-File').": $user $domain -> $env{'user.domain'} $env{'user.name'} </pre>"; |
Line 243 sub grade_pdf {
|
Line 237 sub grade_pdf {
|
|
|
} elsif($entry =~ /^upload.*/) { |
} elsif($entry =~ /^upload.*/) { |
$debug .= 'found: a problem -> '.$entry; |
$debug .= 'found: a problem -> '.$entry; |
my ($label, $value) = split('\?', $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); |
$value =~ s/(.*)\n/$1/; |
$value =~ s/(.*)\n/$1/; |
Line 259 sub grade_pdf {
|
Line 253 sub grade_pdf {
|
$problems{$symb.$part}{$HWVAL} = $value; |
$problems{$symb.$part}{$HWVAL} = $value; |
} else { |
} else { |
$problems{$symb.$part} = { 'resource' => $resource, |
$problems{$symb.$part} = { 'resource' => $resource, |
'symb' => $symb, |
'symb' => &Apache::lonenc::encrypted($symb), |
'submitted' => $part, |
'submitted' => $part, |
$submit => 'Answer', |
$submit => 'Answer', |
$HWVAL => $value}; |
$HWVAL => $value}; |
Line 268 sub grade_pdf {
|
Line 262 sub grade_pdf {
|
$debug .= 'found: -> '.$entry; |
$debug .= 'found: -> '.$entry; |
next; |
next; |
} |
} |
#$result = $debug; |
|
} |
} |
|
#$result .= $debug; |
|
|
foreach my $key (sort (keys %problems)) { |
foreach my $key (sort (keys %problems)) { |
my %problem = %{$problems{$key}}; |
my %problem = %{$problems{$key}}; |
my ($problemname, $grade) = &grade_problem(%problem); |
my ($problemname, $grade) = &grade_problem(%problem); |
$result .= "<tr style='background-color: #EEF5F5;'><td>$problemname</td><td style='background-color: "; |
|
|
$problemname =~ s/(.*)\s*-\sPart\s0/$1/; #cut part when there is only one part in problem |
|
|
|
$result .= &Apache::loncommon::start_data_table_row(); |
|
$result .= "<td>$problemname</td><td class='"; |
if($grade eq "EXACT_ANS") { |
if($grade eq "EXACT_ANS") { |
$result .= "#DDFFDD"; |
$result .= "LC_answer_correct"; |
} else { |
} else { |
$result .= "#DD5555"; |
$result .= "LC_answer_charged_try"; |
} |
} |
$result .= "'>$grade</td></tr>"; |
$result .= "'>$grade</span></td>"; |
|
$result .= &Apache::loncommon::end_data_table_row(); |
} |
} |
$result .= "\n</table>"; |
#$result .= "\n</table>"; |
|
$result .= &Apache::loncommon::end_data_table(); |
|
|
|
|
return $result; |
return $result; |
} |
} |
Line 293 sub grade_problem {
|
Line 293 sub grade_problem {
|
|
|
my ($content) = &Apache::loncommon::ssi_with_retries('/res/'. |
my ($content) = &Apache::loncommon::ssi_with_retries('/res/'. |
$problem{'resource'}, 5, %problem); |
$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 =~ s/.*class="LC_current_location".*>(.*)<\/td>.*/$1/g; |
$content = $1; |
$content = $1; |
|
|