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


line stmt bran cond sub pod time code
1             package Astro::App::Satpass2::Warner;
2              
3 21     21   1569 use 5.008;
  21         76  
4              
5 21     21   113 use strict;
  21         54  
  21         478  
6 21     21   108 use warnings;
  21         47  
  21         662  
7              
8 21     21   635 use Astro::App::Satpass2::Locale qw{ __message };
  21         76  
  21         1198  
9 21     21   141 use Astro::App::Satpass2::Utils qw{ @CARP_NOT };
  21         51  
  21         14241  
10              
11             our $VERSION = '0.051_01';
12              
13             sub new {
14 26     26 1 87 my ( $class, @arg ) = @_;
15 26 50       92 ref $class and $class = ref $class;
16 26         66 my $self = {};
17 26         58 bless $self, $class;
18 26         85 while ( @arg ) {
19 7         44 my ( $name, $value ) = splice @arg, 0, 2;
20 7 50       66 my $code = $self->can( $name )
21             or $self->wail( "Warner has no such method as $name" );
22 7         31 $code->( $self, $value );
23             }
24 26         99 return $self;
25             }
26              
27             sub wail {
28 21     21 1 77 my ($self, @args) = @_;
29 21         117 my $msg = __message( @args );
30 21 100       130 ref $msg
31             and die $msg;
32 20         41 chomp $msg;
33 20 50       99 if ($self->warning()) {
34 0 0       0 if ( $Carp::Verbose ) {
35 0         0 require Carp; # Paranoia
36 0         0 Carp::confess( $msg );
37             }
38 0 0       0 $msg =~ m/[.?!]\z/msx or $msg .= '.';
39 0         0 die $msg, "\n";
40             } else {
41 20         107 $msg =~ s/[.?!]\z//msx;
42 20         151 require Carp;
43 20         5463 Carp::croak( $msg );
44             }
45             }
46              
47             sub warning {
48 30     30 1 83 my ( $self, @arg ) = @_;
49 30 100       95 if ( @arg ) {
50 7         48 $self->{warning} = shift @arg;
51 7         31 return $self;
52             } else {
53 23         98 return $self->{warning};
54             }
55             }
56              
57             sub weep {
58 0     0 1 0 my ( undef, @args ) = @_; # Invocant unused
59 0         0 my $msg = join ' ', __message( 'Programming Error -' ), __message( @args );
60 0         0 chomp $msg;
61 0         0 require Carp;
62 0         0 Carp::confess( $msg );
63             }
64              
65             sub whinge {
66 3     3 1 8 my ($self, @args) = @_;
67 3         11 my $msg = __message( @args );
68             ref $msg
69 3 50       12 and do {
70 0         0 warn $msg;
71 0         0 return;
72             };
73 3         7 chomp $msg;
74 3 50       12 if ($self->warning()) {
75 0 0       0 $msg =~ m/ [.?!] \z /msx or $msg .= '.';
76 0         0 warn $msg, "\n";
77             } else {
78 3         44 $msg =~ s/ [.?!] \z //msx;
79 3         52 require Carp;
80 3         420 Carp::carp( $msg );
81             }
82 3         160 return;
83             }
84              
85             1;
86              
87             __END__