File Coverage

blib/lib/Mail/Message/Field/Date.pm
Criterion Covered Total %
statement 15 43 34.8
branch 0 20 0.0
condition 0 4 0.0
subroutine 5 10 50.0
pod 5 5 100.0
total 25 82 30.4


line stmt bran cond sub pod time code
1             # Copyrights 2001-2022 by [Mark Overmeer ].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.03.
5             # This code is part of distribution Mail-Message. Meta-POD processed with
6             # OODoc into POD and HTML manual-pages. See README.md
7             # Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
8              
9             package Mail::Message::Field::Date;
10 21     21   140 use vars '$VERSION';
  21         38  
  21         1163  
11             $VERSION = '3.012';
12              
13 21     21   117 use base 'Mail::Message::Field::Structured';
  21         61  
  21         2207  
14              
15 21     21   127 use warnings;
  21         40  
  21         500  
16 21     21   97 use strict;
  21         39  
  21         456  
17              
18 21     21   6102 use POSIX qw/mktime tzset/;
  21         81556  
  21         121  
19              
20              
21             my $dayname = qr/Mon|Tue|Wed|Thu|Fri|Sat|Sun/;
22             my @months = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
23             my %monthnr; { my $i; $monthnr{$_} = ++$i for @months }
24             my %tz = qw/EDT -0400 EST -0500 CDT -0500 CST -0600
25             MDT -0600 MST -0700 PDT -0700 PST -0800
26             UT +0000 GMT +0000/;
27              
28             sub parse($)
29 0     0 1   { my ($self, $string) = @_;
30              
31 0 0         my ($dn, $d, $mon, $y, $h, $min, $s, $z) = $string =~
32             m/ ^ \s*
33             (?: ($dayname) \s* \, \s* )?
34             ( 0?[1-9] | [12][0-9] | 3[01] ) \s* # day
35             \s+ ( [A-Z][a-z][a-z]|[0-9][0-9] ) \s+ # month
36             ( (?: 19 | 20 | ) [0-9][0-9] ) \s+ # year
37             ( [0-1]?[0-9] | 2[0-3] ) \s* # hour
38             [:.] ( [0-5][0-9] ) \s* # minute
39             (?: [:.] ( [0-5][0-9] ) )? \s+ # second
40             ( [+-][0-9]{4} | [A-Z]+ )? # zone
41             \s* /x
42             or return undef;
43              
44 0 0         defined $dn or $dn = '';
45 0           $dn =~ s/\s+//g;
46 0 0         $mon = $months[$mon-1] if $mon =~ /[0-9]+/; # Broken mail clients
47              
48 0 0         $y += 2000 if $y < 50;
49 0 0         $y += 1900 if $y < 100;
50              
51 0   0       $z ||= '-0000';
52 0 0 0       $z = $tz{$z} || '-0000'
53             if $z =~ m/[A-Z]/;
54              
55 0 0         $self->{MMFD_date} = sprintf "%s%s%02d %s %04d %02d:%02d:%02d %s"
56             , $dn, (length $dn ? ', ' : ''), $d, $mon, $y, $h, $min, $s, $z;
57              
58 0           $self;
59             }
60              
61 0     0 1   sub produceBody() { shift->{MMFD_date} }
62 0     0 1   sub date() { shift->{MMFD_date} }
63              
64             #------------------------------------------
65              
66              
67             sub addAttribute($;@)
68 0     0 1   { my $self = shift;
69 0           $self->log(ERROR => 'No attributes for date fields.');
70 0           $self;
71             }
72              
73              
74             sub time()
75 0     0 1   { my $date = shift->{MMFD_date};
76 0           my ($d, $mon, $y, $h, $min, $s, $z)
77             = $date =~ m/^ (?:\w\w\w\,\s+)? (\d\d)\s+(\w+)\s+(\d\d\d\d)
78             \s+ (\d\d)\:(\d\d)\:(\d\d) \s+ ([+-]\d\d\d\d)? \s*$ /x;
79              
80 0           my $oldtz = $ENV{TZ};
81 0           $ENV{TZ} = 'UTC';
82 0           tzset;
83 0           my $timestamp = mktime $s, $min, $h, $d, $monthnr{$mon}-1, $y-1900;
84 0 0         if(defined $oldtz) { $ENV{TZ} = $oldtz } else { delete $ENV{TZ} }
  0            
  0            
85 0           tzset;
86              
87 0 0         $timestamp += ($1 eq '-' ? 1 : -1) * ($2*3600 + $3*60)
    0          
88             if $z =~ m/^([+-])(\d\d)(\d\d)$/;
89 0           $timestamp;
90             }
91              
92             #------------------------------------------
93              
94              
95             1;