[groff] 11/12: Fix Savannah #66504 (backport to Perl 5.8).

[G. Branden Robinson]

gbranden pushed a commit to branch master
in repository groff.

commit b658dd996be81adf5fe50c2d89167572037e74f2
Author: Deri James <deri@chuzzlewit.myzen.co.uk>
AuthorDate: Thu Dec 5 19:01:41 2024 +0000

    Fix Savannah #66504 (backport to Perl 5.8).
    
    Backport gropdf and pdfpic.tmac to Perl 5.8.
    
    * src/devices/gropdf/gropdf.pl:
    * tmac/pdfpic.tmac (pdfpic@get-image-dimensions): Use Perl 5.8-
      ompatible regular expressions.
    
    * src/devices/gropdf/gropdf.pl: Cope with pre-Perl-5.12 semantics for
      applying the `length` built-in function to an undefined scalar.
    
    Fixes <https://savannah.gnu.org/bugs/?66504>.
---
 ChangeLog                    | 14 ++++++++++++++
 src/devices/gropdf/gropdf.pl | 21 ++++++++++++++-------
 tmac/pdfpic.tmac             |  4 ++--
 3 files changed, 30 insertions(+), 9 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 721d4fa00..f7dcd4aec 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2024-12-05  Deri James  <deri@chuzzlewit.myzen.co.uk>
+
+       Backport gropdf and pdfpic.tmac to Perl 5.8.
+
+       * src/devices/gropdf/gropdf.pl:
+       * tmac/pdfpic.tmac (pdfpic@get-image-dimensions): Use Perl
+       5.8-compatible regular expressions.
+
+       * src/devices/gropdf/gropdf.pl: Cope with pre-Perl-5.12
+       semantics for applying the `length` built-in function to an
+       undefined scalar.
+
+       Fixes <https://savannah.gnu.org/bugs/?66504>.
+
 2024-12-05  G. Branden Robinson <g.branden.robinson@gmail.com>
 
        Document new CJK/UTF-16 font support features.
diff --git a/src/devices/gropdf/gropdf.pl b/src/devices/gropdf/gropdf.pl
index 754c4904b..fcad03c6f 100644
--- a/src/devices/gropdf/gropdf.pl
+++ b/src/devices/gropdf/gropdf.pl
@@ -486,7 +486,7 @@ my $term="\n";
 my @bl;
 my %seac;
 my $thisfnt;
-my $parcln=qr/\[[^\]]*?\]|(?<term>.)((?!\g{term}).)*\g{term}/;
+my $parcln=qr/\[[^\]]*?\]|(.)((?!\1).)*\1/;
 my $parclntyp=qr/(?:[\d\w]|\([+-]?[\S]{2}|$parcln)/;
 
 if (!GetOptions('F=s' => \$fd, 'I=s' => \@idirs, 'l' => \$frot,
@@ -1697,10 +1697,16 @@ sub do_x
                    else
                    {
                        my $dim=`( identify $FDnm 2>/dev/null || file $FDnm )`;
-                       $dim=~m/(?:(?:[,=A-Z]|JP2) 
(?<w>\d+)\s*x\s*(?<h>\d+))|(?:height=(?<h>\d+).+width=(?<w>\d+))/;
-
-                       $info->{ImageWidth}=$+{w};
-                       $info->{ImageHeight}=$+{h};
+                       if ($dim=~m/(?:[,=A-Z]|JP2) (\d+)\s*x\s*(\d+)/)
+                       {
+                           $info->{ImageWidth}=$1;
+                           $info->{ImageHeight}=$2;
+                       }
+                       elsif ($dim=~m/height=(\d+).+width=(\d+)/)
+                       {
+                           $info->{ImageWidth}=$2;
+                           $info->{ImageHeight}=$1;
+                       }
 
                        if ($dim=~m/JPEG \d+x|JFIF/)
                        {
@@ -2009,7 +2015,8 @@ sub do_x
                my ($S,$P,$St);
 
                $xprm[2]='' if !$xprm[2] or $xprm[2] eq '.';
-               $xprm[3]='' if defined($xprm[3]) and $xprm[3] eq '.';
+               $xprm[3]='' if !defined($xprm[3]) or $xprm[3] eq '.';
+               $xprm[4]='' if !defined($xprm[4]);
 
                if ($xprm[2] and index('DRrAa',substr($xprm[2],0,1)) == -1)
                {
@@ -2037,7 +2044,7 @@ sub do_x
                    my $label={};
                    $label->{S} = "/$S" if $S;
                    $label->{P} = "($P)" if length($P);
-                   $label->{St} = $St if length($St);
+                   $label->{St} = $St if $St and length($St);
 
                    $#PageLabel=$pginsert if $pginsert > $#PageLabel;
                    splice(@PageLabel,$pginsert,0,$label);
diff --git a/tmac/pdfpic.tmac b/tmac/pdfpic.tmac
index a847fde11..6d6f65ca6 100644
--- a/tmac/pdfpic.tmac
+++ b/tmac/pdfpic.tmac
@@ -70,13 +70,13 @@
 .de pdfpic@get-image-dimensions
 .  ds pdfpic*command pdfinfo \$1 2>/dev/null \"
 .  eo
-.  as pdfpic*command  | perl -ne 'print qq(. \\\\R\@pdfpic*width $+{w}p@ 
\\\\R\@pdfpic*height $+{h}p\@) if 
m/Page\s+size:\s+(?<w>[\d.]+)\sx\s(?<h>[\d.]+)/si;'
+.  as pdfpic*command  | perl -ne 'print qq(. \\\\R\@pdfpic*width ${1}p@ 
\\\\R\@pdfpic*height ${2}p\@) if m/Page\s+size:\s+([\d.]+)\sx\s([\d.]+)/si;'
 .  ec
 .  pso \*[pdfpic*command]
 .  if !r pdfpic*width \{\
 .    ds pdfpic*command ( identify \$1 2>/dev/null || file \$1 ) \"
 .    eo
-.    as pdfpic*command  | perl -ne 'print qq(. \\\\R\@pdfpic*width $+{w}p@ 
\\\\R\@pdfpic*height $+{h}p\@),qq(\\n) if m/(?:(?:[,=A-Z]|JP2) 
(?<w>\d+)\s*x\s*(?<h>\d+))|(?:height=(?<h>\d+).+width=(?<w>\d+))/;'
+.    as pdfpic*command  | perl -ne 'print qq(. \\\\R\@pdfpic*width ${1}p@ 
\\\\R\@pdfpic*height ${2}p\@),qq(\\n) if m/(?:[,=A-Z]|JP2) (\d+)\s*x\s*(\d+)/';
 .    ec
 .    pso \*[pdfpic*command]
 .  \}