view release on metacpan or  search on metacpan

lib/Astro/App/Satpass2/Macro/Command.pm  view on Meta::CPAN

package Astro::App::Satpass2::Macro::Command;

use 5.008;

use strict;
use warnings;

use parent qw{ Astro::App::Satpass2::Macro };

use Astro::App::Satpass2::Utils qw{ quoter ARRAY_REF @CARP_NOT };

our $VERSION = '0.057';

sub execute {
    my ( $self, $name ) = @_;
    $self->implements( $name )
	or $self->weep( "'$name' not implemented by this object" );
    my $satpass2 = $self->parent();
    my $output;
    foreach my $cmd ( @{ $self->{def} } ) {
	eval {
	    if ( defined( my $buffer = $satpass2->execute( $cmd ) ) ) {
		$output .= $buffer;
	    }
	    1;
	} or do {
	    $satpass2->__wail( $@ );
	}
    }
    return $output;
}

sub completion {
    my ( $self, $text ) = @_;
    $self->{completion}
	or return;
    defined $text
	or $text = '';
    my @rslt = sort( grep { ! index $_, $text } @{ $self->{completion} } )
	or return;
    return \@rslt;
}

sub def {
    my ( $self ) = @_;
    my @def = @{ $self->{def} };
    return wantarray ? @def : \@def;
}

sub init {
    my ( $self ) = @_;
    $self->SUPER::init();
    ARRAY_REF eq ref $self->{def}
	or $self->wail( q{Attribute 'def' must be an array reference} );
    $self->{implements} = { map { $_ => 1 } $self->name() };

    $self->{completion}
	and @{ $self->{completion} } = map { split qr< \s+ >smx }
	    @{ $self->{completion} };

    return;
}

# Rewrite level1 macro definitions to level 2 commands. Note that this
# is idempotent.

sub __level1_rewrite {	# TODO get rid of this when level1 support goes away
    my ( $self ) = @_;

    delete $self->{level1}
	and $self->{def} = $self->parent()->__rewrite_level1_macro_def(
	$self->name(), $self->{def} );

    return;
}

1;

__END__

=head1 NAME

Astro::App::Satpass2::Macro::Command - Define a macro which consists of an array of commands

=head1 SYNOPSIS

No user-serviceable parts inside.

=head1 DESCRIPTION

This class is private to the Astro-App-Satpass2 distribution.
Documentation is for the benefit of the author only.

=head1 METHODS

This class provides the following methods in addition to those if its
superclass:

=head2 completion

 my $completion = $self->completion( $text );

This method returns a reference to an array containing all completions
defined by the C<'completion'> argument to C<new()> that match C<$text>.
If there are none, or if the C<'completion'> argument was not specified,
nothing is returned.

=head2 init

This method overrides the superclass method of the same name. In
addition to the functionality of that method, The C<def> attribute is
checked, and the C<implements> attribute populated.