From 50d2c696cfff40d7a9a247eb3fa89bcd207613b7 Mon Sep 17 00:00:00 2001 From: pmqs 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 a4e5385..be69dab 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 = '(?{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 = '(?{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 0c60aa6..4803083 100644 --- a/t/globmapper.t +++ b/t/globmapper.t @@ -24,7 +24,7 @@ Perl $]" ) $extra = 1 if eval { require Test::NoWarnings ; import Test::NoWarnings; 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