/usr/local/CPAN/Getopt-Chain/Getopt/Chain/Builder.pm

• package Getopt::Chain::Builder
  • _build_builder
  • start
  • on
  • under
• EOF

package Getopt::Chain::Builder;

use Moose;
use Getopt::Chain::Carp;

use Path::Dispatcher;
use Path::Dispatcher::Builder;

has builder => qw/is ro lazy_build 1/, handles => [qw/ dispatcher rewrite /];
sub _build_builder {
    my $self = shift;
    return Path::Dispatcher::Builder->new;
}

sub start {
    my $self = shift;
    $self->on( '' => always_run => 1, @_ );
}

sub on {
    my $self = shift;
    my $path = shift;

    my ( @argument_schema, $run, @given );
    while ( @_ ) {

        local $_ = shift;
        if ( ref eq 'ARRAY' ) {
            push @argument_schema, @$_;
        }
        elsif ( ref eq 'CODE' ) {
            $run = $_;
        }
        elsif ( ! defined ) {   
        }
        else {
            push @given, $_ => shift;
        }
    }
    my %given = @given;

    my %control = (
        map { $_ => $given{$_} } grep { exists $given{$_} } qw/always_run terminator/
    );
    
    my $matcher;
    if (ref $path eq 'ARRAY') {
        $matcher = $path;
    }
    elsif (ref $path eq 'Regexp') {
        $matcher = $path;
    }
    elsif (! ref $path) {
        if ( $path =~ s/\s+\*\s*$// ) { # "xyzzy *"
            $matcher = qr/$path\b(.*)/;
            $control{arguments_from_1} = 1;
        }
        elsif ( $path =~ m/^\s*\*\s*$/ ) { # "*"
            $matcher = qr/(.*)/;
            $control{arguments_from_1} = 1;
        }
        elsif ( $path =~ s/\s+--\s*$// ) { # "xyzzy --"
            $matcher = [ split m/\s+/, $path ];
            $control{terminator} = 1;
        }
        elsif ( $path =~ m/^\s*--\s*$/ ) { # "--"
            $matcher = [];
            $control{terminator} = 1;
        }
        else {
            $matcher = [ split m/\s+/, $path ];
        }
    }
    else {
        croak "Don't recogonize matcher ($path)";
    }
    $self->builder->on( $matcher, sub { # The builder should do the split for us!
        my $context = shift;
        my $dollar1;
        $dollar1 = $1 if $control{arguments_from_1};
        return $context->run_step( \@argument_schema, $run, { %control }, dollar1 => $dollar1 );
    } );
}

sub under {
    my $self = shift;
    $self->builder->under( @_ );
}

1;