1package DateTime::Format::Strptime;
2
3use strict;
4use warnings;
5
6our $VERSION = '1.79';
7
8use Carp qw( carp croak );
9use DateTime 1.00;
10use DateTime::Locale 1.30;
11use DateTime::Format::Strptime::Types;
12use DateTime::TimeZone 2.09;
13use Exporter ();
14use Params::ValidationCompiler qw( validation_for );
15use Try::Tiny;
16
17our @EXPORT_OK = qw( strftime strptime );
18
19## no critic (ValuesAndExpressions::ProhibitConstantPragma)
20use constant PERL_58 => $] < 5.010;
21
22# We previously used Package::DeprecationManager which allowed passing of
23# "-api_version => X" on import. We don't want any such imports to blow up but
24# we no longer have anything to deprecate.
25sub import {
26    my $class = shift;
27    my @args;
28    ## no critic (ControlStructures::ProhibitCStyleForLoops)
29    for ( my $i = 0; $i < @_; $i++ ) {
30        if ( $_[$i] eq '-api_version' ) {
31            $i++;
32        }
33        else {
34            push @args, $_[$i];
35        }
36    }
37    @_ = ( $class, @args );
38    goto &Exporter::import;
39}
40
41{
42    my $en_locale = DateTime::Locale->load('en');
43
44    my $validator = validation_for(
45        params => {
46            pattern   => { type => t('NonEmptyStr') },
47            time_zone => {
48                type     => t('TimeZone'),
49                optional => 1,
50            },
51            zone_map => {
52                type    => t('HashRef'),
53                default => sub { {} },
54            },
55            locale => {
56                type    => t('Locale'),
57                default => sub {$en_locale},
58            },
59            on_error => {
60                type    => t('OnError'),
61                default => 'undef',
62            },
63            strict => {
64                type    => t('Bool'),
65                default => 0,
66            },
67            debug => {
68                type    => t('Bool'),
69                default => $ENV{DATETIME_FORMAT_STRPTIME_DEBUG},
70            },
71        },
72    );
73
74    sub new {
75        my $class = shift;
76        my %args  = $validator->(@_);
77
78        my $self = bless {
79            %args,
80            zone_map => $class->_build_zone_map( $args{zone_map} ),
81        }, $class;
82
83        # Forces a check that the pattern is valid
84        $self->_parser;
85
86        if ( $self->{debug} ) {
87            binmode STDERR, ':encoding(UTF-8)' or die $!;
88        }
89
90        return $self;
91    }
92}
93
94{
95    my %zone_map = (
96        'A'      => '+0100', 'ACDT'   => '+1030', 'ACST'   => '+0930',
97        'ADT'    => undef,   'AEDT'   => '+1100', 'AES'    => '+1000',
98        'AEST'   => '+1000', 'AFT'    => '+0430', 'AHDT'   => '-0900',
99        'AHST'   => '-1000', 'AKDT'   => '-0800', 'AKST'   => '-0900',
100        'AMST'   => '+0400', 'AMT'    => '+0400', 'ANAST'  => '+1300',
101        'ANAT'   => '+1200', 'ART'    => '-0300', 'AST'    => undef,
102        'AT'     => '-0100', 'AWST'   => '+0800', 'AZOST'  => '+0000',
103        'AZOT'   => '-0100', 'AZST'   => '+0500', 'AZT'    => '+0400',
104        'B'      => '+0200', 'BADT'   => '+0400', 'BAT'    => '+0600',
105        'BDST'   => '+0200', 'BDT'    => '+0600', 'BET'    => '-1100',
106        'BNT'    => '+0800', 'BORT'   => '+0800', 'BOT'    => '-0400',
107        'BRA'    => '-0300', 'BST'    => undef,   'BT'     => undef,
108        'BTT'    => '+0600', 'C'      => '+0300', 'CAST'   => '+0930',
109        'CAT'    => undef,   'CCT'    => undef,   'CDT'    => undef,
110        'CEST'   => '+0200', 'CET'    => '+0100', 'CETDST' => '+0200',
111        'CHADT'  => '+1345', 'CHAST'  => '+1245', 'CKT'    => '-1000',
112        'CLST'   => '-0300', 'CLT'    => '-0400', 'COT'    => '-0500',
113        'CST'    => undef,   'CSuT'   => '+1030', 'CUT'    => '+0000',
114        'CVT'    => '-0100', 'CXT'    => '+0700', 'ChST'   => '+1000',
115        'D'      => '+0400', 'DAVT'   => '+0700', 'DDUT'   => '+1000',
116        'DNT'    => '+0100', 'DST'    => '+0200', 'E'      => '+0500',
117        'EASST'  => '-0500', 'EAST'   => undef,   'EAT'    => '+0300',
118        'ECT'    => undef,   'EDT'    => undef,   'EEST'   => '+0300',
119        'EET'    => '+0200', 'EETDST' => '+0300', 'EGST'   => '+0000',
120        'EGT'    => '-0100', 'EMT'    => '+0100', 'EST'    => undef,
121        'ESuT'   => '+1100', 'F'      => '+0600', 'FDT'    => undef,
122        'FJST'   => '+1300', 'FJT'    => '+1200', 'FKST'   => '-0300',
123        'FKT'    => '-0400', 'FST'    => undef,   'FWT'    => '+0100',
124        'G'      => '+0700', 'GALT'   => '-0600', 'GAMT'   => '-0900',
125        'GEST'   => '+0500', 'GET'    => '+0400', 'GFT'    => '-0300',
126        'GILT'   => '+1200', 'GMT'    => '+0000', 'GST'    => undef,
127        'GT'     => '+0000', 'GYT'    => '-0400', 'GZ'     => '+0000',
128        'H'      => '+0800', 'HAA'    => '-0300', 'HAC'    => '-0500',
129        'HAE'    => '-0400', 'HAP'    => '-0700', 'HAR'    => '-0600',
130        'HAT'    => '-0230', 'HAY'    => '-0800', 'HDT'    => '-0930',
131        'HFE'    => '+0200', 'HFH'    => '+0100', 'HG'     => '+0000',
132        'HKT'    => '+0800', 'HL'     => 'local', 'HNA'    => '-0400',
133        'HNC'    => '-0600', 'HNE'    => '-0500', 'HNP'    => '-0800',
134        'HNR'    => '-0700', 'HNT'    => '-0330', 'HNY'    => '-0900',
135        'HOE'    => '+0100', 'HST'    => '-1000', 'I'      => '+0900',
136        'ICT'    => '+0700', 'IDLE'   => '+1200', 'IDLW'   => '-1200',
137        'IDT'    => undef,   'IOT'    => '+0500', 'IRDT'   => '+0430',
138        'IRKST'  => '+0900', 'IRKT'   => '+0800', 'IRST'   => '+0430',
139        'IRT'    => '+0330', 'IST'    => undef,   'IT'     => '+0330',
140        'ITA'    => '+0100', 'JAVT'   => '+0700', 'JAYT'   => '+0900',
141        'JST'    => '+0900', 'JT'     => '+0700', 'K'      => '+1000',
142        'KDT'    => '+1000', 'KGST'   => '+0600', 'KGT'    => '+0500',
143        'KOST'   => '+1200', 'KRAST'  => '+0800', 'KRAT'   => '+0700',
144        'KST'    => '+0900', 'L'      => '+1100', 'LHDT'   => '+1100',
145        'LHST'   => '+1030', 'LIGT'   => '+1000', 'LINT'   => '+1400',
146        'LKT'    => '+0600', 'LST'    => 'local', 'LT'     => 'local',
147        'M'      => '+1200', 'MAGST'  => '+1200', 'MAGT'   => '+1100',
148        'MAL'    => '+0800', 'MART'   => '-0930', 'MAT'    => '+0300',
149        'MAWT'   => '+0600', 'MDT'    => '-0600', 'MED'    => '+0200',
150        'MEDST'  => '+0200', 'MEST'   => '+0200', 'MESZ'   => '+0200',
151        'MET'    => undef,   'MEWT'   => '+0100', 'MEX'    => '-0600',
152        'MEZ'    => '+0100', 'MHT'    => '+1200', 'MMT'    => '+0630',
153        'MPT'    => '+1000', 'MSD'    => '+0400', 'MSK'    => '+0300',
154        'MSKS'   => '+0400', 'MST'    => '-0700', 'MT'     => '+0830',
155        'MUT'    => '+0400', 'MVT'    => '+0500', 'MYT'    => '+0800',
156        'N'      => '-0100', 'NCT'    => '+1100', 'NDT'    => '-0230',
157        'NFT'    => undef,   'NOR'    => '+0100', 'NOVST'  => '+0700',
158        'NOVT'   => '+0600', 'NPT'    => '+0545', 'NRT'    => '+1200',
159        'NST'    => undef,   'NSUT'   => '+0630', 'NT'     => '-1100',
160        'NUT'    => '-1100', 'NZDT'   => '+1300', 'NZST'   => '+1200',
161        'NZT'    => '+1200', 'O'      => '-0200', 'OESZ'   => '+0300',
162        'OEZ'    => '+0200', 'OMSST'  => '+0700', 'OMST'   => '+0600',
163        'OZ'     => 'local', 'P'      => '-0300', 'PDT'    => '-0700',
164        'PET'    => '-0500', 'PETST'  => '+1300', 'PETT'   => '+1200',
165        'PGT'    => '+1000', 'PHOT'   => '+1300', 'PHT'    => '+0800',
166        'PKT'    => '+0500', 'PMDT'   => '-0200', 'PMT'    => '-0300',
167        'PNT'    => '-0830', 'PONT'   => '+1100', 'PST'    => undef,
168        'PWT'    => '+0900', 'PYST'   => '-0300', 'PYT'    => '-0400',
169        'Q'      => '-0400', 'R'      => '-0500', 'R1T'    => '+0200',
170        'R2T'    => '+0300', 'RET'    => '+0400', 'ROK'    => '+0900',
171        'S'      => '-0600', 'SADT'   => '+1030', 'SAST'   => undef,
172        'SBT'    => '+1100', 'SCT'    => '+0400', 'SET'    => '+0100',
173        'SGT'    => '+0800', 'SRT'    => '-0300', 'SST'    => undef,
174        'SWT'    => '+0100', 'T'      => '-0700', 'TFT'    => '+0500',
175        'THA'    => '+0700', 'THAT'   => '-1000', 'TJT'    => '+0500',
176        'TKT'    => '-1000', 'TMT'    => '+0500', 'TOT'    => '+1300',
177        'TRUT'   => '+1000', 'TST'    => '+0300', 'TUC '   => '+0000',
178        'TVT'    => '+1200', 'U'      => '-0800', 'ULAST'  => '+0900',
179        'ULAT'   => '+0800', 'USZ1'   => '+0200', 'USZ1S'  => '+0300',
180        'USZ3'   => '+0400', 'USZ3S'  => '+0500', 'USZ4'   => '+0500',
181        'USZ4S'  => '+0600', 'USZ5'   => '+0600', 'USZ5S'  => '+0700',
182        'USZ6'   => '+0700', 'USZ6S'  => '+0800', 'USZ7'   => '+0800',
183        'USZ7S'  => '+0900', 'USZ8'   => '+0900', 'USZ8S'  => '+1000',
184        'USZ9'   => '+1000', 'USZ9S'  => '+1100', 'UTZ'    => '-0300',
185        'UYT'    => '-0300', 'UZ10'   => '+1100', 'UZ10S'  => '+1200',
186        'UZ11'   => '+1200', 'UZ11S'  => '+1300', 'UZ12'   => '+1200',
187        'UZ12S'  => '+1300', 'UZT'    => '+0500', 'V'      => '-0900',
188        'VET'    => '-0400', 'VLAST'  => '+1100', 'VLAT'   => '+1000',
189        'VTZ'    => '-0200', 'VUT'    => '+1100', 'W'      => '-1000',
190        'WAKT'   => '+1200', 'WAST'   => undef,   'WAT'    => '+0100',
191        'WEST'   => '+0100', 'WESZ'   => '+0100', 'WET'    => '+0000',
192        'WETDST' => '+0100', 'WEZ'    => '+0000', 'WFT'    => '+1200',
193        'WGST'   => '-0200', 'WGT'    => '-0300', 'WIB'    => '+0700',
194        'WIT'    => '+0900', 'WITA'   => '+0800', 'WST'    => undef,
195        'WTZ'    => '-0100', 'WUT'    => '+0100', 'X'      => '-1100',
196        'Y'      => '-1200', 'YAKST'  => '+1000', 'YAKT'   => '+0900',
197        'YAPT'   => '+1000', 'YDT'    => '-0800', 'YEKST'  => '+0600',
198        'YEKT'   => '+0500', 'YST'    => '-0900', 'Z'      => '+0000',
199        'UTC'    => '+0000',
200    );
201
202    for my $i ( map { sprintf( '%02d', $_ ) } 1 .. 12 ) {
203        $zone_map{ '-' . $i } = '-' . $i . '00';
204        $zone_map{ '+' . $i } = '+' . $i . '00';
205    }
206
207    sub _build_zone_map {
208        return {
209            %zone_map,
210            %{ $_[1] },
211        };
212    }
213}
214
215sub parse_datetime {
216    my $self   = shift;
217    my $string = shift;
218
219    my $parser = $self->_parser;
220    if ( $self->{debug} ) {
221        warn "Regex for $self->{pattern}: $parser->{regex}\n";
222        warn "Fields: @{$parser->{fields}}\n";
223    }
224
225    my @matches = ( $string =~ $parser->{regex} );
226    unless (@matches) {
227        my $msg = 'Your datetime does not match your pattern';
228        if ( $self->{debug} ) {
229            $msg .= qq{ - string = "$string" - regex = $parser->{regex}};
230        }
231        $msg .= q{.};
232        $self->_our_croak($msg);
233        return;
234    }
235
236    my %args;
237    my $i = 0;
238    for my $f ( @{ $parser->{fields} } ) {
239        unless ( defined $matches[$i] ) {
240            die
241                "Something horrible happened - the string matched $parser->{regex}"
242                . " but did not return the expected fields: [@{$parser->{fields}}]";
243        }
244        $args{$f} = $matches[ $i++ ];
245    }
246
247    # We need to copy the %args here because _munge_args will delete keys in
248    # order to turn this into something that can be passed to a DateTime
249    # constructor.
250    my ( $constructor, $args, $post_construct )
251        = $self->_munge_args( {%args} );
252    return unless $constructor && $args;
253
254    my $dt = try { DateTime->$constructor($args) };
255    $self->_our_croak('Parsed values did not produce a valid date')
256        unless $dt;
257    if ($post_construct) {
258        $post_construct->($dt);
259    }
260    return unless $dt && $self->_check_dt( $dt, \%args );
261
262    $dt->set_time_zone( $self->{time_zone} )
263        if $self->{time_zone};
264
265    return $dt;
266}
267
268sub _parser {
269    my $self = shift;
270
271    return $self->{parser} ||= $self->_build_parser;
272}
273
274sub _build_parser {
275    my $self = shift;
276
277    my (
278        $replacement_tokens_re,
279        $replacements,
280        $pattern_tokens_re,
281        $patterns,
282    ) = $self->_parser_pieces;
283
284    my $pattern = $self->{pattern};
285
286    # When the first replacement is a glibc pattern, the first round of
287    # replacements may simply replace one replacement token (like %X) with
288    # another replacement token (like %I).
289    $pattern =~ s/%($replacement_tokens_re)/$replacements->{$1}/g for 1 .. 2;
290
291    if ( $self->{debug} && $pattern ne $self->{pattern} ) {
292        warn "Pattern after replacement substitution: $pattern\n";
293    }
294
295    my $regex = q{};
296    my @fields;
297
298    while (
299        $pattern =~ /
300            \G
301            %($pattern_tokens_re)
302            |
303            %([1-9]?)(N)
304            |
305            (%[0-9]*[a-zA-Z])
306            |
307            ([^%]+)
308                    /xg
309    ) {
310        # Using \G in the regex match fails for some reason on Perl 5.8, so we
311        # do this hack instead.
312        substr( $pattern, 0, pos $pattern, q{} )
313            if PERL_58;
314        if ($1) {
315            my $p = $patterns->{$1}
316                or croak
317                "Unidentified token in pattern: $1 in $self->{pattern}";
318            if ( $p->{field} ) {
319                $regex .= qr/($p->{regex})/;
320                push @fields, $p->{field};
321            }
322            else {
323                $regex .= qr/$p->{regex}/;
324            }
325        }
326        elsif ($3) {
327            $regex .= $2 ? qr/([0-9]{$2})/ : qr/([0-9]+)/;
328            push @fields, 'nanosecond';
329        }
330        elsif ($4) {
331            croak qq{Pattern contained an unrecognized strptime token, "$4"};
332        }
333        else {
334            $regex .= qr/\Q$5/;
335        }
336    }
337
338    return {
339        regex =>
340            ( $self->{strict} ? qr/(?:\A|\b)$regex(?:\b|\Z)/ : qr/$regex/ ),
341        fields => \@fields,
342    };
343}
344
345{
346    my $digit             = qr/(?:[0-9])/;
347    my $one_or_two_digits = qr/[0-9 ]?$digit/;
348
349    # These patterns are all locale-independent. There are a few that depend
350    # on the locale, and must be re-calculated for each new parser object.
351    my %universal_patterns = (
352        '%' => {
353            regex => qr/%/,
354        },
355        C => {
356            regex => $one_or_two_digits,
357            field => 'century',
358        },
359        d => {
360            regex => $one_or_two_digits,
361            field => 'day',
362        },
363        g => {
364            regex => $one_or_two_digits,
365            field => 'iso_week_year_100',
366        },
367        G => {
368            regex => qr/$digit{4}/,
369            field => 'iso_week_year',
370        },
371        H => {
372            regex => $one_or_two_digits,
373            field => 'hour',
374        },
375        I => {
376            regex => $one_or_two_digits,
377            field => 'hour_12',
378        },
379        j => {
380            regex => qr/$digit{1,3}/,
381            field => 'day_of_year',
382        },
383        m => {
384            regex => $one_or_two_digits,
385            field => 'month',
386        },
387        M => {
388            regex => $one_or_two_digits,
389            field => 'minute',
390        },
391        n => {
392            regex => qr/\s+/,
393        },
394        O => {
395            regex => qr{[a-zA-Z_]+(?:/[a-zA-Z_]+(?:/[a-zA-Z_]+)?)?},
396            field => 'time_zone_name',
397        },
398        s => {
399            regex => qr/$digit+/,
400            field => 'epoch',
401        },
402        S => {
403            regex => $one_or_two_digits,
404            field => 'second',
405        },
406        U => {
407            regex => $one_or_two_digits,
408            field => 'week_sun_0',
409        },
410        u => {
411            regex => $one_or_two_digits,
412            field => 'day_of_week',
413        },
414        w => {
415            regex => $one_or_two_digits,
416            field => 'day_of_week_sun_0',
417        },
418        W => {
419            regex => $one_or_two_digits,
420            field => 'week_mon_1',
421        },
422        y => {
423            regex => $one_or_two_digits,
424            field => 'year_100',
425        },
426        Y => {
427            regex => qr/$digit{4}/,
428            field => 'year',
429        },
430        z => {
431            regex => qr/(?:Z|[+-]$digit{2}(?:[:]?$digit{2})?)/,
432            field => 'time_zone_offset',
433        },
434        Z => {
435            regex => qr/[a-zA-Z]{1,6}|[\-\+]$digit{2}/,
436            field => 'time_zone_abbreviation',
437        },
438    );
439
440    $universal_patterns{e} = $universal_patterns{d};
441    $universal_patterns{k} = $universal_patterns{H};
442    $universal_patterns{l} = $universal_patterns{I};
443    $universal_patterns{t} = $universal_patterns{n};
444
445    my %universal_replacements = (
446        D => '%m/%d/%y',
447        F => '%Y-%m-%d',
448        r => '%I:%M:%S %p',
449        R => '%H:%M',
450        T => '%H:%M:%S',
451    );
452
453    sub _parser_pieces {
454        my $self = shift;
455
456        my %replacements = %universal_replacements;
457        $replacements{c} = $self->{locale}->glibc_datetime_format;
458        $replacements{x} = $self->{locale}->glibc_date_format;
459        $replacements{X} = $self->{locale}->glibc_time_format;
460
461        my %patterns = %universal_patterns;
462        $patterns{a} = $patterns{A} = {
463            regex => do {
464                my $days = join '|', map {quotemeta}
465                    sort { ( length $b <=> length $a ) or ( $a cmp $b ) }
466                    keys %{ $self->_locale_days };
467                qr/$days/i;
468            },
469            field => 'day_name',
470        };
471
472        $patterns{b} = $patterns{B} = $patterns{h} = {
473            regex => do {
474                my $months = join '|', map {quotemeta}
475                    sort { ( length $b <=> length $a ) or ( $a cmp $b ) }
476                    keys %{ $self->_locale_months };
477                qr/$months/i;
478            },
479            field => 'month_name',
480        };
481
482        $patterns{p} = $patterns{P} = {
483            regex => do {
484                my $am_pm = join '|',
485                    map  {quotemeta}
486                    sort { ( length $b <=> length $a ) or ( $a cmp $b ) }
487                    @{ $self->{locale}->am_pm_abbreviated };
488                qr/$am_pm/i;
489            },
490            field => 'am_pm',
491        };
492
493        return (
494            $self->_token_re_for( keys %replacements ),
495            \%replacements,
496            $self->_token_re_for( keys %patterns ),
497            \%patterns,
498        );
499    }
500}
501
502sub _locale_days {
503    my $self = shift;
504
505    return $self->{locale_days} if $self->{locale_days};
506
507    my $wide = $self->{locale}->day_format_wide;
508    my $abbr = $self->{locale}->day_format_abbreviated;
509
510    my %locale_days;
511    for my $i ( 0 .. 6 ) {
512        $locale_days{ lc $wide->[$i] } = $i;
513        $locale_days{ lc $abbr->[$i] } = $i;
514    }
515
516    return $self->{locale_days} ||= \%locale_days;
517}
518
519sub _locale_months {
520    my $self = shift;
521
522    return $self->{locale_months} if $self->{locale_months};
523
524    my $wide = $self->{locale}->month_format_wide;
525    my $abbr = $self->{locale}->month_format_abbreviated;
526
527    my %locale_months;
528    for my $i ( 0 .. 11 ) {
529        $locale_months{ lc $wide->[$i] } = $i + 1;
530        $locale_months{ lc $abbr->[$i] } = $i + 1;
531    }
532
533    return $self->{locale_months} ||= \%locale_months;
534}
535
536sub _token_re_for {
537    shift;
538    my $t = join '|',
539        sort { ( length $b <=> length $a ) or ( $a cmp $b ) } @_;
540
541    return qr/$t/;
542}
543
544{
545    # These are fields we parse that cannot be passed to a DateTime
546    # constructor
547    my @non_dt_keys = qw(
548        am_pm
549        century
550        day_name
551        day_of_week
552        day_of_week_sun_0
553        hour_12
554        iso_week_year
555        iso_week_year_100
556        month_name
557        time_zone_abbreviation
558        time_zone_name
559        time_zone_offset
560        week_mon_1
561        week_sun_0
562        year_100
563    );
564
565    ## no critic (Subroutines::ProhibitExcessComplexity)
566    sub _munge_args {
567        my $self = shift;
568        my $args = shift;
569
570        if ( defined $args->{month_name} ) {
571            my $num = $self->_locale_months->{ lc $args->{month_name} }
572                or die "We somehow parsed a month name ($args->{month_name})"
573                . ' that does not correspond to any month in this locale!';
574
575            $args->{month} = $num;
576        }
577
578        if ( defined $args->{am_pm} && defined $args->{hour_12} ) {
579            my ( $am, $pm ) = @{ $self->{locale}->am_pm_abbreviated };
580            $args->{hour} = $args->{hour_12};
581
582            if ( lc $args->{am_pm} eq lc $am ) {
583                $args->{hour} = 0 if $args->{hour} == 12;
584            }
585            else {
586                $args->{hour} += 12 unless $args->{hour} == 12;
587            }
588        }
589        elsif ( defined $args->{hour_12} ) {
590            $self->_our_croak(
591                      qq{Parsed a 12-hour based hour, "$args->{hour_12}",}
592                    . ' but the pattern does not include an AM/PM specifier'
593            );
594            return;
595        }
596
597        if ( defined $args->{year_100} ) {
598            if ( defined $args->{century} ) {
599                $args->{year}
600                    = $args->{year_100} + ( $args->{century} * 100 );
601            }
602            else {
603                $args->{year} = $args->{year_100} + (
604                    $args->{year_100} >= 69
605                    ? 1900
606                    : 2000
607                );
608            }
609        }
610
611        if ( $args->{time_zone_offset} ) {
612            my $offset = $args->{time_zone_offset};
613
614            if ( $offset eq 'Z' ) {
615                $offset = '+0000';
616            }
617            elsif ( $offset =~ /^[+-][0-9]{2}$/ ) {
618                $offset .= '00';
619            }
620
621            my $tz = try { DateTime::TimeZone->new( name => $offset ) };
622            unless ($tz) {
623                $self->_our_croak(
624                    qq{The time zone name offset that was parsed does not appear to be valid, "$args->{time_zone_offset}"}
625                );
626                return;
627            }
628
629            $args->{time_zone} = $tz;
630        }
631
632        if ( defined $args->{time_zone_abbreviation} ) {
633            my $abbr = $args->{time_zone_abbreviation};
634            unless ( exists $self->{zone_map}{$abbr} ) {
635                $self->_our_croak(
636                    qq{Parsed an unrecognized time zone abbreviation, "$args->{time_zone_abbreviation}"}
637                );
638                return;
639            }
640            if ( !defined $self->{zone_map}{$abbr} ) {
641                $self->_our_croak(
642                    qq{The time zone abbreviation that was parsed is ambiguous, "$args->{time_zone_abbreviation}"}
643                );
644                return;
645            }
646            $args->{time_zone}
647                = DateTime::TimeZone->new( name => $self->{zone_map}{$abbr} );
648        }
649        else {
650            $args->{time_zone} ||= 'floating';
651        }
652
653        if ( $args->{time_zone_name} ) {
654            my $name = $args->{time_zone_name};
655            my $tz;
656            unless ( $tz = try { DateTime::TimeZone->new( name => $name ) } )
657            {
658                $name = lc $name;
659                $name =~ s{(^|[/_])(.)}{$1\U$2}g;
660            }
661            $tz = try { DateTime::TimeZone->new( name => $name ) };
662            unless ($tz) {
663                $self->_our_croak(
664                    qq{The Olson time zone name that was parsed does not appear to be valid, "$args->{time_zone_name}"}
665                );
666                return;
667            }
668            $args->{time_zone} = $tz
669                if $tz;
670        }
671
672        delete @{$args}{@non_dt_keys};
673        $args->{locale} = $self->{locale};
674
675        for my $k ( grep { defined $args->{$_} }
676            qw( month day hour minute second nanosecond ) ) {
677            $args->{$k} =~ s/^\s+//;
678        }
679
680        if ( defined $args->{nanosecond} ) {
681
682            # If we parsed "12345" we treat it as "123450000" but if we parsed
683            # "000123456" we treat it as 123,456 nanoseconds. This is all a bit
684            # weird and confusing but it matches how this module has always
685            # worked.
686            $args->{nanosecond} *= 10**( 9 - length $args->{nanosecond} )
687                if length $args->{nanosecond} != 9;
688
689            # If we parsed 000000123 we want to turn this into a number.
690            $args->{nanosecond} += 0;
691        }
692
693        for my $k (qw( year month day )) {
694            $args->{$k} = 1 unless defined $args->{$k};
695        }
696
697        if ( defined $args->{epoch} ) {
698
699            # We don't want to pass a non-integer epoch value since that gets
700            # truncated as of DateTime 1.22. Instead, we'll set the nanosecond
701            # to parsed value after constructing the object. This is a hack,
702            # but it's the best I can come up with.
703            my $post_construct;
704            if ( my $nano = $args->{nanosecond} ) {
705                $post_construct = sub { $_[0]->set( nanosecond => $nano ) };
706            }
707
708            delete @{$args}{
709                qw( day_of_year year month day hour minute second nanosecond )
710            };
711
712            return ( 'from_epoch', $args, $post_construct );
713        }
714        elsif ( $args->{day_of_year} ) {
715            delete @{$args}{qw( epoch month day )};
716            return ( 'from_day_of_year', $args );
717        }
718
719        return ( 'new', $args );
720    }
721}
722
723## no critic (Subroutines::ProhibitExcessComplexity)
724sub _check_dt {
725    my $self = shift;
726    my $dt   = shift;
727    my $args = shift;
728
729    my $is_am = defined $args->{am_pm}
730        && lc $args->{am_pm} eq lc $self->{locale}->am_pm_abbreviated->[0];
731    if ( defined $args->{hour} && defined $args->{hour_12} ) {
732        unless ( ( $args->{hour} % 12 ) == $args->{hour_12} ) {
733            $self->_our_croak(
734                'Parsed an input with 24-hour and 12-hour time values that do not match'
735                    . qq{ - "$args->{hour}" versus "$args->{hour_12}"} );
736            return;
737        }
738    }
739
740    if ( defined $args->{hour} && defined $args->{am_pm} ) {
741        if (   ( $is_am && $args->{hour} >= 12 )
742            || ( !$is_am && $args->{hour} < 12 ) ) {
743            $self->_our_croak(
744                'Parsed an input with 24-hour and AM/PM values that do not match'
745                    . qq{ - "$args->{hour}" versus "$args->{am_pm}"} );
746            return;
747        }
748    }
749
750    if ( defined $args->{year} && defined $args->{century} ) {
751        unless ( int( $args->{year} / 100 ) == $args->{century} ) {
752            $self->_our_croak(
753                'Parsed an input with year and century values that do not match'
754                    . qq{ - "$args->{year}" versus "$args->{century}"} );
755            return;
756        }
757    }
758
759    if ( defined $args->{year} && defined $args->{year_100} ) {
760        unless ( ( $args->{year} % 100 ) == $args->{year_100} ) {
761            $self->_our_croak(
762                'Parsed an input with year and year-within-century values that do not match'
763                    . qq{ - "$args->{year}" versus "$args->{year_100}"} );
764            return;
765        }
766    }
767
768    if (   defined $args->{time_zone_abbreviation}
769        && defined $args->{time_zone_offset} ) {
770        unless ( $self->{zone_map}{ $args->{time_zone_abbreviation} }
771            && $self->{zone_map}{ $args->{time_zone_abbreviation} } eq
772            $args->{time_zone_offset} ) {
773
774            $self->_our_croak(
775                'Parsed an input with time zone abbreviation and time zone offset values that do not match'
776                    . qq{ - "$args->{time_zone_abbreviation}" versus "$args->{time_zone_offset}"}
777            );
778            return;
779        }
780    }
781
782    if ( defined $args->{epoch} ) {
783        for my $key (
784            qw( year month day minute hour second hour_12 day_of_year )) {
785            if ( defined $args->{$key} && $dt->$key != $args->{$key} ) {
786                my $print_key
787                    = $key eq 'hour_12'     ? 'hour (1-12)'
788                    : $key eq 'day_of_year' ? 'day of year'
789                    :                         $key;
790                $self->_our_croak(
791                    "Parsed an input with epoch and $print_key values that do not match"
792                        . qq{ - "$args->{epoch}" versus "$args->{$key}"} );
793                return;
794            }
795        }
796    }
797
798    if ( defined $args->{month} && defined $args->{day_of_year} ) {
799        unless ( $dt->month == $args->{month} ) {
800            $self->_our_croak(
801                'Parsed an input with month and day of year values that do not match'
802                    . qq{ - "$args->{month}" versus "$args->{day_of_year}"} );
803            return;
804        }
805    }
806
807    if ( defined $args->{day_name} ) {
808        my $dow = $self->_locale_days->{ lc $args->{day_name} };
809        defined $dow
810            or die "We somehow parsed a day name ($args->{day_name})"
811            . ' that does not correspond to any day in this locale!';
812
813        unless ( $dt->day_of_week_0 == $dow ) {
814            $self->_our_croak(
815                'Parsed an input where the day name does not match the date'
816                    . qq{ - "$args->{day_name}" versus "}
817                    . $dt->ymd
818                    . q{"} );
819            return;
820        }
821    }
822
823    if ( defined $args->{day_of_week} ) {
824        unless ( $dt->day_of_week == $args->{day_of_week} ) {
825            $self->_our_croak(
826                'Parsed an input where the day of week does not match the date'
827                    . qq{ - "$args->{day_of_week}" versus "}
828                    . $dt->ymd
829                    . q{"} );
830            return;
831        }
832    }
833
834    if ( defined $args->{day_of_week_sun_0} ) {
835        unless ( ( $dt->day_of_week % 7 ) == $args->{day_of_week_sun_0} ) {
836            $self->_our_croak(
837                'Parsed an input where the day of week (Sunday as 0) does not match the date'
838                    . qq{ - "$args->{day_of_week_sun_0}" versus "}
839                    . $dt->ymd
840                    . q{"} );
841            return;
842        }
843    }
844
845    if ( defined $args->{iso_week_year} ) {
846        unless ( $dt->week_year == $args->{iso_week_year} ) {
847            $self->_our_croak(
848                'Parsed an input where the ISO week year does not match the date'
849                    . qq{ - "$args->{iso_week_year}" versus "}
850                    . $dt->ymd
851                    . q{"} );
852            return;
853        }
854    }
855
856    if ( defined $args->{iso_week_year_100} ) {
857        unless ( ( 0 + substr( $dt->week_year, -2 ) )
858            == $args->{iso_week_year_100} ) {
859            $self->_our_croak(
860                'Parsed an input where the ISO week year (without century) does not match the date'
861                    . qq{ - "$args->{iso_week_year_100}" versus "}
862                    . $dt->ymd
863                    . q{"} );
864            return;
865        }
866    }
867
868    if ( defined $args->{week_mon_1} ) {
869        unless ( ( 0 + $dt->strftime('%W') ) == $args->{week_mon_1} ) {
870            $self->_our_croak(
871                'Parsed an input where the ISO week number (Monday starts week) does not match the date'
872                    . qq{ - "$args->{week_mon_1}" versus "}
873                    . $dt->ymd
874                    . q{"} );
875            return;
876        }
877    }
878
879    if ( defined $args->{week_sun_0} ) {
880        unless ( ( 0 + $dt->strftime('%U') ) == $args->{week_sun_0} ) {
881            $self->_our_croak(
882                'Parsed an input where the ISO week number (Sunday starts week) does not match the date'
883                    . qq{ - "$args->{week_sun_0}" versus "}
884                    . $dt->ymd
885                    . q{"} );
886            return;
887        }
888    }
889
890    return 1;
891}
892## use critic
893
894sub pattern {
895    my $self = shift;
896    return $self->{pattern};
897}
898
899sub locale {
900    my $self = shift;
901    return $self->{locale}->can('code')
902        ? $self->{locale}->code
903        : $self->{locale}->id;
904}
905
906sub time_zone {
907    my $self = shift;
908    return $self->{time_zone}->name;
909}
910
911sub parse_duration {
912    croak q{DateTime::Format::Strptime doesn't do durations.};
913}
914
915{
916    my $validator = validation_for( params => [ { type => t('DateTime') } ] );
917
918    sub format_datetime {
919        my $self = shift;
920        my ($dt) = $validator->(@_);
921
922        my $pattern = $self->pattern;
923        $pattern =~ s/%O/$dt->time_zone->name/eg;
924        return $dt->clone->set_locale( $self->locale )->strftime($pattern);
925    }
926
927}
928
929sub format_duration {
930    croak q{DateTime::Format::Strptime doesn't do durations.};
931}
932
933sub _our_croak {
934    my $self  = shift;
935    my $error = shift;
936
937    return $self->{on_error}->( $self, $error ) if ref $self->{on_error};
938    croak $error if $self->{on_error} eq 'croak';
939    $self->{errmsg} = $error;
940    return;
941}
942
943sub errmsg {
944    $_[0]->{errmsg};
945}
946
947# Exportable functions:
948
949sub strftime {
950    my ( $pattern, $dt ) = @_;
951    return DateTime::Format::Strptime->new(
952        pattern  => $pattern,
953        on_error => 'croak'
954    )->format_datetime($dt);
955}
956
957sub strptime {
958    my ( $pattern, $time_string ) = @_;
959    return DateTime::Format::Strptime->new(
960        pattern  => $pattern,
961        on_error => 'croak'
962    )->parse_datetime($time_string);
963}
964
9651;
966
967# ABSTRACT: Parse and format strp and strf time patterns
968
969__END__
970
971=pod
972
973=encoding UTF-8
974
975=head1 NAME
976
977DateTime::Format::Strptime - Parse and format strp and strf time patterns
978
979=head1 VERSION
980
981version 1.79
982
983=head1 SYNOPSIS
984
985    use DateTime::Format::Strptime;
986
987    my $strp = DateTime::Format::Strptime->new(
988        pattern   => '%T',
989        locale    => 'en_AU',
990        time_zone => 'Australia/Melbourne',
991    );
992
993    my $dt = $strp->parse_datetime('23:16:42');
994
995    $strp->format_datetime($dt);
996
997    # 23:16:42
998
999    # Croak when things go wrong:
1000    my $strp = DateTime::Format::Strptime->new(
1001        pattern   => '%T',
1002        locale    => 'en_AU',
1003        time_zone => 'Australia/Melbourne',
1004        on_error  => 'croak',
1005    );
1006
1007    # Do something else when things go wrong:
1008    my $strp = DateTime::Format::Strptime->new(
1009        pattern   => '%T',
1010        locale    => 'en_AU',
1011        time_zone => 'Australia/Melbourne',
1012        on_error  => \&phone_police,
1013    );
1014
1015=head1 DESCRIPTION
1016
1017This module implements most of C<strptime(3)>, the POSIX function that is the
1018reverse of C<strftime(3)>, for C<DateTime>. While C<strftime> takes a
1019C<DateTime> and a pattern and returns a string, C<strptime> takes a string and
1020a pattern and returns the C<DateTime> object associated.
1021
1022=for Pod::Coverage parse_duration format_duration
1023
1024=head1 METHODS
1025
1026This class offers the following methods.
1027
1028=head2 DateTime::Format::Strptime->new(%args)
1029
1030This methods creates a new object. It accepts the following arguments:
1031
1032=over 4
1033
1034=item * pattern
1035
1036This is the pattern to use for parsing. This is required.
1037
1038=item * strict
1039
1040This is a boolean which disables or enables strict matching mode.
1041
1042By default, this module turns your pattern into a regex that will match
1043anywhere in a string. So given the pattern C<%Y%m%d%H%M%S> it will match a
1044string like C<20161214233712>. However, this also means that a this pattern
1045will match B<any> string that contains 14 or more numbers! This behavior can be
1046very surprising.
1047
1048If you enable strict mode, then the generated regex is wrapped in boundary
1049checks of the form C</(?:\A|\b)...(?:\b|\z_/)>. These checks ensure that the
1050pattern will only match when at the beginning or end of a string, or when it is
1051separated by other text with a word boundary (C<\w> versus C<\W>).
1052
1053By default, strict mode is off. This is done for backwards compatibility.
1054Future releases may turn it on by default, as it produces less surprising
1055behavior in many cases.
1056
1057Because the default may change in the future, B<< you are strongly encouraged
1058to explicitly set this when constructing all C<DateTime::Format::Strptime>
1059objects >>.
1060
1061=item * time_zone
1062
1063The default time zone to use for objects returned from parsing.
1064
1065=item * zone_map
1066
1067Some time zone abbreviations are ambiguous (e.g. PST, EST, EDT). By default,
1068the parser will die when it parses an ambiguous abbreviation. You may specify a
1069C<zone_map> parameter as a hashref to map zone abbreviations however you like:
1070
1071    zone_map => { PST => '-0800', EST => '-0600' }
1072
1073Note that you can also override non-ambiguous mappings if you want to as well.
1074
1075=item * locale
1076
1077The locale to use for objects returned from parsing.
1078
1079=item * on_error
1080
1081This can be one of C<'undef'> (the string, not an C<undef>), 'croak', or a
1082subroutine reference.
1083
1084=over 8
1085
1086=item * 'undef'
1087
1088This is the default behavior. The module will return C<undef> on errors. The
1089error can be accessed using the C<< $object->errmsg >> method. This is the
1090ideal behaviour for interactive use where a user might provide an illegal
1091pattern or a date that doesn't match the pattern.
1092
1093=item * 'croak'
1094
1095The module will croak with an error message on errors.
1096
1097=item * sub{...} or \&subname
1098
1099When given a code ref, the module will call that sub on errors. The sub
1100receives two parameters: the object and the error message.
1101
1102If your sub does not die, then the formatter will continue on as if C<on_error>
1103was C<'undef'>.
1104
1105=back
1106
1107=back
1108
1109=head2 $strptime->parse_datetime($string)
1110
1111Given a string in the pattern specified in the constructor, this method will
1112return a new C<DateTime> object.
1113
1114If given a string that doesn't match the pattern, the formatter will croak or
1115return undef, depending on the setting of C<on_error> in the constructor.
1116
1117=head2 $strptime->format_datetime($datetime)
1118
1119Given a C<DateTime> object, this methods returns a string formatted in the
1120object's format. This method is synonymous with C<DateTime>'s strftime method.
1121
1122=head2 $strptime->locale
1123
1124This method returns the locale passed to the object's constructor.
1125
1126=head2 $strptime->pattern
1127
1128This method returns the pattern passed to the object's constructor.
1129
1130=head2 $strptime->time_zone
1131
1132This method returns the time zone passed to the object's constructor.
1133
1134=head2 $strptime->errmsg
1135
1136If the on_error behavior of the object is 'undef', you can retrieve error
1137messages with this method so you can work out why things went wrong.
1138
1139=head1 EXPORTS
1140
1141These subs are available as optional exports.
1142
1143=head2 strptime( $strptime_pattern, $string )
1144
1145Given a pattern and a string this function will return a new C<DateTime>
1146object.
1147
1148=head2 strftime( $strftime_pattern, $datetime )
1149
1150Given a pattern and a C<DateTime> object this function will return a formatted
1151string.
1152
1153=head1 STRPTIME PATTERN TOKENS
1154
1155The following tokens are allowed in the pattern string for strptime
1156(parse_datetime):
1157
1158=over 4
1159
1160=item * %%
1161
1162The % character.
1163
1164=item * %a or %A
1165
1166The weekday name according to the given locale, in abbreviated form or the full
1167name.
1168
1169=item * %b or %B or %h
1170
1171The month name according to the given locale, in abbreviated form or the full
1172name.
1173
1174=item * %c
1175
1176The datetime format according to the given locale.
1177
1178Note that this format can change without warning in new versions of
1179L<DateTime::Locale>. You should not use this pattern unless the string you are
1180parsing was generated by using this pattern with L<DateTime> B<and> you are
1181sure that this string was generated with the same version of
1182L<DateTime::Locale> that the parser is using.
1183
1184=item * %C
1185
1186The century number (0-99).
1187
1188=item * %d or %e
1189
1190The day of month (01-31). This will parse single digit numbers as well.
1191
1192=item * %D
1193
1194Equivalent to %m/%d/%y. (This is the American style date, very confusing to
1195non-Americans, especially since %d/%m/%y is widely used in Europe. The ISO 8601
1196standard pattern is %F.)
1197
1198=item * %F
1199
1200Equivalent to %Y-%m-%d. (This is the ISO style date)
1201
1202=item * %g
1203
1204The year corresponding to the ISO week number, but without the century (0-99).
1205
1206=item * %G
1207
1208The 4-digit year corresponding to the ISO week number.
1209
1210=item * %H
1211
1212The hour (00-23). This will parse single digit numbers as well.
1213
1214=item * %I
1215
1216The hour on a 12-hour clock (1-12).
1217
1218=item * %j
1219
1220The day number in the year (1-366).
1221
1222=item * %m
1223
1224The month number (01-12). This will parse single digit numbers as well.
1225
1226=item * %M
1227
1228The minute (00-59). This will parse single digit numbers as well.
1229
1230=item * %n
1231
1232Arbitrary whitespace.
1233
1234=item * %N
1235
1236Nanoseconds. For other sub-second values use C<%[number]N>.
1237
1238=item * %p or %P
1239
1240The equivalent of AM or PM according to the locale in use. See
1241L<DateTime::Locale>.
1242
1243=item * %r
1244
1245Equivalent to %I:%M:%S %p.
1246
1247=item * %R
1248
1249Equivalent to %H:%M.
1250
1251=item * %s
1252
1253Number of seconds since the Epoch.
1254
1255=item * %S
1256
1257The second (0-60; 60 may occur for leap seconds. See L<DateTime::LeapSecond>).
1258
1259=item * %t
1260
1261Arbitrary whitespace.
1262
1263=item * %T
1264
1265Equivalent to %H:%M:%S.
1266
1267=item * %U
1268
1269The week number with Sunday the first day of the week (0-53). The first Sunday
1270of January is the first day of week 1.
1271
1272=item * %u
1273
1274The weekday number (1-7) with Monday = 1. This is the C<DateTime> standard.
1275
1276=item * %w
1277
1278The weekday number (0-6) with Sunday = 0.
1279
1280=item * %W
1281
1282The week number with Monday the first day of the week (0-53). The first Monday
1283of January is the first day of week 1.
1284
1285=item * %x
1286
1287The date format according to the given locale.
1288
1289Note that this format can change without warning in new versions of
1290L<DateTime::Locale>. You should not use this pattern unless the string you are
1291parsing was generated by using this pattern with L<DateTime> B<and> you are
1292sure that this string was generated with the same version of
1293L<DateTime::Locale> that the parser is using.
1294
1295=item * %X
1296
1297The time format according to the given locale.
1298
1299Note that this format can change without warning in new versions of
1300L<DateTime::Locale>. You should not use this pattern unless the string you are
1301parsing was generated by using this pattern with L<DateTime> B<and> you are
1302sure that this string was generated with the same version of
1303L<DateTime::Locale> that the parser is using.
1304
1305=item * %y
1306
1307The year within century (0-99). When a century is not otherwise specified (with
1308a value for %C), values in the range 69-99 refer to years in the twentieth
1309century (1969-1999); values in the range 00-68 refer to years in the
1310twenty-first century (2000-2068).
1311
1312=item * %Y
1313
1314A 4-digit year, including century (for example, 1991).
1315
1316=item * %z
1317
1318An RFC-822/ISO 8601 standard time zone specification. (For example +1100) [See
1319note below]
1320
1321=item * %Z
1322
1323The timezone name. (For example EST -- which is ambiguous) [See note below]
1324
1325=item * %O
1326
1327This extended token allows the use of Olson Time Zone names to appear in parsed
1328strings. B<NOTE>: This pattern cannot be passed to C<DateTime>'s C<strftime()>
1329method, but can be passed to C<format_datetime()>.
1330
1331=back
1332
1333=head1 AUTHOR EMERITUS
1334
1335This module was created by Rick Measham.
1336
1337=head1 SEE ALSO
1338
1339C<datetime@perl.org> mailing list.
1340
1341http://datetime.perl.org/
1342
1343L<perl>, L<DateTime>, L<DateTime::TimeZone>, L<DateTime::Locale>
1344
1345=head1 BUGS
1346
1347Please report any bugs or feature requests to
1348C<bug-datetime-format-strptime@rt.cpan.org>, or through the web interface at
1349L<http://rt.cpan.org>. I will be notified, and then you'll automatically be
1350notified of progress on your bug as I make changes.
1351
1352Bugs may be submitted at L<https://github.com/houseabsolute/DateTime-Format-Strptime/issues>.
1353
1354There is a mailing list available for users of this distribution,
1355L<mailto:datetime@perl.org>.
1356
1357I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
1358
1359=head1 SOURCE
1360
1361The source code repository for DateTime-Format-Strptime can be found at L<https://github.com/houseabsolute/DateTime-Format-Strptime>.
1362
1363=head1 DONATIONS
1364
1365If you'd like to thank me for the work I've done on this module, please
1366consider making a "donation" to me via PayPal. I spend a lot of free time
1367creating free software, and would appreciate any support you'd care to offer.
1368
1369Please note that B<I am not suggesting that you must do this> in order for me
1370to continue working on this particular software. I will continue to do so,
1371inasmuch as I have in the past, for as long as it interests me.
1372
1373Similarly, a donation made in this way will probably not make me work on this
1374software much more, unless I get so many donations that I can consider working
1375on free software full time (let's all have a chuckle at that together).
1376
1377To donate, log into PayPal and send money to autarch@urth.org, or use the
1378button at L<https://www.urth.org/fs-donation.html>.
1379
1380=head1 AUTHORS
1381
1382=over 4
1383
1384=item *
1385
1386Dave Rolsky <autarch@urth.org>
1387
1388=item *
1389
1390Rick Measham <rickm@cpan.org>
1391
1392=back
1393
1394=head1 CONTRIBUTORS
1395
1396=for stopwords Christian Hansen D. Ilmari Mannsåker gregor herrmann key-amb Mohammad S Anwar
1397
1398=over 4
1399
1400=item *
1401
1402Christian Hansen <chansen@cpan.org>
1403
1404=item *
1405
1406D. Ilmari Mannsåker <ilmari.mannsaker@net-a-porter.com>
1407
1408=item *
1409
1410gregor herrmann <gregoa@debian.org>
1411
1412=item *
1413
1414key-amb <yasutake.kiyoshi@gmail.com>
1415
1416=item *
1417
1418Mohammad S Anwar <mohammad.anwar@yahoo.com>
1419
1420=back
1421
1422=head1 COPYRIGHT AND LICENSE
1423
1424This software is Copyright (c) 2015 - 2021 by Dave Rolsky.
1425
1426This is free software, licensed under:
1427
1428  The Artistic License 2.0 (GPL Compatible)
1429
1430The full text of the license can be found in the
1431F<LICENSE> file included with this distribution.
1432
1433=cut
1434