File Coverage

blib/lib/DateTime/Format/DateManip.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package DateTime::Format::DateManip;

use strict;

use vars qw ($VERSION);

$VERSION = '0.04';

use Carp;

use DateTime;
use DateTime::Duration;

use Date::Manip;


# All formats are in the ASCII range so we can safely turn off UTF8 support
use bytes;

# This takes a Date::Manip string and converts it to a DateTime object
# Note that the Date::Manip string just needs to be something that
# Date::Manip::ParseDate() can format.
# undef is returned if the string can not be converted.
sub parse_datetime {
    my ($class, $dm_date) = @_;
    croak "Missing DateManip parseable string" unless defined $dm_date;

    # Get the timezone name and the date information and zome offset from
    # the Date::Manip string.
    my ($dm_tz, @bits) = UnixDate($dm_date, qw( %Z %Y %m %d %H %M %S %z ));
    return undef unless @bits;
    my @args = merge_lists([qw( year month day hour minute second time_zone )],
			   \@bits);

    # Construct the DateTime object and use the offset timezone
    my $dt = DateTime->new(@args);

    # See if there is a better timezone to use
    my $dt_tz = $class->get_dt_timezone($dm_tz);

    # Apply the final time zone
    if (defined $dt_tz) {
	$dt->set_time_zone($dt_tz);
    }

    return $dt;
}

# Takes a DateTime object and returns the corresponding Date::Manip string (in
# the format returned by ParseDate)
sub format_datetime {
    my ($class, $dt) = @_;
    croak "Missing DateTime object" unless defined $dt;

    # Note that we just use the TZ offset since Date::Manip doesn't
    # store time zone information with the dates but sets it system wide
    return ParseDate( $dt->strftime("%Y%m%dT%H%M%S %z") );
}

# Takes a Date::Manip Delta string and returns the corresponding
# DateTime::Duration object or undef
sub parse_duration {
    my ($class, $dm_delta) = @_;
    croak "Missing DateManip parseable delta string" unless defined $dm_delta;

    my @bits = Delta_Format($dm_delta, 0, qw( %yv %Mv %wv %dv %hv %mv %sv ));
    return undef unless @bits;
    my @args = merge_lists([qw( years months weeks days hours minutes seconds )],
			   \@bits);

    # We have to do this in two phases since Date::Manip handles the sign
    # for years and months separately from the sign for the rest.
    # DateTime::Duration assumes that the sign is the same across all
    # items so we make the inital duration with years and months and add
    # the second duration (which may be negative) to finish the duration
    my $dt_dur = DateTime::Duration->new(@args[0..3]); # Year and month
    $dt_dur->add(@args[4..13]);                        # The rest

    return $dt_dur;
}

# Takes a DateTime::Duration object and returns the corresponding
# Date::Manip Delta string (in the format returned by ParseDateDelta)
sub format_duration {
    my ($class, $dt_dur) = @_;
    croak "Missing DateTime::Duration object" unless defined $dt_dur;

    # Not all elements are defined (if they can be derived from smaller elements)
    my %bits = $dt_dur->deltas();
    my $str = join(":",
	       0, # Years
	       $bits{months},
	       0, # Weeks
	       $bits{days},
	       0, # Hours
	       $bits{minutes},
	       $bits{seconds},
	       );
    my $dm_dur = ParseDateDelta($str);

    return $dm_dur;
}


