| 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__ |