use strict;
use warnings;
use re 'eval'; # Should be scoped better.
sub rc($) {
my $ofs = @- + shift;
return substr($_, $-[$ofs], $+[$ofs] - $-[$ofs])
}
sub compile_pat { qr/$_[0]/ }
my @s_months = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
my $s_months = compile_pat join '|', @s_months;
local our
%s_months = map { $s_months[$_] => $_+1 } 0..$#s_months;
my @pats = (
qr/ (\d{4})-(\d{2})-(\d{2}) (?{[ rc-3, rc-2, rc-1 ]})/x,
qr/ (\d{2})($s_months)(\d{4}) (?{[ rc-1, $s_months{rc-2}, rc-3 ]})/x,
);
my $pat = compile_pat join '|', @pats;
for (qw(
2009-12-01
01Dec2009
01-12-2009
)) {
local our ($y,$m,$d);
if (/$pat(?{ ($y,$m,$d) = @{$^R} })/) {
printf("%s => %04d-%02d-%02d\n", $_,$y,$m,$d);
} else {
printf("%s => [No match]\n", $_);
}
}
Bonus: $pat can be calculated once and stored in a file. |