view release on metacpan or  search on metacpan

lib/Astro/App/Satpass2/ParseTime/Date/Manip/v6.pm  view on Meta::CPAN

	    or return;
	load_package( 'Date::Manip::Date' )
	    or return;
	my $ver = Date::Manip->VERSION();
	$ver =~ s/ _ //smxg;
	$ver >= 6
	    and do {
		Date::Manip->import();
		1;
	    }
	    or $invalid = sprintf
		'%s assumes a Date::Manip version >= 6. You have %s',
		__PACKAGE__, Date::Manip->VERSION();
	$ver >= 6.49
	    and *_normalize_zone = sub {
		$_[0] =~ s/ \A (?: gmt | ut ) \z /UT/smxi;
	    };
	1;
    } or $invalid = ( $@ || 'Unable to load Date::Manip' );
    __PACKAGE__->can( '_normalize_zone' )
	or *_normalize_zone = sub{};
}

sub delegate {
    return __PACKAGE__;
}

sub dmd_err {
    my ( $self ) = @_;
    return $self->_get_dm_field( 'object' )->err();
}

sub dmd_zone {
    my ( $self ) = @_;
    return scalar $self->_get_dm_field( 'object' )->tz->zone();
}

sub parse_time_absolute {
    my ( $self, $string ) = @_;
    $invalid and $self->wail( $invalid );
    my $dm = $self->_get_dm_field( 'object' );
    $dm->parse( $string ) and return;
    return $dm->secs_since_1970_GMT() - $self->__epoch_offset();
}

sub use_perltime {
    return 0;
}

sub tz {
    my ( $self, @args ) = @_;
    $invalid and $self->wail( $invalid );
    if ( @args ) {
	my $zone = $args[0];
	my $dm = $self->_get_dm_field( 'object' );
	defined $zone and '' ne $zone
	    or $zone = $self->_get_dm_field( 'default_zone' );
	_normalize_zone( $zone ); 
	$dm->config( setdate => "zone,$zone" );
    }
    return $self->SUPER::tz( @args );
}

sub __back_end_validate {
    my ( $self, $cls ) = @_;
    $cls->can( 'parse' )
	or $self->wail( "$cls does not have a parse() method" );
    return;
}

sub __set_back_end_location {
    my ( $self, $location ) = @_;
    if ( my $dm = $self->_get_dm_field( 'object' ) ) {
	# NOTE that we have no way to introspect Date::Manip::Date (or
	# any other back end) to see if it has the 'location' config, so
	# since Date::Manip uses warn() to report errors, we just
	# blindly set it and swallow the possible warning.
	local $SIG{__WARN__} = sub {};
	$dm->config( location => $location );
    }
    return;
}

sub _get_dm_field {
    my ( $self, $field ) = @_;
    my $info = $self->{+__PACKAGE__} ||= $self->_make_dm_hash();
    return $info->{$field};
}

sub _make_dm_hash {
    my ( $self ) = @_;

    # Workaround for bug (well, _I_ think it's a bug) introduced into
    # Date::Manip with 6.34, while fixing RT #78566. My bug report is RT
    # #80435.
    my $path = $ENV{PATH};
    local $ENV{PATH} = $path;

    my $back_end = $self->back_end() || 'Date::Manip::Date';
    my $dm = $back_end->new();
    return {
	default_zone	=> scalar $dm->tz->zone(),
	object		=> $dm,
    };
}

1;

=head1 NAME

Astro::App::Satpass2::ParseTime::Date::Manip::v6 - Astro::App::Satpass2 wrapper for Date::Manip v6 or greater

=head1 SYNOPSIS

No user-serviceable parts inside.

=head1 DETAILS

This class wraps the L<Date::Manip::Date|Date::Manip::Date> object from
L<Date::Manip|Date::Manip> version 6.0 or higher, and uses it to parse
dates. It ignores the C<perltime> mechanism.