+In many situations, users may want to specify patterns to match but don't need the full power of regexps. Wildcards make one of those sets of simplified rules. This module converts wildcard expressions to Perl regular expressions, so that you can use them for matching.
+
+It handles the C<*> and C<?> shell jokers, as well as Unix bracketed alternatives C<{,}>, but also C<%> and C<_> SQL wildcards. It can also keep original C<(...)> groups. Backspace (C<\>) is used as an escape character.
+
+Typesets that mimic the behaviour of Windows and Unix shells are also provided.
+
+=head1 METHODS
+
+=cut
+
+sub _check_self {
+ croak 'First argument isn\'t a valid ' . __PACKAGE__ . ' object'
+ unless ref $_[0] and $_[0]->isa(__PACKAGE__);
+}
+
+my %types = (
+ jokers => [ qw/jokers/ ],
+ sql => [ qw/sql/ ],
+ commas => [ qw/commas/ ],
+ brackets => [ qw/brackets/ ],
+ unix => [ qw/jokers brackets/ ],
+ win32 => [ qw/jokers commas/ ],
+);
+$types{$_} = $types{win32} for qw/dos os2 MSWin32 cygwin/;
+
+my %escapes = (
+ jokers => '?*',
+ sql => '%_',
+ commas => ',',
+ brackets => '{},',
+ groups => '()',
+);
+
+my %captures = (
+ single => sub { $_[1] ? '(.)' : '.' },
+ any => sub { $_[1] ? ($_[0]->{greedy} ? '(.*)'
+ : '(.*?)')
+ : '.*' },
+ brackets => sub { $_[1] ? '(' : '(?:'; },
+ greedy => undef
+);
+
+sub _validate {
+ my $self = shift;
+ _check_self $self;
+ my $valid = shift;
+ my $old = shift;
+ $old = { } unless defined $old;
+ my $c;
+ if (@_ <= 1) {
+ $c = { set => $_[0] };
+ } elsif (@_ % 2) {
+ croak 'Arguments must be passed as an unique scalar or as key => value pairs';
+ } else {
+ my %args = @_;
+ $c = { map { (exists $args{$_}) ? ($_ => $args{$_}) : () } qw/set add rem/ };
+ }
+ for (qw/set add rem/) {
+ my $v = $c->{$_};
+ next unless defined $v;
+ my $cb = {
+ '' => sub { +{ ($_[0] => 1) x (exists $valid->{$_[0]}) } },
+ 'ARRAY' => sub { +{ map { ($_ => 1) x (exists $valid->{$_}) } @{$_[0]} } },
+ 'HASH' => sub { +{ map { ($_ => $_[0]->{$_}) x (exists $valid->{$_}) }
+ keys %{$_[0]} } }
+ }->{ ref $v };
+ croak 'Wrong option set' unless $cb;
+ $c->{$_} = $cb->($v);
+ }
+ my $config = (exists $c->{set}) ? $c->{set} : $old;
+ $config->{$_} = $c->{add}->{$_} for grep $c->{add}->{$_},
+ keys %{$c->{add} || {}};
+ delete $config->{$_} for grep $c->{rem}->{$_}, keys %{$c->{rem} || {}};
+ $config;
+}
+
+sub _do {
+ my $self = shift;
+ my $config;
+ $config->{do} = $self->_validate(\%escapes, $self->{do}, @_);
+ $config->{escape} = '';
+ $config->{escape} .= $escapes{$_} for keys %{$config->{do}};
+ $config->{escape} = quotemeta $config->{escape};
+ $config;
+}
+
+sub do {
+ my $self = shift;
+ _check_self $self;
+ 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};
+ for (keys %captures) {
+ $config->{'c_' . $_} = $captures{$_}->($config, $config->{capture}->{$_})
+ if $captures{$_}; # Skip 'greedy'
+ }
+ $config;
+}
+
+sub capture {
+ my $self = shift;
+ _check_self $self;
+ 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});
+ $config->{type} = $type;
+ $config;
+}
+
+sub type {
+ my $self = shift;
+ _check_self $self;
+ my $config = $self->_type(@_);
+ $self->{$_} = $config->{$_} for keys %$config;
+ $self;
+}
+
+sub new {
+ my $class = shift;
+ $class = ref($class) || $class || __PACKAGE__;
+ croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
+ my %args = @_;
+ my $self = { };
+ bless $self, $class;
+ if (defined $args{do}) {
+ $self->do($args{do});
+ } else {
+ $self->type($args{type});
+ }
+ $self->capture($args{capture});
+}
+
+=head2 C<< new [ do => $what | type => $type ], capture => $captures >>
+
+Constructs a new L<Regexp::Wildcard> object.
+
+C<do> lists all features that should be enabled when converting wildcards to regexps. Refer to L</do> for details on what can be passed in C<$what>.
+
+The C<type> specifies a predefined set of C<do> features to use.
+
+
+C<$type> can be any of C<'jokers'>, C<'sql'>, C<'commas'>, C<'brackets'>, C<'win32'> or C<'unix'>. An unknown value defaults to C<'unix'>, except for C<'dos'>, C<'os2'>, C<'MSWin32'> and C<'cygwin'> that default to C<'win32'>. With this set of options, you can pass C<$^O> as the C<$type> so that you get the corresponding shell behaviour.