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   302 use 5.008;
  21         62  
4              
5 21     21   82 use strict;
  21         38  
  21         505  
6 21     21   85 use warnings;
  21         28  
  21         975  
7              
8 21     21   3670 use Astro::App::Satpass2::Locale qw{ __message };
  21         40  
  21         1224  
9 21     21   132 use Astro::App::Satpass2::Utils qw{ @CARP_NOT };
  21         32  
  21         12945  
10              
11             our $VERSION = '0.057_02';
12              
13             sub new {
14 26     26 1 58 my ( $class, @arg ) = @_;
15 26 50       62 ref $class and $class = ref $class;
16 26         45 my $self = {};
17 26         42 bless $self, $class;
18 26         101 while ( @arg ) {
19 7         19 my ( $name, $value ) = splice @arg, 0, 2;
20 7 50       81 my $code = $self->can( $name )
21             or $self->wail( "Warner has no such method as $name" );
22 7         23 $code->( $self, $value );
23             }
24 26         64 return $self;
25             }
26              
27             sub wail {
28 22     22 1 57 my ($self, @args) = @_;
29 22         136 my $msg = __message( @args );
30 22 100       80 ref $msg
31             and die $msg;
32 21         37 chomp $msg;
33 21 50       95 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         83 $msg =~ s/[.?!]\z//msx;
42 21         160 require Carp;
43 21         5929 Carp::croak( $msg );
44             }
45             }
46              
47             sub warning {
48 31     31 1 63 my ( $self, @arg ) = @_;
49 31 100       82 if ( @arg ) {
50 7         29 $self->{warning} = shift @arg;
51 7         20 return $self;
52             } else {
53 24         95 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 10 my ($self, @args) = @_;
67 3         15 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         6 chomp $msg;
74 3 50       14 if ($self->warning()) {
75 0 0       0 $msg =~ m/ [.?!] \z /msx or $msg .= '.';
76 0         0 warn $msg, "\n";
77             } else {
78 3         26 $msg =~ s/ [.?!] \z //msx;
79 3         41 require Carp;
80 3         496 Carp::carp( $msg );
81             }
82 3         22 return;
83             }
84              
85             1;
86              
87             __END__