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__ =head1 NAME DateTime::Format::DateManip - Perl DateTime extension to convert Date::Manip dates and durations to DateTimes and vice versa. =head1 SYNOPSIS use Date::Manip; use DateTime::Format::DateManip; # Date::Manip to DateTime my $dm = ParseDate("January 1st, 2001"); my $dt = DateTime::Format::DateManip->parse_datetime($dm); $dt->add( weeks => 1 ); # And back again my $dm2 = DateTime::Format::DateManip->format_datetime($dt); # Same thing with a duration my $dm_delta = ParseDateDelta("3 years 2 days -4 hours +3mn -2 second"); my $dt_dur = DateTime::Format::DateManip->parse_duration($dm_delta); my $dm_delta2 = DateTime::Format::DateManip->format_duration($dt_dur); # Note that we can parse any string that is in the appropriate format # there is no need to call ParseDate or ParseDateDelta first: my $dt2 = DateTime::Format::DateManip->parse_datetime("In 2 hours"); my $dt_dur2 = DateTime::Format::DateManip->parse_duration("3 years"); =head1 DESCRIPTION DateTime::Format::DateManip is a class that knows how to convert between C dates and durations and C and C objects. Recurrences are note yet supported. =head1 USAGE =head2 Time Zones C can have a time zone set globally and it keeps the dates it produces in the local time. In all cases we rely on the GMT offset to set up the C object. However, we try to work out what the matching timezone is using the C nomenclature and create the object in the correct time zone so the date is correct if dajustments to the date object pushes it over a DST change. Note that we call C to make the change, so the absolute time is not affected by the time zone change. However, not all C time zones have reasonable mappings (for example NT and CAT both appear to be obsolete). It is unlikely that a user will have their time zone set to one of these items. If we are unable to work out the mapping we simply use the GMT offset and do not set a timezone. When converting to a C we only need to tell C the GMT offset and it will automatically convert to the local time zone that is in effect. =head2 Class Methods =over 4 =item * parse_datetime( $date_manip_string ) This method takes the input string and returns the corresponding C object. If C was unable to parse the input string then undef will be returned. See the note above about Time Zones. =item * format_datetime( $datetime_object ) This method takes the given C object and returns a corresponding C parseable string. See the note above about Time Zones. =item * parse_duration( $date_manip_duration_string ) This method takes the giben duration string and returns the corresponding C object. If C was unable to parse the input string then undef will be returned. =item * format_duration( $datetime_duration_object ) This method takes the given C object and returns a corresponding C parseable string. =back =head1 AUTHOR Ben Bennett =head1 COPYRIGHT Copyright (c) 2003 Ben Bennett. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Portions of the code in this distribution are derived from other works. Please see the CREDITS file for more details. The full text of the license can be found in the LICENSE file included with this module. =head1 SEE ALSO datetime@perl.org mailing list http://datetime.perl.org/ =cut