perl-IO-Compress/RHEL-180415.patch

From 2066c1edc2f5b4cf97a1b66536d552fa225b4aaa Mon Sep 17 00:00:00 2001
From: pmqs <pmqs@cpan.org>
Date: Sat, 16 May 2026 17:48:34 +0100
Subject: [PATCH] remove use of eval in globmapper. #73

---
 lib/File/GlobMapper.pm | 52 ++++++++++++++++++++++++++++++++++--------
 t/globmapper.t         | 52 +++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 94 insertions(+), 10 deletions(-)

diff --git a/lib/File/GlobMapper.pm b/lib/File/GlobMapper.pm
index 53f957a..6454bc4 100644
--- a/lib/File/GlobMapper.pm
+++ b/lib/File/GlobMapper.pm
@@ -29,6 +29,11 @@ our ($VERSION, @EXPORT_OK);
 $VERSION = '1.001';
 @EXPORT_OK = qw( globmap );
 
+our $BEGIN_DELIM = "\xFF";
+our $END_DELIM   = "\xFE";
+our $BACKSLASH_ESC = "\xFD";
+our $HASH_ESC = "\xFC";
+our $STAR_ESC = "\xFB";
 
 our ($noPreBS, $metachars, $matchMetaRE, %mapping, %wildCount);
 $noPreBS = '(?<!\\\)' ; # no preceding backslash
@@ -310,14 +315,23 @@ sub _parseOutputGlob
     }
 
     my $noPreBS = '(?<!\\\)' ; # no preceding backslash
-    #warn "noPreBS = '$noPreBS'\n";
+    my $noPreESC = '(?<![${BEGIN_DELIM}])' ; # no preceding backslash
 
-    #$string =~ s/${noPreBS}\$(\d)/\${$1}/g;
-    $string =~ s/${noPreBS}#(\d)/\${$1}/g;
-    $string =~ s#${noPreBS}\*#\${inFile}#g;
-    $string = '"' . $string . '"';
+    # escape any use of the delimiter symbols
+    # $string =~ s/(${BEGIN_DELIM}|${END_DELIM}|${BACKSLASH_ESC})/$1$1/g;
+
+    # escape \# and \*
+    $string =~ s/\\#/${HASH_ESC}/g;
+    $string =~ s/\\\*/${STAR_ESC}/g;
+
+    # Transform "#3" to BEGIN_DELIM 3 END_DELIM
+    $string =~ s/${noPreESC}#(\d)/${BEGIN_DELIM}${1}${END_DELIM}/g;
+
+    $string =~ s#\*#${BEGIN_DELIM}${END_DELIM}#g;
+
+    # print "INPUT  '$self->{InputPattern}'\n";
+    # print "OUTPUT '$self->{OutputGlob}' => '$string'\n";
 
-    #print "OUTPUT '$self->{OutputGlob}' => '$string'\n";
     $self->{OutputPattern} = $string ;
 
     return 1 ;
@@ -335,11 +349,31 @@ sub _getFiles
         next if $inFiles{$inFile} ++ ;
 
         my $outFile = $inFile ;
+        my @matches ;
+
+        my $noPreESC = '(?<![${BEGIN_DELIM}])' ; # no preceding backslash
 
-        if ( $inFile =~ m/$self->{InputPattern}/ )
+        if (@matches = ($inFile =~ m/$self->{InputPattern}/ ))
         {
-            no warnings 'uninitialized';
-            eval "\$outFile = $self->{OutputPattern};" ;
+            $outFile = $self->{OutputPattern};
+            my $ix = 1;
+
+            # get the filename glob
+            $outFile =~ s/${noPreESC}${BEGIN_DELIM}${END_DELIM}/$inFile/g;
+
+            # now each of the #1, #2,...
+            for my $pattern (@matches)
+            {
+                $outFile =~ s/${noPreESC}${BEGIN_DELIM}${ix}${END_DELIM}/$pattern/g;
+
+                ++ $ix;
+            }
+
+            # unescape
+            $outFile =~ s/${BEGIN_DELIM}${BEGIN_DELIM}/${BEGIN_DELIM}/g;
+            $outFile =~ s/${END_DELIM}${END_DELIM}/${END_DELIM}/g;
+            $outFile =~ s/${HASH_ESC}/#/g;
+            $outFile =~ s/${STAR_ESC}/*/g;
 
             if (defined $outInMapping{$outFile})
             {
diff --git a/t/globmapper.t b/t/globmapper.t
index 75fa768..842562f 100644
--- a/t/globmapper.t
+++ b/t/globmapper.t
@@ -24,7 +24,7 @@ Perl $]" )
     $extra = 1
         if eval { require Test::NoWarnings ;  Test::NoWarnings->import; 1 };
 
-    plan tests => 68 + $extra ;
+    plan tests => 76 + $extra ;
 
     use_ok('File::GlobMapper') ;
 }
@@ -290,6 +290,56 @@ Perl $]" )
         ], "  got mapping";
 }
 
+{
+    title "check escaping";
+
+    my $tmpDir ;#= 'td';
+    my $lex = LexDir->new( $tmpDir );
+
+    my $BEGIN_DELIM = "\xFF";
+    my $END_DELIM   = "\xFE";
+
+    #mkdir $tmpDir, 0777 ;
+
+    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
+
+    my $map = File::GlobMapper::globmap("$tmpDir/*b*.tmp", "$tmpDir/X-${BEGIN_DELIM}#2-#1${END_DELIM}-X");
+    ok $map, "  got map"
+        or diag $File::GlobMapper::Error ;
+
+    is @{ $map }, 3, "  returned 3 maps";
+    is_deeply $map,
+        [ [map { "$tmpDir/$_" } ("abc1.tmp", "X-${BEGIN_DELIM}c1-a${END_DELIM}-X")],
+          [map { "$tmpDir/$_" } ("abc2.tmp", "X-${BEGIN_DELIM}c2-a${END_DELIM}-X")],
+          [map { "$tmpDir/$_" } ("abc3.tmp", "X-${BEGIN_DELIM}c3-a${END_DELIM}-X")],
+        ], "  got mapping";
+}
+
+{
+    title "check backslash escaping";
+
+    my $tmpDir ;#= 'td';
+    my $lex = LexDir->new( $tmpDir );
+
+    my $BEGIN_DELIM = "\xFF";
+    my $END_DELIM   = "\xFE";
+
+    #mkdir $tmpDir, 0777 ;
+
+    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
+
+    my $map = File::GlobMapper::globmap("$tmpDir/*b*.tmp", $tmpDir . '/X-#2-\\#1\\*-X');
+    ok $map, "  got map"
+        or diag $File::GlobMapper::Error ;
+
+    is @{ $map }, 3, "  returned 3 maps";
+    is_deeply $map,
+        [ [map { "$tmpDir/$_" } ("abc1.tmp", "X-c1-#1*-X")],
+          [map { "$tmpDir/$_" } ("abc2.tmp", "X-c2-#1*-X")],
+          [map { "$tmpDir/$_" } ("abc3.tmp", "X-c3-#1*-X")],
+        ], "  got mapping";
+}
+
 # TODO
 # test each of the wildcard metacharacters can be mapped to the output filename
 #
-- 
2.52.0