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   394 use 5.008;
  21         78  
4              
5 21     21   112 use strict;
  21         44  
  21         693  
6 21     21   139 use warnings;
  21         42  
  21         1328  
7              
8 21     21   4792 use Astro::App::Satpass2::Locale qw{ __message };
  21         52  
  21         1609  
9 21     21   154 use Astro::App::Satpass2::Utils qw{ @CARP_NOT };
  21         43  
  21         18122  
10              
11             our $VERSION = '0.057_01';
12              
13             sub new {
14 26     26 1 91 my ( $class, @arg ) = @_;
15 26 50       95 ref $class and $class = ref $class;
16 26         62 my $self = {};
17 26         70 bless $self, $class;
18 26         119 while ( @arg ) {
19 7         27 my ( $name, $value ) = splice @arg, 0, 2;
20 7 50       79 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         96 return $self;
25             }
26              
27             sub wail {
28 22     22 1 82 my ($self, @args) = @_;
29 22         135 my $msg = __message( @args );
30 22 100       85 ref $msg
31             and die $msg;
32 21         46 chomp $msg;
33 21 50       170 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 21         147 $msg =~ s/[.?!]\z//msx;
42 21         185 require Carp;
43 21         15566 Carp::croak( $msg );
44             }
45             }
46              
47             sub warning {
48 31     31 1 92 my ( $self, @arg ) = @_;
49 31 100       96 if ( @arg ) {
50 7         47 $self->{warning} = shift @arg;
51 7         34 return $self;
52             } else {
53 24         103 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 13 my ($self, @args) = @_;
67 3         35 my $msg = __message( @args );
68             ref $msg
69 3 50       16 and do {
70 0         0 warn $msg;
71 0         0 return;
72             };
73 3         13 chomp $msg;
74 3 50       19 if ($self->warning()) {
75 0 0       0 $msg =~ m/ [.?!] \z /msx or $msg .= '.';
76 0         0 warn $msg, "\n";
77             } else {
78 3         38 $msg =~ s/ [.?!] \z //msx;
79 3         75 require Carp;
80 3         731 Carp::carp( $msg );
81             }
82 3         34 return;
83             }
84              
85             1;
86              
87             __END__