This is a great idea! I'll have a good look at Regexp::Common over the weekend. I did get a full implementation and all my tests are passing on both Unix and Windows, so I did get it to work correctly. I've moved on to updating berrybrew with some new enhancements/bug fixes before I can get back to that distribution, as it relies on some berrybrew changes anyway.
I'll create a new branch and test it out, but at this time, this is what I ended up with:
package Test::BrewBuild::Regex;
use strict;
use warnings;
use Carp qw(croak);
use Exporter qw(import);
our $VERSION = '2.20';
our @EXPORT = qw(
re_brewbuild
re_brewcommands
re_dispatch
re_git
);
my %brewbuild = (
check_failed => qr{failed.*?See\s+(.*?)\s+for details},
check_result => qr{
[Pp]erl-\d\.\d+\.\d+(?:_\w+)?
\s+===.*?
(?=(?:[Pp]erl-\d\.\d+\.\d+(?:_\w+)?\s+===|$))
}xs,
extract_dzil_dist_name => qr{^name\s+=\s+(.*)$},
extract_dzil_dist_version => qr{^version\s+=\s+(.*)$},
extract_errors => qr{
cpanm\s+\(App::cpanminus\)
.*?
(?=(?:cpanm\s+\(App::cpanminus\)|$))
}xs,
extract_error_perl_ver => qr{cpanm.*?perl\s(5\.\d+)\s},
extract_result => qr{
([Pp]erl-\d\.\d+\.\d+(?:_\w+)?\s+=+?)
(\s+.*?)
(?=(?:[Pp]erl-\d\.\d+\.\d+(?:_\w+)?\s+===|$))
}xs,
extract_perl_version => qr{^([Pp]erl-\d\.\d+\.\d+(_\d{2})?)},
);
my %brewcommands = (
available_berrybrew => qr{(\d\.\d+\.\d+_\d+)},
available_perlbrew => qr{(?<!c)(perl-\d\.\d+\.\d+(?:-RC\d+)?)},
installed_berrybrew => qr{(\d\.\d{2}\.\d(?:_\d{2}))(?!=_)\s+\[inst
+alled\]}i,
installed_perlbrew => qr{i\s+(perl-\d\.\d+\.\d+)},
using_berrybrew => qr{(\d\.\d{2}\.\d(?:_\d{2}))(?!=_)\s+\[installe
+d\]\s+\*}i,
);
my %dispatch = (
extract_short_results => qr{(5\.\d{1,2}\.\d{1,2} :: \w{4})},
);
my %git = (
extract_repo_name => qr{.*/(.*?)(?:\.git)*$},
extract_commit_csum => qr{([A-F0-9]{40})\s+HEAD}i,
);
sub re_brewbuild {
my $re = shift;
_check(\%brewbuild, $re);
return $brewbuild{$re};
}
sub re_brewcommands {
my $re = shift;
_check(\%brewcommands, $re);
return $brewcommands{$re};
}
sub re_dispatch {
my $re = shift;
_check(\%dispatch, $re);
return $dispatch{$re};
}
sub re_git {
my $re = shift;
_check(\%git, $re);
return $git{$re};
}
sub _check {
my ($module, $re) = @_;
croak "regex '$re' doesn't exist for re_${module}()"
if ! exists $module->{$re};
}
1;
(POD redacted).
Thanks for all of the tips and advice everyone! |