: '(.*?)')
: '.*' },
brackets => sub { $_[1] ? '(' : '(?:'; },
- greedy => undef
+ greedy => undef,
);
sub _validate {
for (qw<set add rem>) {
my $opt = $opts{$_};
next unless defined $opt;
+
my $cb = {
'' => sub { +{ ($_[0] => 1) x (exists $valid->{$_[0]}) } },
'ARRAY' => sub { +{ map { ($_ => 1) x (exists $valid->{$_}) } @{$_[0]} } },
sub _do {
my $self = shift;
+
my $config;
- $config->{do} = $self->_validate(\%escapes, $self->{do}, @_);
- $config->{escape} = '';
+ $config->{do} = $self->_validate(\%escapes, $self->{do}, @_);
+ $config->{escape} = '';
$config->{escape} .= $escapes{$_} for keys %{$config->{do}};
- $config->{escape} = quotemeta $config->{escape};
+ $config->{escape} = quotemeta $config->{escape};
+
$config;
}
sub do {
my $self = shift;
_check_self $self;
- my $config = $self->_do(@_);
+
+ my $config = $self->_do(@_);
$self->{$_} = $config->{$_} for keys %$config;
+
$self;
}
sub _capture {
my $self = shift;
+
my $config;
$config->{capture} = $self->_validate(\%captures, $self->{capture}, @_);
$config->{greedy} = delete $config->{capture}->{greedy};
$config->{'c_' . $_} = $captures{$_}->($config, $config->{capture}->{$_})
if $captures{$_}; # Skip 'greedy'
}
+
$config;
}
sub capture {
my $self = shift;
_check_self $self;
- my $config = $self->_capture(@_);
+
+ my $config = $self->_capture(@_);
$self->{$_} = $config->{$_} for keys %$config;
+
$self;
}
sub _type {
my ($self, $type) = @_;
- $type = 'unix' unless defined $type;
- croak 'Wrong type' unless exists $types{$type};
- my $config = $self->_do($types{$type});
+ $type = 'unix' unless defined $type;
+ croak 'Wrong type' unless exists $types{$type};
+
+ my $config = $self->_do($types{$type});
$config->{type} = $type;
+
$config;
}
sub type {
my $self = shift;
_check_self $self;
- my $config = $self->_type(@_);
+
+ my $config = $self->_type(@_);
$self->{$_} = $config->{$_} for keys %$config;
+
$self;
}
sub new {
my $class = shift;
- $class = ref($class) || $class || __PACKAGE__;
+ $class = blessed($class) || $class || __PACKAGE__;
+
croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
my %args = @_;
- my $self = { };
- bless $self, $class;
+
+ my $self = bless { }, $class;
+
if (defined $args{do}) {
$self->do($args{do});
} else {
$self->type($args{type});
}
+
$self->capture($args{capture});
}
sub convert {
my ($self, $wc, $type) = @_;
_check_self $self;
+
my $config = (defined $type) ? $self->_type($type) : $self;
return unless defined $wc;
$wc = $self->{'c_brackets'} . $self->_commas($wc) . ')';
}
- return $wc;
+ $wc
}
=head1 EXPORT
sub _jokers {
my $self = shift;
local $_ = $_[0];
+
# substitute ? preceded by an even number of \
my $s = $self->{c_single};
s/(?<!\\)((?:\\\\)*)\?/$1$s/g;
# substitute * preceded by an even number of \
$s = $self->{c_any};
s/(?<!\\)((?:\\\\)*)\*+/$1$s/g;
- return $_;
+
+ $_
}
sub _sql {
my $self = shift;
local $_ = $_[0];
+
# substitute _ preceded by an even number of \
my $s = $self->{c_single};
s/(?<!\\)((?:\\\\)*)_/$1$s/g;
# substitute % preceded by an even number of \
$s = $self->{c_any};
s/(?<!\\)((?:\\\\)*)%+/$1$s/g;
- return $_;
+
+ $_
}
sub _commas {
local $_ = $_[1];
+
# substitute , preceded by an even number of \
s/(?<!\\)((?:\\\\)*),/$1|/g;
- return $_;
+
+ $_
}
sub _brackets {
my ($self, $rest) = @_;
+
substr $rest, 0, 1, '';
chop $rest;
+
my ($re, $bracket, $prefix) = ('');
while (do { ($bracket, $rest, $prefix) = _extract $rest; $bracket }) {
$re .= $self->_commas($prefix) . $self->_brackets($bracket);
}
$re .= $self->_commas($rest);
- return $self->{c_brackets} . $re . ')';
+
+ $self->{c_brackets} . $re . ')';
}
sub _bracketed {
my ($self, $rest) = @_;
+
my ($re, $bracket, $prefix) = ('');
while (do { ($bracket, $rest, $prefix) = _extract $rest; $bracket }) {
$re .= $prefix . $self->_brackets($bracket);
}
$re .= $rest;
+
$re =~ s/(?<!\\)((?:\\\\)*[\{\},])/\\$1/g;
- return $re;
+
+ $re;
}
1; # End of Regexp::Wildcards