[LON-CAPA-cvs] cvs: loncom /homework optionresponse.pm /interface lonpdfupload.pm lontiny.pm /xml lonxml.pm
raeburn
raeburn at source.lon-capa.org
Sun Feb 22 18:27:03 EST 2026
raeburn Sun Feb 22 23:27:03 2026 EDT
Modified files:
/loncom/interface lontiny.pm
/loncom/homework optionresponse.pm
/loncom/xml lonxml.pm
/loncom/interface lonpdfupload.pm
Log:
- Bug 6121
- Support checkbox mode for optionresponse in PDF Forms.
- Expand encoding checks for PDF form fields and submitted values to
include iso-2022-jp, cp1252, and MacRoman.
-------------- next part --------------
Index: loncom/interface/lontiny.pm
diff -u loncom/interface/lontiny.pm:1.8.2.6 loncom/interface/lontiny.pm:1.8.2.7
--- loncom/interface/lontiny.pm:1.8.2.6 Sat Feb 10 14:24:46 2024
+++ loncom/interface/lontiny.pm Thu Jan 16 21:42:12 2025
@@ -2,7 +2,7 @@
# Extract domain, courseID, and symb from a shortened URL,
# and switch role to a role in designated course.
#
-# $Id: lontiny.pm,v 1.8.2.6 2024/02/10 14:24:46 raeburn Exp $
+# $Id: lontiny.pm,v 1.8.2.7 2025/01/16 21:42:12 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -99,7 +99,7 @@
}
if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
# Check for ttoken
- my $newlauncher = &launch_check($r->uri,$symb);
+ my $newlauncher = &launch_check($r->uri,$symb,$cdom,$cnum);
my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
if (&Apache::lonnet::is_on_map($url)) {
my $realuri;
@@ -307,7 +307,7 @@
}
sub launch_check {
- my ($linkuri,$symb) = @_;
+ my ($linkuri,$symb,$cdom,$cnum) = @_;
my ($linkprotector,$linkproturi,$linkprotexit,$linkprotpbid,$linkprotpburl,
$linkkey,$newlauncher,$prevlaunch);
if ($env{'form.ttoken'}) {
@@ -447,6 +447,11 @@
}
if ($linkprotector) {
&Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
+ if ($linkprotpburl && $linkprotpbid) {
+ my ($res,$error) = &store_passback_info($cdom,$cnum,$linkuri,$linkprotector,
+ $scope,$symb,$linkprotpbid,$linkprotpburl,
+ $currdeeplinklogin);
+ }
} elsif ($env{'request.linkprot'}) {
&Apache::lonnet::delenv('request.linkprot');
}
@@ -525,6 +530,68 @@
return $newlauncher;
}
+#
+# Store linkprotpburl and linkprotpbid in user's nohist_$cid_linkprot_pb.db
+# $linkuri\0$linkprotector\0$scope = [$linkprotpbid,$linkprotpburl]
+# Separately store $symb in course's nohist_linkprot_passback.db
+# which should trigger passback:
+# $symb => {$linkuri\0$linkprotector\0$scope => 1};
+#
+
+sub store_passback_info {
+ my ($cdom,$cnum,$linkuri,$linkprotector,$scope,$symb,
+ $linkprotpbid,$linkprotpburl,$currdeeplinklogin) = @_;
+ my $key = join("\0",($linkuri,$linkprotector,$scope));
+ my $namespace = 'nohist_'.$cdom.'_'.$cnum.'_linkprot_pb';
+ if ($linkuri eq $currdeeplinklogin) {
+ my %pbinfo = &Apache::lonnet::get($namespace,[$key]);
+ if (ref($pbinfo{$key}) eq 'ARRAY') {
+ if (($pbinfo{$key}[0] eq $linkprotpbid) &&
+ ($pbinfo{$key}[1] eq $linkprotpburl)) {
+ return ('ok');
+ }
+ }
+ }
+ my $now = time;
+ my $result = &Apache::lonnet::cput($namespace,{$key => [$linkprotpbid,$linkprotpburl]});
+ my $error;
+ if (($result eq 'ok') || ($result eq 'con_delayed')) {
+ $namespace = 'nohist_linkprot_passback';
+ my %triggers = &Apache::lonnet::get($namespace,[$symb],$cdom,$cnum);
+ my $newtrigger;
+ if ((exists($triggers{$symb})) && (ref($triggers{$symb}) eq 'HASH')) {
+ unless (exists($triggers{$symb}{$key})) {
+ $newtrigger = 1;
+ }
+ } else {
+ $newtrigger = 1;
+ }
+ if ($newtrigger) {
+ my ($lockhash,$tries,$gotlock);
+ $lockhash = {
+ lock => $env{'user.name'}.
+ ':'.$env{'user.domain'},
+ };
+ $tries = 0;
+ $gotlock = &Apache::lonnet::newput($namespace,$lockhash,$cdom,$cnum);
+ while (($gotlock ne 'ok') && ($tries<10)) {
+ $tries ++;
+ sleep (0.1);
+ $gotlock = &Apache::lonnet::newput($namespace,$lockhash,$cdom,$cnum);
+ }
+ if ($gotlock eq 'ok') {
+ %triggers = &Apache::lonnet::get($namespace,[$symb],$cdom,$cnum);
+ $triggers{$symb}{$key} = 1;
+ $result = &Apache::lonnet::cput($namespace,{$symb => $triggers{$symb}},$cdom,$cnum);
+ my $dellockoutcome = &Apache::lonnet::del($namespace,['lock'],$cdom,$cnum);
+ } else {
+ $error = 'nolock';
+ }
+ }
+ }
+ return ($result,$error);
+}
+
sub do_redirect {
my ($r,$destination,$linkprot) = @_;
my $windowname = 'loncapaclient';
Index: loncom/homework/optionresponse.pm
diff -u loncom/homework/optionresponse.pm:1.206 loncom/homework/optionresponse.pm:1.207
--- loncom/homework/optionresponse.pm:1.206 Sat Feb 21 16:03:57 2026
+++ loncom/homework/optionresponse.pm Sun Feb 22 23:27:02 2026
@@ -1,7 +1,7 @@
# LearningOnline Network with CAPA
# option list style responses
#
-# $Id: optionresponse.pm,v 1.206 2026/02/21 16:03:57 raeburn Exp $
+# $Id: optionresponse.pm,v 1.207 2026/02/22 23:27:02 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -610,10 +610,20 @@
sub check_box_opt {
my ($target,$checkboxvalue, at opt)=@_;
-# Check if we are in checkbox mode: checkboxvalue specified, on web, only two options.
-# If so, return "checked" value
+# Check if we are in checkbox mode: checkboxvalue specified, only two options.
if ($#opt!=1) { return ''; }
+ if (($target eq 'tex') && ($env{'form.pdfFormFields'} eq 'yes')
+ && ($Apache::inputtags::status[-1] eq 'CAN_ANSWER')) {
+# If this is tex for pdfFormFields -- return "checked" and "unchecked" values.
+ if (wantarray) {
+ ($checkboxvalue eq $opt[0]? return ($checkboxvalue,$opt[1]) :
+ return ($checkboxvalue,$opt[0]) );
+ } else {
+ return $checkboxvalue;
+ }
+ }
unless (($target eq 'web') || ($target eq 'grade')) { return ''; }
+# If on web, return "checked" value
return $checkboxvalue;
}
@@ -729,13 +739,13 @@
my $checkboxopt;
if ($target eq 'web') {
$checkboxopt=&check_box_opt($target,$checkboxvalue, at opt);
+ if ($checkboxopt && (!$no_tfprompt)) {
+ $result.='<br />'.
+ ($checkboxchoices?&mt('Choices: ').'<b>'.$opt[0].','.$opt[1].'</b>. ':'').
+ &mt('Select all that are [_1].','<b>'.$checkboxopt.'</b>');
+ }
}
- if ($checkboxopt && (!$no_tfprompt)) {
- $result.='<br />'.
- ($checkboxchoices?&mt('Choices: ').'<b>'.$opt[0].','.$opt[1].'</b>. ':'').
- &mt('Select all that are [_1].','<b>'.$checkboxopt.'</b>');
- }
- my $fieldname;
+ my ($fieldname,$checkboxoff);
if ($target eq 'tex' and $env{'form.pdfFormFields'} eq 'yes'
&& $Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
$fieldname = &Apache::lonenc::encrypted($env{'request.symb'},1);
@@ -749,7 +759,26 @@
$escpart =~ s{_}{\\_}g;
my $escres = $Apache::inputtags::response['-1'];
$escres =~ s{_}{\\_}g;
- $fieldname .= '\&part\_'.$escpart.'\&optionresponse\&HWVAL\_'.$escres.':';
+ $fieldname .= '\&part\_'.$escpart.'\&optionresponse';
+ ($checkboxopt,$checkboxoff)=&check_box_opt($target,$checkboxvalue, at opt);
+
+# To support checkbox mode for optionresponse, include a hidden form
+# field in the PDF with the value set to the option in effect for
+# the unchecked checkboxes. When the submitted form data are processed
+# the values for any unchecked boxes (each null value in received form
+# data) are all set to the value retrieved from the hidden form field.
+
+ if ($checkboxopt) {
+ my $hidden = $fieldname.'\&HWHDN\_'.$escres.':';
+ $result .= &Apache::lonxml::print_pdf_hidden_textfield($hidden.'0',$checkboxoff).' ';
+ if (!$no_tfprompt) {
+ $result .= ($checkboxchoices?&mt('Choices: ').
+ '\textbf{'.$opt[0].','.$opt[1].'}. ':'').
+ &mt('Select all that are [_1].','\textbf{'.$checkboxopt.'}').
+ '\\\\';
+ }
+ }
+ $fieldname .= '\&HWVAL\_'.$escres.':';
}
foreach $name (@whichopt) {
if ($target eq 'web') {
@@ -766,7 +795,12 @@
if($target eq 'tex' and $env{'form.pdfFormFields'} eq 'yes'
&& $Apache::inputtags::status[-1] eq 'CAN_ANSWER') {
- $optionlist = &Apache::lonxml::print_pdf_start_combobox($fieldname.$temp);
+ if ($checkboxopt) {
+ $optionlist = '\vskip 4 mm'.
+ &Apache::lonxml::print_pdf_checkbox($fieldname.$temp,$checkboxopt);
+ } else {
+ $optionlist = &Apache::lonxml::print_pdf_start_combobox($fieldname.$temp);
+ }
}
foreach my $option (@opt) {
@@ -775,7 +809,9 @@
if ($target eq 'tex' && $env{'form.pdfFormFields'} eq 'yes'
&& $Apache::inputtags::status[-1] eq 'CAN_ANSWER'
&& $Apache::lonhomework::type ne 'exam') {
- $optionlist .= &Apache::lonxml::print_pdf_add_combobox_option($option);
+ unless ($checkboxopt) {
+ $optionlist .= &Apache::lonxml::print_pdf_add_combobox_option($option);
+ }
} else {
$optionlist.="<option value='".$escopt."' selected=\"selected\">$option</option>\n";
}
@@ -783,7 +819,9 @@
if ($target eq 'tex' && $env{'form.pdfFormFields'} eq 'yes'
&& $Apache::inputtags::status[-1] eq 'CAN_ANSWER'
&& $Apache::lonhomework::type ne 'exam') {
- $optionlist .= &Apache::lonxml::print_pdf_add_combobox_option($option);
+ unless ($checkboxopt) {
+ $optionlist .= &Apache::lonxml::print_pdf_add_combobox_option($option);
+ }
} else {
$optionlist.="<option value='".$escopt."'>$option</option>\n";
}
@@ -892,7 +930,13 @@
&& $Apache::inputtags::status[-1] eq 'CAN_ANSWER'
&& $Apache::lonhomework::type ne 'exam') {
$text =~ s/\\item//m;
- $result .= " $optionlist ". &Apache::lonxml::print_pdf_end_combobox($text).'\strut \\\\';
+ $result .= " $optionlist ";
+ if ($checkboxopt) {
+ $result .= $text;
+ } else {
+ $result .= &Apache::lonxml::print_pdf_end_combobox($text);
+ }
+ $result .= '\strut \\\\';
$temp++;
}
$displayoptionintex=0;
Index: loncom/xml/lonxml.pm
diff -u loncom/xml/lonxml.pm:1.579 loncom/xml/lonxml.pm:1.580
--- loncom/xml/lonxml.pm:1.579 Sat Feb 21 16:03:58 2026
+++ loncom/xml/lonxml.pm Sun Feb 22 23:27:03 2026
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# XML Parser Module
#
-# $Id: lonxml.pm,v 1.579 2026/02/21 16:03:58 raeburn Exp $
+# $Id: lonxml.pm,v 1.580 2026/02/22 23:27:03 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2526,6 +2526,35 @@
.$fieldname.'}{10bp}{10bp}{'.$value.'}';
}
+=pod
+
+=item &print_pdf_checkbox(fieldname, value)
+
+Returns a latexline to generate a PDF-Form-checkBox.
+
+$fieldname: PDF internalname of the checkbox
+$value: Value of checkbox
+
+=cut
+sub print_pdf_checkbox {
+ my ($fieldname, $value) = @_;
+ return '\checkBox{'.$fieldname.'}{10bp}{10bp}{'.$value.'}';
+}
+
+=pod
+
+=item &print_pdf_hidden_textfield(fieldname, value)
+
+Returns a latexline to generate a generic PDF-Form-hiddenField
+
+$fieldname: PDF internalname of the hidden field
+$value: Value of the hidden field
+
+=cut
+sub print_pdf_hidden_textfield {
+ my ($fieldname, $value) = @_;
+ return '\textField[\F{\FHidden}\F{-\FPrint}\V{'.$value.'}]{'.$fieldname.'}{0mm}{0mm}';
+}
=pod
@@ -2586,7 +2615,7 @@
=pod
-=item &print_pdf_hiddenField(fieldname, user, domain)
+=item &print_pdf_hiddenfield(fieldname, user, domain)
Returns a latexline to generate a PDF-Form-hiddenField with userdata.
Index: loncom/interface/lonpdfupload.pm
diff -u loncom/interface/lonpdfupload.pm:1.31 loncom/interface/lonpdfupload.pm:1.32
--- loncom/interface/lonpdfupload.pm:1.31 Sat Feb 21 16:03:57 2026
+++ loncom/interface/lonpdfupload.pm Sun Feb 22 23:27:03 2026
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# PDF Form Upload Handler
#
-# $Id: lonpdfupload.pm,v 1.31 2026/02/21 16:03:57 raeburn Exp $
+# $Id: lonpdfupload.pm,v 1.32 2026/02/22 23:27:03 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -207,26 +207,84 @@
my @formFields = $pdf->getFormFieldList(); #get names of form fields
foreach my $field (@formFields) {
+ my $value;
my $dict = $pdf->getFormFieldDict($pdf->getFormField($field)); # get form field dictonary
- # 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'}) {
- my $decoder = Encode::Guess->guess($field);
- if (ref($decoder)) {
- $field = $decoder->decode($field);
- }
- push(@data, $field."?". $dict->{'V'}{'value'}); #binding fieldname with value
+# Checking for $dict->{'V'}, present in rev. 1.19 to rev. 1.31
+# to handle fragmentary names from form fieldnames containing
+# a dot, eliminated for rev. 1.32 as fieldnames now only contain
+# encrypted symbs which will not contain any dots.
+# This allows checkboxes which are unchecked to be included
+# as form fields to support checkbox mode for optionresponse.
+
+ if ((ref($dict)) && (ref($dict->{'V'}))) {
+ $value = $dict->{'V'}{'value'};
+ }
+ $field = &check_encoding($field);
+ if ($value ne '') {
+ $value = &check_encoding($value);
}
+ push(@data, $field."?". $value); #binding fieldname with value
}
}
return @data;
}
+sub check_encoding {
+ my ($data) = @_;
+
+# ps2pdf13 used by LON-CAPA to output PDFs produces PDF format 1.3.
+# For pre-PDF 2.0, Adobe Acrobat attempts to use "best host encoding" for
+# values being submitted, which will depend on characters entered by the user.
+#
+# Encode::Guess checks ascii, utf8 and UTF-16/32 with BOM, by default
+
+ my $decoder = Encode::Guess->guess($data);
+ if (ref($decoder)) {
+ return Encode::encode('UTF-8',$decoder->decode($data));
+ } else {
+ # If encoding yet to be guessed, reuse code from pre_xml.pm
+ # try iso-2022-jp first
+ $decoder = Encode::Guess->guess($data, 'iso-2022-jp');
+ if (ref($decoder)) {
+ return Encode::encode('UTF-8',$decoder->decode($data));
+ } else {
+
+# NOTE: cp1252 is identical to iso-8859-1 but with additional characters in range 128-159
+# instead of control codes. Assume these control codes absent, so test for cp1252.
+# Use frequent non-ASCII characters to distinguish between cp1252 and MacRoman
+# (languages: mostly German, Spanish, Portuguese)
+
+ my $decoded_windows = Encode::decode('cp1252', $data);
+ my $decoded_mac = Encode::decode('MacRoman', $data);
+
+# à has been removed because it conflicts with ’ and ’ is more frequent
+# ± has been removed because it is, suprisingly, the same code in both encodings !
+
+ my $score_windows = $decoded_windows =~ tr/ßáà äâãçéèêëñóöôõúüÄÉÑÖÜ¿¡‘’“â€Â °½–—…§//;
+ my $score_mac = $decoded_mac =~ tr/ßáà äâãçéèêëñóöôõúüÄÉÑÖÜ¿¡‘’“â€Â °½–—…§//;
+ # check newlines too (\r on MacOS < X, \r\n on Windows)
+ my $ind_cr = index($data, "\r");
+ if ($ind_cr != -1) {
+ if (substr($data, $ind_cr + 1, 1) eq "\n") {
+ $score_windows++;
+ } else {
+ $score_mac++;
+ }
+ }
+ if ($score_windows >= $score_mac) {
+ return Encode::encode('UTF-8',$decoded_windows);
+ } else {
+ return Encode::encode('UTF-8',$decoded_mac);
+ }
+ }
+ }
+}
+
sub grade_pdf {
my @pdfdata = @_;
- my ($result,$meta,%grades,%problems,%foreigncourse,%mismatchuser,%hwvals,$debug);
+ my ($result,$meta,%grades,%problems,%foreigncourse,%mismatchuser,
+ %types,%checkboxoff,$debug);
my $navmap = Apache::lonnavmaps::navmap->new();
if (!defined($navmap)) {
@@ -296,6 +354,10 @@
if ($type eq 'radiobuttonresponse' && $value eq 'Off' ) {
next;
}
+ if (($type eq 'optionresponse') && ($HWVAL =~ /^HWHDN([^:]+):0$/)) {
+ $checkboxoff{$symb.$part}{'HWVAL'.$1} = $value;
+ next;
+ }
my $submit = $part;
$submit =~ s/part_(.*)/submit_$1/;
@@ -325,7 +387,7 @@
$problems{$symb.$part}{'inputid'} = $input_id;
}
}
- $hwvals{$symb.$part}{$HWVAL} = 1;
+ $types{$symb.$part}{$HWVAL} = $type;
} else {
$debug .= 'found: -> '.$entry;
next;
@@ -345,8 +407,8 @@
foreach my $key (sort(keys(%problems))) {
my %problem = %{$problems{$key}};
- if (ref($hwvals{$key}) eq 'HASH') {
- foreach my $hwval (keys(%{$hwvals{$key}})) {
+ if (ref($types{$key}) eq 'HASH') {
+ foreach my $hwval (keys(%{$types{$key}})) {
if (ref($problem{$hwval}) eq 'HASH') {
my %valhash = %{$problem{$hwval}};
my %ordered;
@@ -360,6 +422,14 @@
push(@{$problem{$hwval}},$ordered{$digit});
}
}
+ } elsif (ref($checkboxoff{$key}) eq 'HASH') {
+ if (($problem{$hwval} eq '') &&
+ ($types{$key}{$hwval} eq 'optionresponse')) {
+ my ($hwvalprefix) = split(/:/,$hwval);
+ if ($checkboxoff{$key}{$hwvalprefix} ne '') {
+ $problem{$hwval} = $checkboxoff{$key}{$hwvalprefix};
+ }
+ }
}
}
}
More information about the LON-CAPA-cvs
mailing list