File Coverage

blib/lib/Astro/App/Satpass2/ParseTime/Date/Manip/v5.pm
Criterion Covered Total %
statement 18 47 38.3
branch 2 26 7.6
condition 1 5 20.0
subroutine 6 12 50.0
pod 5 5 100.0
total 32 95 33.6


line stmt bran cond sub pod time code
1             package Astro::App::Satpass2::ParseTime::Date::Manip::v5;
2              
3 1     1   1058 use strict;
  1         2  
  1         30  
4 1     1   5 use warnings;
  1         10  
  1         35  
5              
6 1         60 use Astro::Coord::ECI::Utils 0.112 qw{
7 1     1   6 looks_like_number greg_time_local };
  1         18  
8              
9 1     1   6 use parent qw{ Astro::App::Satpass2::ParseTime::Date::Manip };
  1         2  
  1         10  
10              
11 1     1   62 use Astro::App::Satpass2::Utils qw{ load_package @CARP_NOT };
  1         2  
  1         205  
12              
13             our $VERSION = '0.051_01';
14              
15             my $invalid;
16              
17             BEGIN {
18 1 50 50 1   16 eval {
19 1         8 local $Date::Manip::Backend = 'DM5';
20              
21 1 50       4 load_package( 'Date::Manip' )
22             or return;
23              
24 0           Date::Manip->import();
25 0           1;
26             } or $invalid = ( $@ || 'Unable to load Date::Manip' );
27             }
28              
29             my ( $default_zone ) = eval {
30             grep { m{ \A TZ= }smx } Date_Init()
31             };
32              
33             sub delegate {
34 0     0 1   return __PACKAGE__;
35             }
36              
37             sub parse_time_absolute {
38 0     0 1   my ( $self, $string ) = @_;
39 0 0         $invalid and $self->wail( $invalid );
40 0           my $time = UnixDate( $string, '%s' ) - $self->__epoch_offset();
41 0 0         if ( $self->perltime() ) {
42 0           my @gt = gmtime $time;
43 0           $gt[5] += 1900;
44 0           $time = greg_time_local( @gt );
45             }
46 0           return $time;
47             }
48              
49             sub perltime {
50 0     0 1   my ( $self, @args ) = @_;
51 0 0         $invalid and $self->wail( $invalid );
52 0 0         if ( @args ) {
53 0 0         my $zone = $args[0] ? 'GMT' : $self->tz();
54 0 0         $zone = defined $zone ? "TZ=$zone" : $default_zone;
55 0           Date_Init( $zone );
56             }
57 0           return $self->SUPER::perltime( @args );
58             }
59              
60             sub use_perltime {
61 0     0 1   return 1;
62             }
63              
64             sub tz {
65 0     0 1   my ( $self, @args ) = @_;
66 0 0         $invalid and $self->wail( $invalid );
67 0 0         if ( @args ) {
68 0 0 0       if ( $args[0] || looks_like_number( $args[0] ) ) {
69 0           $ENV{TZ} = $args[0]; ## no critic (RequireLocalizedPunctuationVars)
70 0 0         $self->perltime() or Date_Init( "TZ=$args[0]" );
71             } else {
72 0           delete $ENV{TZ};
73 0 0         $self->perltime() or Date_Init( $default_zone );
74             }
75             }
76 0           return $self->SUPER::tz( @args );
77             }
78              
79             sub __set_back_end_location {
80 0     0     return;
81             };
82              
83             1;
84              
85             =head1 NAME
86              
87             Astro::App::Satpass2::ParseTime::Date::Manip::v5 - Astro::App::Satpass2 wrapper for Date::Manip v5 interface
88              
89             =head1 SYNOPSIS
90              
91             No user-serviceable parts inside.
92              
93             =head1 DETAILS
94              
95             This class wraps L version 5.54 or lower and
96             the C back-end for L 6.0 and higher, and
97             uses it to parse dates. It uses the C mechanism, since these
98             versions of L do not understand summer time.
99              
100             =head1 METHODS
101              
102             This class supports no public methods over and above those documented in
103             its superclass
104             L.
105              
106             =head1 SUPPORT
107              
108             Support is by the author. Please file bug reports at
109             L,
110             L, or in
111             electronic mail to the author.
112              
113             =head1 AUTHOR
114              
115             Thomas R. Wyant, III F
116              
117             =head1 COPYRIGHT AND LICENSE
118              
119             Copyright (C) 2009-2023 by Thomas R. Wyant, III
120              
121             This program is free software; you can redistribute it and/or modify it
122             under the same terms as Perl 5.10.0. For more details, see the full text
123             of the licenses in the directory LICENSES.
124              
125             This program is distributed in the hope that it will be useful, but
126             without any warranty; without even the implied warranty of
127             merchantability or fitness for a particular purpose.
128              
129             =cut
130              
131             __END__