epita-std
/
ACU
Archived
1
0
Fork 0

Use Text::Glob instead of ACU::Tinyglob

This commit is contained in:
Mercier Pierre-Olivier 2013-11-23 17:21:46 +01:00
parent f8e5d1b5c0
commit f271f36203
4 changed files with 6 additions and 134 deletions

View File

@ -7,8 +7,6 @@ use strict;
use warnings;
use XML::LibXML;
use ACU::Tinyglob;
sub new
{
my $class = shift;
@ -185,6 +183,7 @@ use warnings;
use Carp;
use Safe;
use List::Util "reduce";
use Text::Glob qw( glob_to_regex );
use XML::LibXML;
sub new ($$$;$$)
@ -349,7 +348,7 @@ sub compute ($$$;$$$)
{
eval
{
my $glob = Tinyglob::tinyglob($ref);
my $glob = glob_to_regex($ref);
if ($glob ne $ref)
{
my $value = 0;

View File

@ -1,67 +0,0 @@
#! /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 $orig = shift;
my @str = split("", quotemeta($orig));
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 .= '.*';
}
elsif ($metaescape) {
$res .= $str[$i];
$metaescape = 0;
}
else {
$res .= "\\".$str[$i];
}
}
else {
$res .= $str[$i];
}
}
return $res;
}
sub match
{
my $glob = tinyglob(shift);
my $str = shift;
say $glob;
return $str =~ /$glob/;
}
1;

View File

@ -1,60 +0,0 @@
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("\\\\?"), "\\\\.");
is(Tinyglob::tinyglob("\\."), "\\.");
is(Tinyglob::tinyglob("\\\\."), "\\\\\\.");
is(Tinyglob::tinyglob("a*b?"), "a.*b.");
is(Tinyglob::tinyglob("a-b"), "a\\-b");
ok(! Tinyglob::match("?", ""));
ok(! Tinyglob::match("b", "a"));
ok(! Tinyglob::match("b*", "a"));
ok(! Tinyglob::match("b?", "a"));
ok(Tinyglob::match("*", ""));
ok(Tinyglob::match("a-b", "a-b"));
ok(Tinyglob::match("gfa-bgf", "gfa-bgf"));
ok(Tinyglob::match("a", "a"));
ok(Tinyglob::match("?", "a"));
ok(Tinyglob::match("*", "a"));
ok(Tinyglob::match("ab", "ab"));
ok(Tinyglob::match("?b", "ab"));
ok(Tinyglob::match("*b", "ab"));
ok(Tinyglob::match("*", "ab"));
ok(Tinyglob::match("b?", "ba"));
ok(Tinyglob::match("b*", "ba"));
ok(Tinyglob::match("*", "abcdef"));
ok(Tinyglob::match("a?b", "acb"));
ok(Tinyglob::match("a*b", "acb"));
ok(Tinyglob::match("a*b", "acdefb"));
ok(Tinyglob::match("a*b*", "acdefblkjgd"));
ok(! Tinyglob::match("a?b*", "acdefblkjgd"));
ok(Tinyglob::match("a?b*", "acblkjgd"));
ok(Tinyglob::match("a?b*", "abblkjgd"));
#ok(! Tinyglob::match("a*b?", "abblkjgd"));
ok(Tinyglob::match("a*b?", "aasdasbd"));
print "youpi " if ("de-bro_m" =~ /^de\-bro_m$/);
done_testing();

View File

@ -1,10 +1,10 @@
#! /bin/bash
# Install missing packages
DEB_PACKAGES_LIST="screen libnet-ldap-perl libxml-libxml-perl libgearman-client-perl libmailtools-perl libdatetime-format-iso8601-perl libnet-ip-perl libsys-gamin-perl libdigest-sha-perl libemail-mime-perl libemail-sender-perl"
ARCH_PACKAGES_LIST="screen perl-io-socket-ssl perl-email-mime perl-term-readkey perl-ldap perl-lwp-protocol-https perl-datetime-format-iso8601 perl-net-ip" # aur/perl-sys-gamin
GENTOO_PACKAGES_LIST="app-misc/screen dev-perl/IO-Socket-SSL dev-perl/Email-MIME dev-perl/TermReadKey dev-perl/perl-ldap dev-perl/LWP-Protocol-https dev-perl/DateTime-Format-ISO8601 dev-perl/Net-IP dev-perl/Email-Sender"
FBSD_PACKAGES_LIST="screen p5-IO-Socket-SSL p5-Email-MIME p5-Term-ANSIColor p5-Term-ReadKey p5-LWP-Protocol-https p5-DateTime-Format-ISO8601 p5-Net-IP p5-Sys-Gamin"
DEB_PACKAGES_LIST="screen libnet-ldap-perl libxml-libxml-perl libgearman-client-perl libmailtools-perl libdatetime-format-iso8601-perl libnet-ip-perl libsys-gamin-perl libdigest-sha-perl libemail-mime-perl libemail-sender-perl libtext-glob-perl"
ARCH_PACKAGES_LIST="screen perl-io-socket-ssl perl-email-mime perl-term-readkey perl-ldap perl-lwp-protocol-https perl-datetime-format-iso8601 perl-net-ip" # aur/perl-sys-gamin aur/perl-text-glob
GENTOO_PACKAGES_LIST="app-misc/screen dev-perl/IO-Socket-SSL dev-perl/Email-MIME dev-perl/TermReadKey dev-perl/perl-ldap dev-perl/LWP-Protocol-https dev-perl/DateTime-Format-ISO8601 dev-perl/Net-IP dev-perl/Email-Sender dev-perl/Text-Glob"
FBSD_PACKAGES_LIST="screen p5-IO-Socket-SSL p5-Email-MIME p5-Term-ANSIColor p5-Term-ReadKey p5-LWP-Protocol-https p5-DateTime-Format-ISO8601 p5-Net-IP p5-Sys-Gamin p5-Text-Glob"
KERNEL=`uname -s`