Archived
1
0
Fork 0

Add a tinyglobing package

This commit is contained in:
Mercier Pierre-Olivier 2013-09-26 08:58:49 +02:00
parent babf3f7850
commit a40d249fd6
2 changed files with 74 additions and 0 deletions

52
ACU/Tinyglob.pm Normal file
View 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
View 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();