File Coverage

blib/lib/Astro/App/Satpass2/Macro.pm

Criterion	Covered	Total	%
statement	48	59	81.3
branch	9	18	50.0
condition	4	12	33.3
subroutine	14	18	77.7
pod	11	11	100.0
total	86	118	72.8

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_01';

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__