1package Astro::App::Satpass2::ParseTime::Date::Manip::v6; 2 3use strict; 4use warnings; 5 6use Astro::Coord::ECI::Utils 0.112 qw{ looks_like_number greg_time_gm }; 7 8use parent qw{ Astro::App::Satpass2::ParseTime::Date::Manip }; 9 10use Astro::App::Satpass2::Utils qw{ load_package @CARP_NOT }; 11 12our $VERSION = '0.049'; 13 14my $invalid; 15 16BEGIN { 17 eval { 18 load_package( 'Date::Manip' ) 19 or return; 20 load_package( 'Date::Manip::Date' ) 21 or return; 22 my $ver = Date::Manip->VERSION(); 23 $ver =~ s/ _ //smxg; 24 $ver >= 6 25 and do { 26 Date::Manip->import(); 27 1; 28 } 29 or $invalid = sprintf 30 '%s assumes a Date::Manip version >= 6. You have %s', 31 __PACKAGE__, Date::Manip->VERSION(); 32 $ver >= 6.49 33 and *_normalize_zone = sub { 34 $_[0] =~ s/ \A (?: gmt | ut ) \z /UT/smxi; 35 }; 36 1; 37 } or $invalid = ( $@ || 'Unable to load Date::Manip' ); 38 __PACKAGE__->can( '_normalize_zone' ) 39 or *_normalize_zone = sub{}; 40} 41 42my $epoch_offset = greg_time_gm( 0, 0, 0, 1, 0, 1970 ); 43 44sub delegate { 45 return __PACKAGE__; 46} 47 48sub dmd_err { 49 my ( $self ) = @_; 50 return $self->_get_dm_field( 'object' )->err(); 51} 52 53sub dmd_zone { 54 my ( $self ) = @_; 55 return scalar $self->_get_dm_field( 'object' )->tz->zone(); 56} 57 58sub parse_time_absolute { 59 my ( $self, $string ) = @_; 60 $invalid and $self->wail( $invalid ); 61 my $dm = $self->_get_dm_field( 'object' ); 62 $dm->parse( $string ) and return; 63 return $dm->secs_since_1970_GMT() - $epoch_offset; 64} 65 66sub use_perltime { 67 return 0; 68} 69 70sub tz { 71 my ( $self, @args ) = @_; 72 $invalid and $self->wail( $invalid ); 73 if ( @args ) { 74 my $zone = $args[0]; 75 my $dm = $self->_get_dm_field( 'object' ); 76 defined $zone and '' ne $zone 77 or $zone = $self->_get_dm_field( 'default_zone' ); 78 _normalize_zone( $zone ); 79 $dm->config( setdate => "zone,$zone" ); 80 } 81 return $self->SUPER::tz( @args ); 82} 83 84sub __back_end_validate { 85 my ( $self, $cls ) = @_; 86 $cls->can( 'parse' ) 87 or $self->wail( "$cls does not have a parse() method" ); 88 return; 89} 90 91sub __set_back_end_location { 92 my ( $self, $location ) = @_; 93 if ( my $dm = $self->_get_dm_field( 'object' ) ) { 94 # NOTE that we have no way to introspect Date::Manip::Date (or 95 # any other back end) to see if it has the 'location' config, so 96 # since Date::Manip uses warn() to report errors, we just 97 # blindly set it and swallow the possible warning. 98 local $SIG{__WARN__} = sub {}; 99 $dm->config( location => $location ); 100 } 101 return; 102} 103 104sub _get_dm_field { 105 my ( $self, $field ) = @_; 106 my $info = $self->{+__PACKAGE__} ||= $self->_make_dm_hash(); 107 return $info->{$field}; 108} 109 110sub _make_dm_hash { 111 my ( $self ) = @_; 112 113 # Workaround for bug (well, _I_ think it's a bug) introduced into 114 # Date::Manip with 6.34, while fixing RT #78566. My bug report is RT 115 # #80435. 116 my $path = $ENV{PATH}; 117 local $ENV{PATH} = $path; 118 119 my $back_end = $self->back_end() || 'Date::Manip::Date'; 120 my $dm = $back_end->new(); 121 return { 122 default_zone => scalar $dm->tz->zone(), 123 object => $dm, 124 }; 125} 126 1271; 128 129=head1 NAME 130 131Astro::App::Satpass2::ParseTime::Date::Manip::v6 - Astro::App::Satpass2 wrapper for Date::Manip v6 or greater 132 133=head1 SYNOPSIS 134 135No user-serviceable parts inside. 136 137=head1 DETAILS 138 139This class wraps the L<Date::Manip::Date|Date::Manip::Date> object from 140L<Date::Manip|Date::Manip> version 6.0 or higher, and uses it to parse 141dates. It ignores the C<perltime> mechanism. 142 143B<Caveat:> the L<Date::Manip|Date::Manip> configuration mechanism (used 144to set the time zone) reports errors using the C<warn> built-in, rather 145than by returning a bad status or throwing an exception. Yes, I could 146use the C<$SIG{__WARN__}> hook to trap this, but I would rather hope 147that Mr. Beck will provide a more friendly mechanism. 148 149=head1 METHODS 150 151This class supports the following public methods over and above those 152documented in its superclass 153L<Astro::App::Satpass2::ParseTime|Astro::App::Satpass2::ParseTime>. 154 155=head2 dmd_err 156 157 my $error_string = $pt->dmd_err(); 158 159This method wraps the L<Date::Manip::Date|Date::Manip::Date> object's 160C<err()> method, and returns whatever that method 161returns. 162 163=head2 dmd_zone 164 165 my $zone_name = $pt->dmd_zone(); 166 167This method wraps the L<Date::Manip::TZ|Date::Manip::TZ> object's 168C<zone()> method, calling it in scalar context to 169get the default zone name, and returning the result. 170 171Note that unlike the inherited C<tz()> method, this is an accessor 172only, and, it is possible that C<< $pt->dmd_zone() >> will not return 173the same thing that C<< $pt->tz() >> does. For example, 174 175 $pt->tz( 'EST5EDT' ); 176 print '$pt->tz(): ', $pt->tz(), "\n"; 177 print '$pt->dmd_zone(): ', $pt->dmd_zone(), "\n"; 178 179prints 180 181 $pt->tz(): EST5EDT 182 $pt->dmd_zone(): America/New_York 183 184This is because C<< $pt->tz() >> returns the last setting, whereas C<< 185$pt->dmd_zone() >> returns the name of the time zone in the Olson 186zoneinfo database, which is typically something like C<Continent/City>, 187even though the time zone was set using an alias, abbreviation or 188offset. See L<Date::Manip::TZ|Date::Manip::TZ> for the gory details. 189 190Another difference is the if the time zone has never been set, 191C<< $pt->tz() >> will return C<undef>, whereas 192C<< $pt->dmd_zone() >> will actually return the name of the default 193zone. 194 195=head1 SUPPORT 196 197Support is by the author. Please file bug reports at 198L<https://rt.cpan.org/Public/Dist/Display.html?Name=Astro-App-Satpass2>, 199L<https://github.com/trwyant/perl-Astro-App-Satpass2/issues>, or in 200electronic mail to the author. 201 202=head1 AUTHOR 203 204Thomas R. Wyant, III F<wyant at cpan dot org> 205 206=head1 COPYRIGHT AND LICENSE 207 208Copyright (C) 2009-2021 by Thomas R. Wyant, III 209 210This program is free software; you can redistribute it and/or modify it 211under the same terms as Perl 5.10.0. For more details, see the full text 212of the licenses in the directory LICENSES. 213 214This program is distributed in the hope that it will be useful, but 215without any warranty; without even the implied warranty of 216merchantability or fitness for a particular purpose. 217 218=cut 219 220__END__ 221 222# ex: set textwidth=72 : 223