BEGIN {
    # Date::Manip to DateTime timezone mapping (where possible)
    my %TZ_MAP =
	(
	 # Abbreviations (see http://www.worldtimezone.com/wtz-names/timezonenames.html)
	 # [1] - YST matches worldtimezone.com but not Canada/Yukon
	 # [2] - AT  matches worldtimezone.com but not Atlantic/Azores
	 # [3] - City chosen at random from similar matches
	 idlw   => "-1200",                # International Date Line West (-1200)
	 nt     => "-1100",                # Nome (-1100) (obs. -1967)
	 hst    => "US/Hawaii",            # Hawaii Standard (-1000)
	 cat    => "-1000",                # Central Alaska (-1000) (obs. -1967)
	 ahst   => "-1000",                # Alaska-Hawaii Standard (-1000) (obs. 1967-1983)
	 akst   => "US/Alaska",            # Alaska Standard (-0900)
	 yst    => "-0900",                # Yukon Standard (-0900) [1]
	 hdt    => "-0900",                # Hawaii Daylight (-0900) (until 1947?)
	 akdt   => "US/Alaska",            # Alaska Daylight (-0800)
	 ydt    => "-0800",                # Yukon Daylight (-0900) [1]
	 pst    => "US/Pacific",           # Pacific Standard (-0800)
	 pdt    => "US/Pacific",           # Pacific Daylight (-0700)
	 mst    => "US/Mountain",          # Mountain Standard (-0700)
	 mdt    => "US/Mountain",          # Mountain Daylight (-0600)
	 cst    => "US/Central",           # Central Standard (-0600)
	 cdt    => "US/Central",           # Central Daylight (-0500)
	 est    => "US/Eastern",           # Eastern Standard (-0500)
	 sat    => "-0400",                # Chile (-0400)
	 edt    => "US/Eastern",           # Eastern Daylight (-0400)
	 ast    => "Canada/Atlantic",      # Atlantic Standard (-0400)
	 #nst   => "Canada/Newfoundland",  # Newfoundland Standard (-0300)     nst=North Sumatra    +0630
	 nft    => "Canada/Newfoundland",  # Newfoundland (-0330)
	 #gst   => "-0300",  # Greenland Standard (-0300)        gst=Guam Standard    +1000
	 #bst   => "Brazil/East",          # Brazil Standard (-0300)           bst=British Summer   +0100
	 adt    => "Canada/Atlantic",      # Atlantic Daylight (-0300)
	 ndt    => "Canada/Newfoundland",  # Newfoundland Daylight (-0230)
	 at     => "-0200",                # Azores (-0200) [2]
	 wat    => "Africa/Bangui",        # West Africa (-0100) [3]
	 gmt    => "Europe/London",        # Greenwich Mean (+0000)
	 ut     => "Etc/Universal",        # Universal (+0000)
	 utc    => "UTC",                  # Universal (Coordinated) (+0000)
	 wet    => "Europe/Lisbon",        # Western European (+0000) [3]
	 west   => "Europe/Lisbon",        # Alias for Western European (+0000) [3]
	 cet    => "Europe/Madrid",        # Central European (+0100)
	 fwt    => "Europe/Paris",         # French Winter (+0100)
	 met    => "Europe/Brussels",      # Middle European (+0100)
	 mez    => "Europe/Berlin",        # Middle European (+0100)
	 mewt   => "Europe/Brussels",      # Middle European Winter (+0100)
	 swt    => "Europe/Stockholm",     # Swedish Winter (+0100)
	 bst    => "Europe/London",        # British Summer (+0100)             bst=Brazil standard  -0300
	 gb     => "Europe/London",        # GMT with daylight savings (+0100)
	 eet    => "Europe/Bucharest",     # Eastern Europe, USSR Zone 1 (+0200)
	 cest   => "Europe/Madrid",        # Central European Summer (+0200)
	 fst    => "Europe/Paris",         # French Summer (+0200)
#     ist    => "Asia/Jerusalem",       # Israel standard (+0200) (duplicate of Indian)
	 mest   => "Europe/Brussels",      # Middle European Summer (+0200)
	 mesz   => "Europe/Berlin",        # Middle European Summer (+0200)
	 metdst => "Europe/Brussels",      # An alias for mest used by HP-UX (+0200)
	 sast   => "Africa/Johannesburg",  # South African Standard (+0200)
	 sst    => "Europe/Stockholm",     # Swedish Summer (+0200)             sst=South Sumatra    +0700
	 bt     => "+0300",                # Baghdad, USSR Zone 2 (+0300)
	 eest   => "Europe/Bucharest",     # Eastern Europe Summer (+0300)
	 eetedt => "Europe/Bucharest",     # Eastern Europe, USSR Zone 1 (+0300)
#     idt    => "Asia/Jerusalem",       # Israel Daylight (+0300) [Jerusalem doesn't honor DST)
	 msk    => "Europe/Moscow",        # Moscow (+0300)
	 it     => "Asia/Tehran",          # Iran (+0330)
	 zp4    => "+0400",                # USSR Zone 3 (+0400)
	 msd    => "Europe/Moscow",        # Moscow Daylight (+0400)
	 zp5    => "+0500",                # USSR Zone 4 (+0500)
	 ist    => "Asia/Calcutta",        # Indian Standard (+0530)
	 zp6    => "+0600",                # USSR Zone 5 (+0600)
	 nst    => "+0630",                # North Sumatra (+0630)             nst=Newfoundland Std -0330
	 #sst   => "+0700",  # South Sumatra, USSR Zone 6 sst=Swedish Summer   +0200
	 hkt    => "Asia/Hong_Kong",       # Hong Kong (+0800)
	 sgt    => "Asia/Singapore",       # Singapore  (+0800)
	 cct    => "Asia/Shanghai",        # China Coast, USSR Zone 7 (+0800)
	 awst   => "Australia/West",       # West Australian Standard (+0800)
	 wst    => "Australia/West",       # West Australian Standard (+0800)
	 pht    => "Asia/Manila",          # Asia Manila (+0800)
	 kst    => "Asia/Seoul",           # Republic of Korea (+0900)
	 jst    => "Asia/Tokyo",           # Japan Standard, USSR Zone 8 (+0900)
	 rok    => "ROK",                  # Republic of Korea (+0900)
	 cast   => "Australia/South",      # Central Australian Standard (+0930)
	 east   => "Australia/Victoria",   # Eastern Australian Standard (+1000)
	 gst    => "Pacific/Guam",         # Guam Standard, USSR Zone 9 gst=Greenland Std    -0300
	 cadt   => "Australia/South",      # Central Australian Daylight (+1030)
	 eadt   => "Australia/Victoria",   # Eastern Australian Daylight (+1100)
	 idle   => "+1200",                # International Date Line East
	 nzst   => "Pacific/Auckland",     # New Zealand Standard
	 nzt    => "Pacific/Auckland",     # New Zealand
	 nzdt   => "Pacific/Auckland",     # New Zealand Daylight

	 # US Military Zones
	 z      => "+0000",
	 a      => "+0100",
	 b      => "+0200",
	 c      => "+0300",
	 d      => "+0400",
	 e      => "+0500",
	 f      => "+0600",
	 g      => "+0700",
	 h      => "+0800",
	 i      => "+0900",
	 k      => "+1000",
	 l      => "+1100",
	 m      => "+1200",
	 n      => "-0100",
	 o      => "-0200",
	 p      => "-0300",
	 q      => "-0400",
	 r      => "-0500",
	 s      => "-0600",
	 t      => "-0700",
	 u      => "-0800",
	 v      => "-0900",
	 w      => "-1000",
	 x      => "-1100",
	 y      => "-1200",
	 );

# Return the DateTime timezone corresponding to the given Date::Manip timezone or
# return undef if there is no match.
sub get_dt_timezone {
    my ($class, $dm_tz) = @_;

    # Work out the time zone that Date::Manip was using and try to reproduce it
    # in DateTime
    my $dt_tz = $dm_tz;
    if ($dm_tz =~ m{/}) {
	# Don't change it since it is in the complete form already
	# (e.g. America/New_York)
    }
    elsif ($dm_tz =~ m/^[-+]\d+$/) {
	# It is an offset, leave it alone (e.g. -0500)
    }
    else {
	# Look it up
	my $lc_tz = lc $dm_tz;
	$dt_tz = $TZ_MAP{$lc_tz};
    }

    return $dt_tz;
}
}

# Take a list of keys and a list of values and insersperse them and
# return the result
sub merge_lists {
    my ($keys, $values) = @_;
    die "Length mismatch" unless @$keys == @$values;

    # Add the argument names to the values
    my @result;
    for (my $i = 0; $i < @$keys; $i++) {
	push @result, $keys->[$i] => $values->[$i];
    }

    return @result;
}

1;


__END__