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 warnings;
|
||||||
use XML::LibXML;
|
use XML::LibXML;
|
||||||
|
|
||||||
use ACU::Tinyglob;
|
|
||||||
|
|
||||||
sub new
|
sub new
|
||||||
{
|
{
|
||||||
my $class = shift;
|
my $class = shift;
|
||||||
|
@ -185,6 +183,7 @@ use warnings;
|
||||||
use Carp;
|
use Carp;
|
||||||
use Safe;
|
use Safe;
|
||||||
use List::Util "reduce";
|
use List::Util "reduce";
|
||||||
|
use Text::Glob qw( glob_to_regex );
|
||||||
use XML::LibXML;
|
use XML::LibXML;
|
||||||
|
|
||||||
sub new ($$$;$$)
|
sub new ($$$;$$)
|
||||||
|
@ -349,7 +348,7 @@ sub compute ($$$;$$$)
|
||||||
{
|
{
|
||||||
eval
|
eval
|
||||||
{
|
{
|
||||||
my $glob = Tinyglob::tinyglob($ref);
|
my $glob = glob_to_regex($ref);
|
||||||
if ($glob ne $ref)
|
if ($glob ne $ref)
|
||||||
{
|
{
|
||||||
my $value = 0;
|
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
|
#! /bin/bash
|
||||||
|
|
||||||
# Install missing packages
|
# 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"
|
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
|
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"
|
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"
|
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`
|
KERNEL=`uname -s`
|
||||||
|
|
||||||
|
|
Reference in New Issue
Block a user