Getopt-Chain

 view release on metacpan or  search on metacpan

lib/Getopt/Chain/Builder.pm  view on Meta::CPAN

    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 );

lib/Getopt/Chain/Context.pm  view on Meta::CPAN

        # A/b -x c      $1 = 'b'    [ -x c ] # Error, -x wasn't parsed!
        # A/b/c         $1 = 'b c'  [ ]

        # A b c d
        # A b c d       $1 = ''         [ b c d ]
        # A/b c d       $1 = 'b'        [ c d ]
        # A/b/c d       $1 = 'b c'      [ d ]
        # A/b/c/d       $1 = 'b c d'    [ ]

        my @arguments;
        push @arguments, grep { length } split m/\s+/, $self->dollar1 if defined $self->dollar1;
        push @arguments, @$arguments;
        my $run = $self->_run;
        $run->( $self->context, @arguments ) if $run;
    }

    return 1;
}

1;

lib/Getopt/Chain/Declare.pm  view on Meta::CPAN

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

extends qw/Moose::Meta::Class/;

has getopt_chain_parent_class => qw/is ro lazy_build 1/;
sub _build_getopt_chain_parent_class {
    my $self = shift;
    my ($class) = $self->linearized_isa;
    my @class = split m/::/, $class;
    pop @class;
    join '::', @class;
}

sub getopt_chain_parent_meta {
    return shift->getopt_chain_parent_class->meta;
}

sub import_arguments {
    my $self = shift;

lib/Getopt/Chain/Declare/under.pm  view on Meta::CPAN

use Moose;
use MooseX::AttributeHelpers;

extends qw/Moose::Meta::Class/;

has getopt_chain_parent_class => qw/is ro lazy_build 1/;
sub _build_getopt_chain_parent_class {
    my $self = shift;
    my ($class) = $self->linearized_isa;
    my @class = split m/::/, $class;
    pop @class;
    join '::', @class;
}

sub getopt_chain_parent_meta {
    return shift->getopt_chain_parent_class->meta;
}

has recorder => qw/is ro lazy_build 1/, handles => [qw/ do_or_record /];
sub _build_recorder {

lib/Getopt/Chain/v005/Context.pm  view on Meta::CPAN

sub pop {
    my $self = shift;
    pop @{ $self->chain };
}

sub run {
    my $self = shift;
    my $path = shift || "";

    my @path = grep { length $_ } split m/[ \/]+/, $path;

    my $link = $self->link;
    my $processor = $self->link(0)->processor;
    for (@path) {
        # TODO Probably call this 'resolve'
        $processor = $processor->commands->{$_} or croak "Couldn't traverse $path: $_ not found";
    }

    $self->push(processor => $processor, command => $path[-1],
        arguments => $link->_arguments, remaining_arguments => $link->_remaining_arguments, options => scalar $link->options);