—package
Sub::Way;
use
strict;
use
warnings;
our
$VERSION
=
'0.01'
;
our
@EXPORT_OK
=
qw/ match /
;
sub
match {
my
(
$target
,
$cond
,
$and
) =
@_
;
if
(
ref
(
$cond
) eq
'ARRAY'
) {
if
(
$and
) {
for
my
$c
(@{
$cond
}) {
return
unless
_match(
$target
,
$c
);
}
return
1;
}
else
{
for
my
$c
(@{
$cond
}) {
return
1
if
_match(
$target
,
$c
);
}
}
}
else
{
return
1
if
_match(
$target
,
$cond
);
}
return
;
# not match
}
sub
_match {
my
(
$target
,
$cond
) =
@_
;
if
( !
ref
(
$cond
) ||
ref
(
$cond
) eq
'Regexp'
) {
return
1
if
$target
=~ m!
$cond
!;
}
elsif
(
ref
(
$cond
) eq
'CODE'
) {
return
1
if
$cond
->(
$target
);
}
return
;
}
1;
__END__
=head1 NAME
Sub::Way - several ways of matching
=head1 SYNOPSIS
use Sub::Way qw/match/;
if ( match($target_text, $condition) ) {
# do something
}
=head1 DESCRIPTION
Sub::Way is the matching utility.
=head1 METHOD
=head2 match($target, $condition, $and_opt)
sevelal ways below:
match('example text', 'amp'); # true
match('example text', qr/amp/); # true
match('example text', sub { my $t = shift; return 1 if $t =~ /^amp/; }); # true
match(
'example text',
[
'amp',
qr/amp/,
sub { my $t = shift; return 1 if $t =~ /^amp/; },
]
); # of course true
match(
'example text',
[
'yamp', # not match
qr/amp/,
sub { my $t = shift; return 1 if $t =~ /^amp/; },
],
1,
); # false
By default, the array of condition is evaluated as 'OR'.
=head1 REPOSITORY
Sub::Way is hosted on github: L<http://github.com/bayashi/Sub-Way>
Welcome your patches and issues :D
=head1 AUTHOR
Dai Okabayashi E<lt>bayashi@cpan.orgE<gt>
=head1 LICENSE
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.
=cut