view release on metacpan or  search on metacpan

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

    ./script --verbose edit --file xyzzy.c

    # At the very beginning: 
    $context->remaining_arguments # Returns ( edit --file xyzzy.c )

    # In the "edit" subroutine:
    $context->remaining_arguments # Returns ( )

=head2 $context->abort( [ ... ] )

Immediately exit the process with exit code of -1

If the optional ... (message) is given, then print that out to STDERR first

=head1 SEE ALSO

L<Getopt::Chain::v005>

=cut

use Hash::Param;

has options => qw/reader _options lazy_build 1 isa HashRef/;
sub _build_options {
    my $self = shift;
    return {};
}

has options_ => qw/is ro isa Hash::Param lazy_build 1/, handles => {qw/option param options params/};
sub _build_options_ {
    my $self = shift;
    return Hash::Param->new(params => $self->_options);
}

has chain => qw/is ro isa ArrayRef/, default => sub { [] };

has stash => qw/is ro isa HashRef/, default => sub { {} };

sub BUILD {
    my $self = shift;
    my $given = shift;
}

sub push {
    my $self = shift;
    my $link = Getopt::Chain::v005::Context::Link->new(context => $self, @_);
    push @{ $self->chain }, $link;
    return $link;
}

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

    $processor->run->($self, @_);

    $self->pop;
}

sub update {
    my $self = shift;

    my $link = $self->link;

    my $local_options = $self->local_options_;
    my $options = $self->options_;

    for my $key ($local_options->params) {
        $options->param($key => scalar $local_options->param($key));
    }
}

sub link {
    my $self = shift;
    my $at = shift;

    $at = -1 unless defined $at;
    return $self->chain->[$at];
}

sub local_option {
    my $self = shift;
    return $self->link->option(@_);
}

sub local_options {
    my $self = shift;
    return $self->link->options(@_);
}

sub local_options_ {
    my $self = shift;
    return $self->link->options_(@_);
}

for my $method (qw/processor command arguments remaining_arguments remainder valid/) {
    no strict 'refs';
    *$method = sub {
        my $self = shift;
        return $self->link->$method(@_);
    };
}