File Coverage

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

Criterion	Covered	Total	%
statement	45	59	76.2
branch	9	20	45.0
condition			n/a
subroutine	9	10	90.0
pod	5	5	100.0
total	68	94	72.3

package Astro::App::Satpass2::Warner;

use 5.008;

use strict;
use warnings;

use Astro::App::Satpass2::Locale qw{ __message };
use Astro::App::Satpass2::Utils qw{ @CARP_NOT };

our $VERSION = '0.052';

sub new {
    my ( $class, @arg ) = @_;
    ref $class and $class = ref $class;
    my $self = {};
    bless $self, $class;
    while ( @arg ) {
	my ( $name, $value ) = splice @arg, 0, 2;
	my $code = $self->can( $name )
	    or $self->wail( "Warner has no such method as $name" );
	$code->( $self, $value );
    }
    return $self;
}

sub wail {
    my ($self, @args) = @_;
    my $msg = __message( @args );
    ref $msg
	and die $msg;
    chomp $msg;
    if ($self->warning()) {
	if ( $Carp::Verbose ) {
	    require Carp;	# Paranoia
	    Carp::confess( $msg );
	}
	$msg =~ m/[.?!]\z/msx or $msg .= '.';
	die $msg, "\n";
    } else {
	$msg =~ s/[.?!]\z//msx;
	require Carp;
	Carp::croak( $msg );
    }
}

sub warning {
    my ( $self, @arg ) = @_;
    if ( @arg ) {
	$self->{warning} = shift @arg;
	return $self;
    } else {
	return $self->{warning};
    }
}

sub weep {
    my ( undef, @args ) = @_;		# Invocant unused
    my $msg = join ' ', __message( 'Programming Error -' ), __message( @args );
    chomp $msg;
    require Carp;
    Carp::confess( $msg );
}

sub whinge {
    my ($self, @args) = @_;
    my $msg = __message( @args );
    ref $msg
	and do {
	warn $msg;
	return;
    };
    chomp $msg;
    if ($self->warning()) {
	$msg =~ m/ [.?!] \z /msx or $msg .= '.';
	warn $msg, "\n";
    } else {
	$msg =~ s/ [.?!] \z //msx;
	require Carp;
	Carp::carp( $msg );
    }
    return;
}

1;

__END__