Add a tinyglobing package
This commit is contained in:
parent
babf3f7850
commit
a40d249fd6
2 changed files with 74 additions and 0 deletions
52
ACU/Tinyglob.pm
Normal file
52
ACU/Tinyglob.pm
Normal file
|
@ -0,0 +1,52 @@
|
|||
#! /usr/bin/env perl
|
||||
|
||||
package Tinyglob;
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use Exporter 'import';
|
||||
|
||||
our @EXPORT = qw(tinyglob);
|
||||
|
||||
sub tinyglob
|
||||
{
|
||||
my @str = split("", quotemeta(shift));
|
||||
my $res = "";
|
||||
|
||||
my $metaescape = 0;
|
||||
|
||||
for (my $i = 0; $i <= $#str; $i++)
|
||||
{
|
||||
if ($str[$i] eq '\\')
|
||||
{
|
||||
$i += 1;
|
||||
if ($str[$i] eq '\\')
|
||||
{
|
||||
$metaescape = ! $metaescape;
|
||||
$res .= $str[$i];
|
||||
}
|
||||
elsif ($metaescape && ($str[$i] eq '*' || $str[$i] eq '?')) {
|
||||
$res .= $str[$i];
|
||||
$metaescape = 0;
|
||||
}
|
||||
elsif ($str[$i] eq '?') {
|
||||
$res .= '.';
|
||||
}
|
||||
elsif ($str[$i] eq '*') {
|
||||
$res .= '.*';
|
||||
}
|
||||
else {
|
||||
croak "Invalid number of \\";
|
||||
}
|
||||
}
|
||||
else {
|
||||
$res .= $str[$i];
|
||||
}
|
||||
}
|
||||
|
||||
return $res;
|
||||
}
|
||||
|
||||
1;
|
22
ACU/t/tinyglob.t
Normal file
22
ACU/t/tinyglob.t
Normal file
|
@ -0,0 +1,22 @@
|
|||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More;
|
||||
|
||||
use lib "../";
|
||||
|
||||
BEGIN {
|
||||
diag("Testing Tinyglob on perl $]");
|
||||
use_ok('ACU::Tinyglob');
|
||||
}
|
||||
|
||||
use ACU::Tinyglob;
|
||||
|
||||
is(Tinyglob::tinyglob("test"), "test");
|
||||
is(Tinyglob::tinyglob("\\*"), "\\*");
|
||||
is(Tinyglob::tinyglob("\\\\*"), "\\\\.*");
|
||||
is(Tinyglob::tinyglob("\\?"), "\\?");
|
||||
is(Tinyglob::tinyglob("\\\\?"), "\\\\.");
|
||||
|
||||
done_testing();
|
Reference in a new issue