File Coverage

blib/lib/DateTime/Format/Pg.pm
Criterion Covered Total %
statement 145 168 86.3
branch 65 88 73.8
condition 25 38 65.7
subroutine 26 31 83.8
pod 13 13 100.0
total 274 338 81.0


line stmt bran cond sub pod time code
1             package DateTime::Format::Pg;
2              
3 22     22   5267542 use strict;
  22         182  
  22         721  
4 22     22   106 use vars qw ($VERSION);
  22         37  
  22         904  
5              
6 22     22   105 use Carp;
  22         40  
  22         1241  
7 22     22   11004 use DateTime 0.13;
  22         6225256  
  22         895  
8 22     22   168 use DateTime::Duration;
  22         44  
  22         632  
9 22     22   12810 use DateTime::Format::Builder 0.72;
  22         1331980  
  22         162  
10 22     22   913 use DateTime::TimeZone 0.06;
  22         264  
  22         496  
11 22     22   111 use DateTime::TimeZone::UTC;
  22         52  
  22         584  
12 22     22   108 use DateTime::TimeZone::Floating;
  22         41  
  22         72012  
13              
14             $VERSION = '0.16014';
15             $VERSION = eval $VERSION;
16              
17             our @ISA = ('DateTime::Format::Builder');
18              
19             =head1 NAME
20              
21             DateTime::Format::Pg - Parse and format PostgreSQL dates and times
22              
23             =head1 SYNOPSIS
24              
25             use DateTime::Format::Pg;
26              
27             my $dt = DateTime::Format::Pg->parse_datetime( '2003-01-16 23:12:01' );
28              
29             # 2003-01-16 23:12:01
30             DateTime::Format::Pg->format_datetime($dt);
31              
32             =head1 DESCRIPTION
33              
34             This module understands the formats used by PostgreSQL for its DATE, TIME,
35             TIMESTAMP, and INTERVAL data types. It can be used to parse these formats in
36             order to create C<DateTime> or C<DateTime::Duration> objects, and it can take a
37             C<DateTime> or C<DateTime::Duration> object and produce a string representing
38             it in a format accepted by PostgreSQL.
39              
40             =head1 CONSTRUCTORS
41              
42             The following methods can be used to create C<DateTime::Format::Pg> objects.
43              
44             =over 4
45              
46             =item * new( name => value, ... )
47              
48             Creates a new C<DateTime::Format::Pg> instance. This is generally not
49             required for simple operations. If you wish to use a different parsing
50             style from the default then it is more comfortable to create an object.
51              
52             my $parser = DateTime::Format::Pg->new()
53             my $copy = $parser->new( 'european' => 1 );
54              
55             This method accepts the following options:
56              
57             =over 8
58              
59             =item * european
60              
61             If european is set to non-zero, dates are assumed to be in european
62             dd/mm/yyyy format. The default is to assume US mm/dd/yyyy format
63             (because this is the default for PostgreSQL).
64              
65             This option only has an effect if PostgreSQL is set to output dates in
66             the 'PostgreSQL' (DATE only) and 'SQL' (DATE and TIMESTAMP) styles.
67              
68             Note that you don't have to set this option if the PostgreSQL server has
69             been set to use the 'ISO' format, which is the default.
70              
71             =item * server_tz
72              
73             This option can be set to a C<DateTime::TimeZone> object or a string
74             that contains a time zone name.
75              
76             This value must be set to the same value as the PostgreSQL server's time
77             zone in order to parse TIMESTAMP WITH TIMEZONE values in the
78             'PostgreSQL', 'SQL', and 'German' formats correctly.
79              
80             Note that you don't have to set this option if the PostgreSQL server has
81             been set to use the 'ISO' format, which is the default.
82              
83             =back
84              
85             =cut
86              
87             sub _add_param
88             {
89 2     2   9 my ($to,%param) = @_;
90 2         6 foreach(keys %param)
91             {
92 2 50       5 if($_ eq 'european') {
    0          
93 2         12 $$to{'_european'} = $param{$_};
94             } elsif($_ eq 'server_tz') {
95 0         0 $$to{'_server_tz'} = $param{$_};
96             } else {
97 0         0 croak("Unknown option $_." );
98             }
99             }
100             }
101              
102             sub european {
103 14     14 1 32 my ($self,%param) = @_;
104 14 100       53 return $param{'european'} if exists $param{'european'};
105 2 50       12 return $self->{'_european'} if ref $self;
106             }
107              
108             sub server_tz {
109 0     0 1 0 my ($self,%param) = @_;
110 0 0       0 return $param{''} if (ref($param{'server_tz'})) =~ /TimeZone/;
111 0 0       0 return DateTime::TimeZone->new('name' => $param{''}) if exists $param{'server_tz'};
112 0   0     0 return ((ref $self) && $self->{'_server_tz'});
113             }
114              
115             sub new
116             {
117 2     2 1 129 my $class = shift;
118 2   33     11 my $self = bless {}, ref($class)||$class;
119 2 50       6 if (ref $class)
120             {
121 0         0 $self->{'_european'} = ( scalar $class->{'_european'} );
122             }
123 2         24 _add_param($self,@_);
124 2         5 return $self;
125             }
126              
127             =item * clone()
128              
129             This method is provided for those who prefer to explicitly clone via a
130             method called C<clone()>.
131              
132             my $clone = $original->clone();
133              
134             If called as a class method it will die.
135              
136             =back
137              
138             =cut
139              
140             sub clone
141             {
142 0     0 1 0 my $self = shift;
143 0 0       0 croak('Calling object method as class method!') unless ref $self;
144 0         0 return $self->new();
145             }
146              
147             sub _create_infinity
148             {
149 6     6   2720 my $self = shift;
150 6         14 my %p = @_;
151              
152 6 100       325 if ($p{sign}) {
153 3         15 return DateTime::Infinite::Past->new;
154             } else {
155 3         57 return DateTime::Infinite::Future->new;
156             }
157             }
158              
159             # infinite datetimes
160             my $pg_infinity =
161             {
162             regex => qr/^(-)?infinity$/,
163             params => [ qw(sign) ],
164             constructor => \&_create_infinity,
165             };
166              
167             # Dates (without time zone)
168             #
169             # see EncodeDateOnly() in
170             # pgsql-server/src/backend/utils/adt/datetime.c
171             #
172             # 2003-04-18 (USE_ISO_DATES)
173             #
174             my $pg_dateonly_iso =
175             {
176             regex => qr/^(\d{4,})-(\d{2,})-(\d{2,})( BC)?$/,
177             params => [ qw( year month day era ) ],
178             postprocess => \&_fix_era,
179             };
180              
181             # 18/04/2003 (USE_SQL_DATES, EuroDates)
182             # 18-04-2003 (USE_POSTGRES_DATES, EuroDates)
183             # 04/18/2003 (USE_SQL_DATES, !EuroDates)
184             # 04-18-2003 (USE_POSTGRES_DATES, !EuroDates)
185             #
186             my $pg_dateonly_sql =
187             {
188             regex => qr/^(\d{2,})[\/-](\d{2,})[\/-](\d{4,})( BC)?$/,
189             params => [ qw( month day year era) ],
190             postprocess => [ \&_fix_era, \&_fix_eu ],
191             };
192              
193             # 18.04.2003 (USE_GERMAN_DATES)
194             #
195             my $pg_dateonly_german =
196             {
197             regex => qr/^(\d{2,})\.(\d{2,})\.(\d{4,})( BC)?$/,
198             params => [ qw( day month year era ) ],
199             postprocess => \&_fix_era
200             };
201              
202             # Times (with/without time zone)
203             #
204             # see EncodeTimeOnly() in
205             # pgsql-server/src/backend/utils/adt/datetime.c
206             #
207             # 17:20:24.373942+02
208             # (NB: always uses numerical tz)
209             #
210             my $pg_timeonly =
211             {
212             regex => qr/^T?(\d{2,}):(\d{2,}):(\d{2,})(\.\d+)? *([-\+][\d:]+)?$/,
213             params => [ qw( hour minute second nanosecond time_zone) ],
214             extra => { year => '1970' },
215             postprocess => [ \&_fix_timezone, \&_fix_nanosecond ],
216             };
217              
218             # Timestamps (with/without time zone)
219             #
220             # see EncodeDateTime() in
221             # pgsql-server/src/backend/utils/adt/datetime.c
222             #
223             # 2003-04-18 17:20:24.373942+02 (USE_ISO_DATES)
224             # (NB: always uses numerical tz)
225             my $pg_datetime_iso =
226             {
227             regex =>
228             qr/^
229             (\d{4,})-(\d{2,})-(\d{2,}) # date part
230             [ T] # separator
231             (\d{2,}):(\d{2,}):(\d{2,})(\.\d+)? # time part
232             [ ]*
233             ([-\+][\d:]+)? # numerical timezone
234             ([ ]BC)?
235             $/x,
236             params => [ qw( year month day hour minute second nanosecond time_zone era) ],
237             postprocess => [ \&_fix_era, \&_fix_timezone, \&_fix_nanosecond ],
238             };
239              
240             # * Added for https://github.com/lestrrat-p5/DateTime-Format-Pg/issues/18
241             # Concatenated dates/times are accepted
242             # e.g. YYYYMMDDTHHMMSS
243             my $pg_datetime_iso_concat_date =
244             {
245             regex =>
246             qr/^
247             (\d{4})(\d{2})(\d{2}) # concatenated date
248             [ T] # separator
249             (\d{2,}):(\d{2,}):(\d{2,})(\.\d+)? # time part
250             [ ]*
251             ([-\+][\d:]+)? # numerical timezone
252             ([ ]BC)?
253             $/x,
254             params => [ qw( year month day hour minute second nanosecond time_zone era) ],
255             postprocess => [ \&_fix_era, \&_fix_timezone, \&_fix_nanosecond ],
256             };
257              
258             # Fri 18 Apr 17:20:24.373942 2003 CEST (USE_POSTGRES_DATES, EuroDates)
259             #
260             my $pg_datetime_pg_eu =
261             {
262             regex => qr/^\S{3,} (\d{2,}) (\S{3,}) (\d{2,}):(\d{2,}):(\d{2,})(\.\d+)? (\d{4,}) *((?:[-\+][\d:]+)|(?:\S+))?( BC)?$/,
263             params => [ qw( day month hour minute second nanosecond year time_zone era ) ],
264             postprocess => [ \&_fix_era, \&_fix_timezone, \&_fix_nanosecond ],
265             };
266              
267             # Fri Apr 18 17:20:24.373942 2003 CEST (USE_POSTGRES_DATES, !EuroDates)
268             #
269             my $pg_datetime_pg_us =
270             {
271             regex => qr/^\S{3,} (\S{3,}) (\s{2,}) (\d{2,}):(\d{2,}):(\d{2,})(\.\d+)? (\d{4,}) *((?:[-\+][\d:]+)|(?:\S+))?( BC)?$/,
272             params => [ qw( month day hour minute second nanosecond year time_zone era ) ],
273             postprocess => [ \&_fix_era, \&_fix_month_names, \&_fix_timezone, \&_fix_nanosecond ],
274             };
275              
276             # 18/04/2003 17:20:24.373942 CEST (USE_SQL_DATES, EuroDates)
277             # 04/18/2003 17:20:24.373942 CEST (USE_SQL_DATES, !EuroDates)
278             #
279             my $pg_datetime_sql =
280             {
281             regex => qr/^(\d{2,})\/(\d{2,})\/(\d{4,}) (\d{2,}):(\d{2,}):(\d{2,})(\.\d+)? *((?:[-\+][\d:]+)|(?:\S+))?( BC)?$/,
282             params => [ qw( month day year hour minute second nanosecond time_zone era ) ],
283             postprocess => [ \&_fix_era, \&_fix_eu, \&_fix_timezone, \&_fix_nanosecond ],
284             };
285              
286             # 18.04.2003 17:20:24.373942 CEST (USE_GERMAN_DATES)
287             #
288             my $pg_datetime_german =
289             {
290             regex => qr/^(\d{2,})\.(\d{2,})\.(\d{4,}) (\d{2,}):(\d{2,}):(\d{2,})(\.\d+)? *((?:[-\+][\d:]+)|(?:\S+))?( BC)?$/,
291             params => [ qw( day month year hour minute second nanosecond time_zone era ) ],
292             postprocess => [ \&_fix_era, \&_fix_timezone, \&_fix_nanosecond ],
293             };
294              
295             # Helper functions
296             #
297             # Fix BC dates (1 BC => year 0, 2 BC => year -1)
298             #
299             sub _fix_era {
300 39     39   36141 my %args = @_;
301 39   100     197 my $era = (delete $args{'parsed'}->{'era'}) || '';
302 39 100       107 if ($era =~ m/BC/) {
303 7         21 $args{'parsed'}->{'year'} = 1-$args{'parsed'}->{'year'}
304             }
305 39         104 return 1;
306             }
307              
308             # Fix European dates (swap month and day)
309             #
310             sub _fix_eu {
311 14     14   95 my %args = @_;
312 14 100       32 if($args{'self'}->european(@{$args{'args'}}) ) {
  14         37  
313 7         25 my $save = $args{'parsed'}->{'month'};
314 7         13 $args{'parsed'}->{'month'} = $args{'parsed'}->{'day'};
315 7         13 $args{'parsed'}->{'day'} = $save;
316             }
317 14         32 return 1;
318             }
319              
320             # Fix month names (name => numeric)
321             #
322             my %months = (
323             'jan' => 1, 'feb' => 2, 'mar' => 3, 'apr' => 4,
324             'may' => 5, 'jun' => 6, 'jul' => 7, 'aug' => 8,
325             'sep' => 9, 'oct' =>10, 'nov' =>11, 'dec' =>12, );
326              
327             sub _fix_month_names {
328 0     0   0 my %args = @_;
329 0         0 $args{'parsed'}->{'month'} = $months{lc( $args{'parsed'}->{'month'} )};
330 0 0       0 return $args{'parsed'}->{'month'} ? 1 : undef;
331             }
332              
333             # Fix time zones
334             #
335             sub _fix_timezone {
336 22     22   4437 my %args = @_;
337 22 100       77 my %param = $args{'args'} ? (@{$args{'args'}}) : ();
  2         7  
338            
339 22 100       144 if($param{'_force_tz'}) {
    100          
    50          
340 2         6 $args{'parsed'}->{'time_zone'} = $param{'_force_tz'};
341             }
342              
343             elsif(!defined($args{'parsed'}->{'time_zone'})) {
344             # For very early and late dates, PostgreSQL always returns times in
345             # UTC and does not tell us that it did so.
346             #
347 6 100 66     68 if ( $args{'parsed'}->{'year'} < 1901
      100        
      66        
      66        
      66        
      100        
      100        
348             || ( $args{'parsed'}->{'year'} == 1901 && ($args{'parsed'}->{'month'} < 12 || $args{'parsed'}->{'day'} < 14) )
349             || $args{'parsed'}->{'year'} > 2038
350             || ( $args{'parsed'}->{'year'} == 2038 && ($args{'parsed'}->{'month'} > 01 || $args{'parsed'}->{'day'} > 18) )
351             ) {
352 2         13 $args{'parsed'}->{'time_zone'} = DateTime::TimeZone::UTC->new();
353             }
354              
355             # DT->new() does not like undef time_zone params, which are generated
356             # by the regexps
357             #
358             else {
359 4         8 delete $args{'parsed'}->{'time_zone'};
360             }
361             }
362              
363             # Numerical time zone
364             #
365            
366             elsif($args{'parsed'}->{'time_zone'} =~ m/^([-\+])(\d+)(?::(\d+))?(?::(\d+))?$/) {
367 14         24 my $tz;
368 14 100       57 if (length($2) == 2) {
369             # regular hour notation
370 10   100     89 my ($min, $sec) = ($3 || '00', $4 || '00');
      100        
371 10         80 $tz = sprintf "%s%02d:%02d:%02d", $1, $2, $min, $sec;
372             } else {
373 4         11 $tz = "$1$2";
374             }
375 14         33 $args{'parsed'}->{'time_zone'} = $tz;
376             }
377            
378             # Non-numerical time zone returned, which can be ambiguous :(
379             #
380             else
381             {
382             # XXX This barfs because 'self' may not necessarily be initialized
383             # Need to fix it
384 0 0       0 my $stz = $args{'self'}->server_tz($args{'args'} ? @{$args{'args'}} : ());
  0         0  
385 0   0     0 $args{'parsed'}->{'time_zone'} = $stz || 'floating';
386             }
387              
388 22         102 return 1;
389             }
390              
391             # Fix fractional seconds
392             #
393             sub _fix_nanosecond {
394 22     22   191 my %args = @_;
395 22 100       58 if(defined $args{'parsed'}->{'nanosecond'}) {
396 8         55 $args{'parsed'}->{'nanosecond'} = sprintf '%.0f', $args{'parsed'}->{'nanosecond'} * 1.0E9;
397             } else {
398 14         29 delete $args{'parsed'}->{'nanosecond'}
399             };
400 22         52 return 1;
401             }
402              
403             # Parser generation
404             #
405             DateTime::Format::Builder->create_class(
406             parsers => {
407             parse_date => [
408             $pg_dateonly_iso,
409             $pg_dateonly_sql,
410             $pg_dateonly_german,
411             $pg_infinity,
412             ],
413             parse_timetz => [
414             $pg_timeonly,
415             ],
416             parse_timestamptz => [
417             $pg_datetime_iso,
418             $pg_datetime_iso_concat_date,
419             $pg_datetime_pg_eu,
420             $pg_datetime_pg_us,
421             $pg_datetime_sql,
422             $pg_datetime_german,
423             $pg_infinity,
424             ],
425             parse_datetime => [
426             $pg_datetime_iso,
427             $pg_datetime_iso_concat_date,
428             $pg_datetime_pg_eu,
429             $pg_datetime_pg_us,
430             $pg_datetime_sql,
431             $pg_datetime_german,
432             $pg_dateonly_iso,
433             $pg_dateonly_german,
434             $pg_dateonly_sql,
435             $pg_timeonly,
436             $pg_infinity,
437             ],
438             }
439             );
440              
441             =head1 METHODS
442              
443             This class provides the following methods. The parse_datetime, parse_duration,
444             format_datetime, and format_duration methods are general-purpose methods
445             provided for compatibility with other C<DateTime::Format> modules.
446              
447             The other methods are specific to the corresponding PostgreSQL date/time data
448             types. The names of these methods are derived from the name of the PostgreSQL
449             data type. (Note: Prior to PostgreSQL 7.3, the TIMESTAMP type was equivalent
450             to the TIMESTAMP WITH TIME ZONE type. This data type corresponds to the
451             format/parse_timestamp_with_time_zone method but not to the
452             format/parse_timestamp method.)
453              
454             =head2 PARSING METHODS
455              
456             This class provides the following parsing methods.
457              
458             As a general rule, the parsing methods accept input in any format that the
459             PostgreSQL server can produce. However, if PostgreSQL's DateStyle is set to
460             'SQL' or 'PostgreSQL', dates can only be parsed correctly if the 'european'
461             option is set correctly (i.e. same as the PostgreSQL server). The same is true
462             for time zones and the 'australian_timezones' option in all modes but 'ISO'.
463              
464             The default DateStyle, 'ISO', will always produce unambiguous results
465             and is also parsed most efficiently by this parser class. I strongly
466             recommend using this setting unless you have a good reason not to.
467              
468             =over 4
469              
470             =item * parse_datetime($string,...)
471              
472             Given a string containing a date and/or time representation, this method
473             will return a new C<DateTime> object.
474              
475             If the input string does not contain a date, it is set to 1970-01-01.
476             If the input string does not contain a time, it is set to 00:00:00.
477             If the input string does not contain a time zone, it is set to the
478             floating time zone.
479              
480             If given an improperly formatted string, this method may die.
481              
482             =cut
483              
484             # sub parse_datetime {
485             # *** created automatically ***
486             # }
487              
488             =item * parse_timestamptz($string,...)
489              
490             =item * parse_timestamp_with_time_zone($string,...)
491              
492             Given a string containing a timestamp (date and time) representation,
493             this method will return a new C<DateTime> object. This method is
494             suitable for the TIMESTAMPTZ (or TIMESTAMP WITH TIME ZONE) type.
495              
496             If the input string does not contain a time zone, it is set to the
497             floating time zone.
498              
499             Please note that PostgreSQL does not actually store a time zone along
500             with the TIMESTAMP WITH TIME ZONE (or TIMESTAMPTZ) type but will just
501             return a time stamp converted for the server's local time zone.
502              
503             If given an improperly formatted string, this method may die.
504              
505             =cut
506              
507             # sub parse_timestamptz {
508             # *** created automatically ***
509             # }
510              
511             *parse_timestamp_with_time_zone = \&parse_timestamptz;
512              
513             =item * parse_timestamp($string,...)
514              
515             =item * parse_timestamp_without_time_zone($string,...)
516              
517             Similar to the functions above, but always returns a C<DateTime> object
518             with a floating time zone. This method is suitable for the TIMESTAMP (or
519             TIMESTAMP WITHOUT TIME ZONE) type.
520              
521             If the server does return a time zone, it is ignored.
522              
523             If given an improperly formatted string, this method may die.
524              
525             =cut
526              
527             sub parse_timestamp {
528 2     2 1 639 parse_timestamptz(@_,'_force_tz' => DateTime::TimeZone::Floating->new());
529             }
530              
531             *parse_timestamp_without_time_zone = \&parse_timestamp;
532              
533             =item * parse_timetz($string,...)
534              
535             =item * parse_time_with_time_zone($string,...)
536              
537             Given a string containing a time representation, this method will return
538             a new C<DateTime> object. The date is set to 1970-01-01. This method is
539             suitable for the TIMETZ (or TIME WITH TIME ZONE) type.
540              
541             If the input string does not contain a time zone, it is set to the
542             floating time zone.
543              
544             Please note that PostgreSQL stores a numerical offset with its TIME WITH
545             TIME ZONE (or TIMETZ) type. It does not store a time zone name (such as
546             'Europe/Rome').
547              
548             If given an improperly formatted string, this method may die.
549              
550             =cut
551              
552             # sub parse_timetz {
553             # *** created automatically ***
554             # }
555              
556             *parse_time_with_time_zone = \&parse_timetz;
557              
558             =item * parse_time($string,...)
559              
560             =item * parse_time_without_time_zone($string,...)
561              
562             Similar to the functions above, but always returns an C<DateTime> object
563             with a floating time zone. If the server returns a time zone, it is
564             ignored. This method is suitable for use with the TIME (or TIME WITHOUT
565             TIME ZONE) type.
566              
567             This ensures that the resulting C<DateTime> object will always have the
568             time zone expected by your application.
569              
570             If given an improperly formatted string, this method may die.
571              
572             =cut
573              
574             sub parse_time {
575 2     2 1 227 parse_timetz(@_,'_force_tz' => 'floating');
576             }
577              
578             *parse_time_without_time_zone = \&parse_time;
579              
580             =item * parse_date($string,...)
581              
582             Given a string containing a date representation, this method will return
583             a new C<DateTime> object. The time is set to 00:00:00 (floating time
584             zone). This method is suitable for the DATE type.
585              
586             If given an improperly formatted string, this method may die.
587              
588             =cut
589              
590             # sub parse_date {
591             # *** generated automatically ***
592             # }
593              
594             =item * parse_duration($string)
595              
596             =item * parse_interval($string)
597              
598             Given a string containing a duration (SQL type INTERVAL) representation,
599             this method will return a new C<DateTime::Duration> object.
600              
601             If given an improperly formatted string, this method may die.
602              
603             =cut
604              
605             sub parse_duration {
606 89     89 1 166971 my ($self, $string_to_parse) = @_;
607              
608             # NB: We can't just pass our values to new() because it treats all
609             # arguments as negative if we have a single negative component.
610             # PostgreSQL might return mixed signs, e.g. '1 mon -1day'.
611 89         309 my $du = DateTime::Duration->new;
612              
613 89         10861 my %units = ( map(($_, ["seconds", 1]), qw(s second seconds sec secs)),
614             map(($_, ["minutes", 1]), qw(m minute minutes min mins)),
615             map(($_, ["hours", 1]), qw(h hr hour hours)),
616             map(($_, ["days", 1]), qw(d day days)),
617             map(($_, ["weeks", 1]), qw(w week weeks)),
618             map(($_, ["months", 1]), qw(M mon mons month months)),
619             map(($_, ["years", 1]), qw(y yr yrs year years)),
620             map(($_, ["years", 10]), qw(decade decades dec decs)),
621             map(($_, ["years", 100]), qw(c cent century centuries)),
622             map(($_, ["years", 1000]), qw(millennium millennia millenniums mil mils)) );
623              
624 89         367 (my $string = $string_to_parse) =~ s/^@\s*//;
625 89         185 $string =~ s/\+(\d+)/$1/g;
626              
627             # Method used later on duration object
628 89         124 my $arith_method = "add";
629 89 100       234 if ( $string =~ s/ago// ) {
630 8         12 $arith_method = "subtract";
631             }
632              
633 89         118 my $sign = 0;
634 89         118 my %done;
635              
636 89         403 $string =~ s/\b(\d+):(\d\d):(\d\d)(\.\d+)?\b/$1h $2m $3$4s/g;
637 89         172 $string =~ s/\b(\d+):(\d\d)\b/$1h $2m/g;
638 89         183 $string =~ s/(-\d+h)\s+(\d+m)\s+(\d+(?:\.\d+)?s)\s*/$1 -$2 -$3 /;
639 89         162 $string =~ s/(-\d+h)\s+(\d+m)\s*/$1 -$2 /;
640              
641 89         531 while ($string =~ s/^\s*(-?\d+(?:[.,]\d+)?)\s*([a-zA-Z]+)(?:\s*(?:,|and)\s*)*//i) {
642 174         9463 my($amount, $unit) = ($1, $2);
643 174 100       344 if (length($unit) != 1) {
644 98         159 $unit = lc($unit);
645             }
646              
647 174         279 my $udata = $units{$unit};
648 174 100       298 if (! $udata) {
649 1         93 Carp::croak("Unknown timespec: $string_to_parse");
650             }
651 173         276 my ($base_unit, $num) = @$udata;
652 173         293 my $key = $base_unit . "-" . $num;
653 173 100       299 if (exists $done{$key}) {
654 1         200 Carp::croak("Unknown timespec: $string_to_parse");
655             }
656 172         298 $done{$key} = 1;
657              
658 172         194 my @extra_args;
659              
660 172         241 $amount =~ s/,/./;
661 172 100       276 if ($amount =~ s/\.(\d+)$//) {
662 2         6 my $fractional = $1;
663             # We only handle fractional seconds right now. If you
664             # need support for silly formats (from my perspective ;-P)
665             # like '1.5 weeks', please provide me with a comprehensive
666             # test for all possible combinations of fractional times.
667 2 50       10 if ($base_unit ne "seconds") {
668 0         0 Carp::croak("Fractional input detected: currently only fractional seconds are supported")
669             }
670              
671             # From the spec, Pg can take up to 6 digits for fractional part
672             # that is microseconds. If we're missing 0's,
673             # we should pad them
674 2         9 $fractional .= '0'x (9 - length($fractional));
675 2 100       9 my $sign = ($amount > 0) ? 1 : -1;
676 2         7 push @extra_args, ("nanoseconds" => $sign * $fractional);
677             }
678              
679 172         575 $du->$arith_method($base_unit => $amount * $num, @extra_args);
680             }
681              
682 87 100       8987 if ($string =~ /\S/) { # OK to have extra spaces, but nothing else
683 2         215 Carp::croak "Unknown timespec: $string_to_parse";
684             }
685              
686 85         898 return $du;
687             }
688              
689             *parse_interval = \&parse_duration;
690              
691             =back
692              
693             =head2 FORMATTING METHODS
694              
695             This class provides the following formatting methods.
696              
697             The output is always in the format mandated by the SQL standard (derived
698             from ISO 8601), which is parsed by PostgreSQL unambiguously in all
699             DateStyle modes.
700              
701             =over 4
702              
703             =item * format_datetime($datetime,...)
704              
705             Given a C<DateTime> object, this method returns a string appropriate as
706             input for all date and date/time types of PostgreSQL. It will contain
707             date and time.
708              
709             If the time zone of the C<DateTime> part is floating, the resulting
710             string will contain no time zone, which will result in the server's time
711             zone being used. Otherwise, the numerical offset of the time zone is
712             used.
713              
714             =cut
715              
716             *format_datetime = \&format_timestamptz;
717              
718             =item * format_time($datetime,...)
719              
720             =item * format_time_without_time_zone($datetime,...)
721              
722             Given a C<DateTime> object, this method returns a string appropriate as
723             input for the TIME type (also known as TIME WITHOUT TIME ZONE), which
724             will contain the local time of the C<DateTime> object and no time zone.
725              
726             =cut
727              
728             sub _format_fractional
729             {
730 11     11   299 my $ns = shift->nanosecond;
731 11 100       82 return $ns ? sprintf(".%09d", "$ns") : ''
732             }
733              
734             sub format_time
735             {
736 0     0 1 0 my ($self,$dt,%param) = @_;
737 0         0 return $dt->hms(':')._format_fractional($dt);
738             }
739              
740             *format_time_without_time_zone = \&format_time;
741              
742             =item * format_timetz($datetime)
743              
744             =item * format_time_with_time_zone($datetime)
745              
746             Given a C<DateTime> object, this method returns a string appropriate as
747             input for the TIME WITH TIME ZONE type (also known as TIMETZ), which
748             will contain the local part of the C<DateTime> object and a numerical
749             time zone.
750              
751             You should not use the TIME WITH TIME ZONE type to store dates with
752             floating time zones. If the time zone of the C<DateTime> part is
753             floating, the resulting string will contain no time zone, which will
754             result in the server's time zone being used.
755              
756             =cut
757              
758             sub _format_time_zone
759             {
760 11     11   17 my $dt = shift;
761 11 100       30 return '' if $dt->time_zone->is_floating;
762 10         81 return &DateTime::TimeZone::offset_as_string($dt->offset);
763             }
764              
765             sub format_timetz
766             {
767 0     0 1 0 my ($self,$dt) = @_;
768 0         0 return $dt->hms(':')._format_fractional($dt)._format_time_zone($dt);
769             }
770              
771             *format_time_with_time_zone = \&format_timetz;
772              
773             =item * format_date($datetime)
774              
775             Given a C<DateTime> object, this method returns a string appropriate as
776             input for the DATE type, which will contain the date part of the
777             C<DateTime> object.
778              
779             =cut
780              
781             sub format_date
782             {
783 5     5 1 2984 my ($self,$dt) = @_;
784 5 100       22 if($dt->is_infinite) {
    100          
785 2 100       23 return $dt->isa('DateTime::Infinite::Future') ? 'infinity' : '-infinity';
786             } elsif($dt->year()<=0) {
787 1         10 return sprintf('%04d-%02d-%02d BC',
788             1-$dt->year(),
789             $dt->month(),
790             $dt->day());
791             } else {
792 2         23 return $dt->ymd('-');
793             }
794             }
795              
796             =item * format_timestamp($datetime)
797              
798             =item * format_timestamp_without_time_zone($datetime)
799              
800             Given a C<DateTime> object, this method returns a string appropriate as
801             input for the TIMESTAMP type (also known as TIMESTAMP WITHOUT TIME
802             ZONE), which will contain the local time of the C<DateTime> object and
803             no time zone.
804              
805             =cut
806              
807             sub format_timestamp
808             {
809 2     2 1 14 my ($self,$dt,%param) = @_;
810 2 50       7 if($dt->is_infinite) {
    0          
811 2 100       18 return $dt->isa('DateTime::Infinite::Future') ? 'infinity' : '-infinity';
812             } elsif($dt->year()<=0) {
813 0         0 return sprintf('%04d-%02d-%02d %s BC',
814             1-$dt->year(),
815             $dt->month(),
816             $dt->day(),
817             $dt->hms(':')._format_fractional($dt));
818             } else {
819 0         0 return $dt->ymd('-').' '.$dt->hms(':')._format_fractional($dt);
820             }
821             }
822              
823             *format_timestamp_without_time_zone = \&format_timestamp;
824              
825             =item * format_timestamptz($datetime)
826              
827             =item * format_timestamp_with_time_zone($datetime)
828              
829             Given a C<DateTime> object, this method returns a string appropriate as
830             input for the TIMESTAMP WITH TIME ZONE type, which will contain the
831             local part of the C<DateTime> object and a numerical time zone.
832              
833             You should not use the TIMESTAMP WITH TIME ZONE type to store dates with
834             floating time zones. If the time zone of the C<DateTime> part is
835             floating, the resulting string will contain no time zone, which will
836             result in the server's time zone being used.
837              
838             =cut
839              
840             sub format_timestamptz
841             {
842 13     13 1 36443 my ($self,$dt,%param) = @_;
843 13 100       55 if($dt->is_infinite) {
    100          
844 2 100       28 return $dt->isa('DateTime::Infinite::Future') ? 'infinity' : '-infinity';
845             } elsif($dt->year()<=0) {
846 2         20 return sprintf('%04d-%02d-%02d',
847             1-$dt->year(),
848             $dt->month(),
849             $dt->day()).
850             ' '.
851             $dt->hms(':').
852             _format_fractional($dt).
853             _format_time_zone($dt).
854             ' BC';
855             } else {
856 9         107 return $dt->ymd('-').' '.$dt->hms(':').
857             _format_fractional($dt).
858             _format_time_zone($dt);
859             }
860             }
861              
862             *format_timestamp_with_time_zone = \&format_timestamptz;
863              
864             =item * format_duration($du)
865              
866             =item * format_interval($du)
867              
868             Given a C<DateTime::Duration> object, this method returns a string appropriate
869             as input for the INTERVAL type.
870              
871             =cut
872              
873             sub format_duration {
874 5 50 33 5 1 2759 shift if UNIVERSAL::isa($_[0], __PACKAGE__) || $_[0] eq __PACKAGE__;
875 5         13 my($du,%param) = @_;
876 5 50       16 croak 'DateTime::Duration object expected' unless UNIVERSAL::isa($du,'DateTime::Duration');
877              
878 5         17 my %deltas = $du->deltas();
879 5         69 my $output = '@';
880              
881 5 100       12 if($deltas{'nanoseconds'}) {
882             $deltas{'seconds'} =
883 2         26 sprintf('%f', $deltas{'seconds'} + $deltas{'nanoseconds'} /
884             DateTime::Duration::MAX_NANOSECONDS);
885             }
886              
887 5         12 foreach(qw(months days minutes seconds)) {
888 20 100       52 $output .= ' '.$deltas{$_}.' '.$_ if $deltas{$_};
889             }
890              
891 5 50       13 $output .= ' 0' if(length($output)<=2);
892 5         20 return $output;
893             }
894              
895             *format_interval = \&format_duration;
896              
897             =back
898              
899             =cut
900              
901              
902              
903             1;
904              
905             __END__
906              
907             =head1 LIMITATIONS
908              
909             Some output formats of PostgreSQL have limitations that can only be passed on
910             by this class.
911              
912             As a general rules, none of these limitations apply to the 'ISO' output
913             format. It is strongly recommended to use this format (and to use
914             PostgreSQL's to_char function when another output format that's not
915             supposed to be handled by a parser of this class is desired). 'ISO' is
916             the default but you are advised to explicitly set it at the beginning of
917             the session by issuing a SET DATESTYLE TO 'ISO'; command in case the
918             server administrator changes that setting.
919              
920             When formatting DateTime objects, this class always uses a format that's
921             handled unambiguously by PostgreSQL.
922              
923             =head2 TIME ZONES
924              
925             If DateStyle is set to 'PostgreSQL', 'SQL', or 'German', PostgreSQL does
926             not send numerical time zones for the TIMESTAMPTZ (or TIMESTAMP WITH
927             TIME ZONE) type. Unfortunately, the time zone names used instead can be
928             ambiguous: For example, 'EST' can mean -0500, +1000, or +1100.
929              
930             You must set the 'server_tz' variable to a time zone that is identical to that
931             of the PostgreSQL server. If the server is set to a different time zone (or the
932             underlying operating system interprets the time zone differently), the parser
933             will return wrong times.
934              
935             You can avoid such problems by setting the server's time zone to UTC
936             using the SET TIME ZONE 'UTC' command and setting 'server_tz' parameter
937             to 'UTC' (or by using the ISO output format, of course).
938              
939             =head2 EUROPEAN DATES
940              
941             For the SQL (for DATE and TIMSTAMP[TZ]) and the PostgreSQL (for DATE)
942             output format, the server can send dates in both European-style
943             'dd/mm/yyyy' and in US-style 'mm/dd/yyyy' format. In order to parse
944             these dates correctly, you have to pass the 'european' option to the
945             constructor or to the C<parse_xxx> routines.
946              
947             This problem does not occur when using the ISO or German output format
948             (and for PostgreSQL with TIMESTAMP[TZ] as month names are used then).
949              
950             =head2 INTERVAL ELEMENTS
951              
952             C<DateTime::Duration> stores months, days, minutes and seconds
953             separately. PostgreSQL only stores months and seconds and disregards the
954             irregular length of days due to DST switching and the irregular length
955             of minutes due to leap seconds. Therefore, it is not possible to store
956             C<DateTime::Duration> objects as SQL INTERVALs without the loss of some
957             information.
958              
959             =head2 NEGATIVE INTERVALS
960              
961             In the SQL and German output formats, the server does not send an
962             indication of the sign with intervals. This means that '1 month ago' and
963             '1 month' are both returned as '1 mon'.
964              
965             This problem can only be avoided by using the 'ISO' or 'PostgreSQL'
966             output format.
967              
968             =head1 SUPPORT
969              
970             Support for this module is provided via the datetime@perl.org email
971             list. See http://lists.perl.org/ for more details.
972              
973             =head1 AUTHOR
974              
975             Daisuke Maki E<lt>daisuke@endeworks.jpE<gt>
976              
977             =head1 AUTHOR EMERITUS
978              
979             Claus A. Faerber <perl@faerber.muc.de>
980              
981             =head1 COPYRIGHT
982              
983             Copyright (c) 2003 Claus A. Faerber. Copyright (c) 2005-2007 Daisuke Maki
984              
985             This program is free software; you can redistribute it and/or modify it under
986             the same terms as Perl itself.
987              
988             The full text of the license can be found in the LICENSE file included with
989             this module.
990              
991             =head1 SEE ALSO
992              
993             datetime@perl.org mailing list
994              
995             http://datetime.perl.org/
996              
997             =cut