view release on metacpan or  search on metacpan

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

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

use 5.008;

use strict;
use warnings;

use Astro::App::Satpass2::Utils qw{
    instance
    CODE_REF
    @CARP_NOT
};
use Astro::App::Satpass2::Warner;
use Scalar::Util 1.26 qw{ weaken };

our $VERSION = '0.057';

sub new {
    my ( $class, %arg ) = @_;
    my $self = bless \%arg, ref $class || $class;
    $self->init();
    return $self;
}

sub execute {
    __PACKAGE__->weep( 'execute() must be overridden' );
    return;	# weep() dies, but Perl::Critic does not know this.
}

sub generator {
    my ( $self, @args ) = @_;
    $self->{generate}
	or $self->weep( q{'generate' attribute not specified} );
    @args
	or return $self->{generate}->( $self, sort $self->implements() );
    foreach my $macro ( @args ) {
	$self->implements( $macro, required => 1 );
    }
    return $self->{generate}->( $self, @args );
}

sub implements {
    my ( $self, $name, %arg ) = @_;
    defined $name
	or return ( keys %{ $self->{implements} } );
    $self->{implements}{$name}
	or not $arg{required}
	or $self->wail( "This object does not implement macro $name" );
    return $self->{implements}{$name};
}

sub init {
    my ( $self ) = @_;
    $self->{warner} ||= Astro::App::Satpass2::Warner->new();

    defined $self->{generate}
	and CODE_REF ne ref $self->{generate}
        and $self->wail( q{If specified, 'generate' must be a code ref} );

    defined $self->{name}
	or $self->wail( q{Attribute 'name' is required} );

    defined $self->{parent}
	or $self->wail( q{Attribute 'parent' is required} );
    instance( $self->{parent}, 'Astro::App::Satpass2' )
	or $self->wail( q{Attribute 'parent' must be an Astro::App::Satpass2} );
    weaken( $self->{parent} );

    return;
}

sub name {
    my ( $self ) = @_;
    return $self->{name};
}

sub parent {
    my ( $self ) = @_;
    return $self->{parent};
}

sub wail {
    my ( $self, @args ) = @_;
    $self->warner()->wail( @args );
    return;	# wail() dies, but Perl::Critic does not know this.
}

sub warner {
    my ( $self ) = @_;
    ref $self
	or return Astro::App::Satpass2::Warner->new();
    return $self->{warner};
}

sub weep {
    my ( $self, @args ) = @_;
    $self->warner()->weep( @args );
    return;	# weep() dies, but Perl::Critic does not know this.
}

sub whinge {
    my ( $self, @args ) = @_;
    $self->warner()->whinge( @args );
    return;
}

# TODO get rid of this when level1 support goes away.
sub __level1_rewrite {
    return;
}

1;

__END__

=head1 NAME

Astro::App::Satpass2::Macro - Implement a macro

=head1 SYNOPSIS

No user-serviceable parts inside.

=head1 DESCRIPTION

This is an abstract class to implement macros.

=head1 METHODS

This class supports the following public methods:

=head2 new

 my $macro = Astro::App::Satpass2::Macro->new( name => 'Foo' );

This static method returns a new macro object. The arguments are
pairs of attribute names and values. An exception will be thrown if the
object can not be constructed.

=head2 execute

 print $macro->execute( $name, @args );

This method executes the named macro, passing it the given arguments.
The results of the execution are returned.

This method must be overridden by the subclass.

=head2 generator

 print $macro->generator( 'foo' );
 print $macro->generator();

If the C<generate> attribute (q.v.) was not provided when the object was
instantiated , this method fails.

If the C<generate> attribute was provided when the object was
instantiated and arguments were provided, this method validates that the
arguments are all names of macros implemented by this object, failing if
they are not. If the arguments are valid, it calls the code provided
in the C<generate> attribute with the invocant and the arguments.

If the C<generate> attribute was provided when the object was
instantiated and no arguments were provided, the code provided
in the C<generate> attribute is called with the invocant and the list of
all macros implemented by the invocant in ASCIIbetical order.

=head2 implements

 print map { "$_\n" } sort $macro->implements();
 $macro->implements( $name )
     and print "Implements $name\n";
 $macro->implements( $name, required => 1 );

This method has several overloads dealing with what macros this object
implements.

If C<$name> is omitted or C<undef>, it returns the names of all macros
implemented by this object, in no particular order.

If C<$name> is specified, it returns a true value if the object
implements the named macro, and false otherwise. No commitment is made
as to exactly what value is returned, and the caller is to regard this
value as opaque.

After the C<$name> argument, optional name/value pairs can be specified.
The only one defined at the moment is C<required>, which causes an
exception to be thrown if this object does not implement the named
macro.

=head2 init

 $self->init();