Use Text::Glob instead of ACU::Tinyglob
This commit is contained in:
parent
f8e5d1b5c0
commit
f271f36203
|
@ -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;
|
||||
|
|
|
@ -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;
|
|
@ -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();
|
|
@ -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`
|
||||
|
||||
|
|
Reference in New Issue