Permalink
Browse files

Rewrote argument handlers to abuse prototypes

  • Loading branch information...
1 parent 75d1397 commit 131ec2acd95cb221b2b059fcfd3b61c1fc671dac @Leont committed Dec 28, 2010
Showing with 24 additions and 18 deletions.
  1. +18 −9 inc/Library/Build.pm
  2. +6 −9 inc/Library/Build/Install.pm
View
@@ -41,7 +41,16 @@ sub _parse_options {
if ($argument =~ / \A -- (.+) \z /xms) {
my $cb = $self->{argument_callback}{$1};
if ($cb) {
- $cb->($options, $1, $argument_list);
+ my $proto = prototype $cb;
+ if ($proto eq '') {
+ $cb->($options, $1);
+ }
+ elsif ($proto eq '$') {
+ $cb->($options, $1, shift @{ $argument_list });
+ }
+ else {
+ Carp::croak("unknown prototype for --$1 handler");
+ }
}
else {
Carp::carp("Unknown option '--$1'");
@@ -133,17 +142,17 @@ sub inject_roles {
}
my @stash_default_callbacks = (
- sub {
- my ($options, $name, undef) = @_;
+ sub() {
+ my ($options, $name) = @_;
$options->{$name}++;
},
- sub {
- my ($options, $name, $arguments) = @_;
- $options->{$name} = shift @{$arguments};
+ sub($) {
+ my ($options, $name, $value) = @_;
+ $options->{$name} = $value;
},
- sub {
- my ($options, $name, $arguments) = @_;
- push @{ $options->{$name} }, shift @{$arguments};
+ sub($) {
+ my ($options, $name, $value) = @_;
+ push @{ $options->{$name} }, $value;
}
);
@@ -79,20 +79,18 @@ sub mixin {
$builder->register_actions(%install_actions);
$builder->register_argument(
- install_path => sub {
- my (undef, undef, $arguments) = @_;
- my $arg = shift @{$arguments};
+ install_path => sub($) {
+ my (undef, undef, $arg) = @_;
my ($name, $value) = $arg =~ / (\w+) = (.*) /x;
$builder->register_paths($name => $value);
},
- installdirs => sub {
- my (undef, undef, $arguments) = @_;
- my $type = shift @{$arguments};
+ installdirs => sub($) {
+ my (undef, undef, $type) = @_;
$builder->register_paths(%{ install_dirs_for($builder, $type) });
return;
},
- install_base => sub {
- my (undef, undef, $arguments) = @_;
+ install_base => sub($) {
+ my (undef, undef, $base_path) = @_;
my %install_base_relpaths = (
lib => ['lib', 'perl5'],
@@ -105,7 +103,6 @@ sub mixin {
libhtml => ['html'],
);
- my $base_path = shift @{$arguments};
my %path_for;
for my $typename (keys %install_base_relpaths) {
$path_for{$typename} = catdir($base_path, @{ $install_base_relpaths{$typename} });

0 comments on commit 131ec2a

Please sign in to comment.