| 1 |
|
|
| 2 |
=head1 NAME |
=head1 NAME |
| 3 |
|
|
| 4 |
Message::Field::Date --- Perl module for various styles of |
Message::Field::Date --- Perl module for various styles of |
| 5 |
date-time used in Internet messages and so on |
date-time used in Internet messages and so on |
| 6 |
|
|
| 7 |
=cut |
=cut |
| 8 |
|
|
| 9 |
package Message::Field::Date; |
## This file is written in UTF-8 |
| 10 |
use strict; |
|
| 11 |
use vars qw(%DEFAULT @ISA %MONTH %REG $VERSION %ZONE); |
package Message::Field::Date; |
| 12 |
$VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; |
use strict; |
| 13 |
require Message::Field::Structured; |
use vars qw(%DEFAULT %FMT2STR @ISA %MONTH %REG $VERSION %ZONE); |
| 14 |
push @ISA, qw(Message::Field::Structured); |
$VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; |
| 15 |
use Time::Local 'timegm_nocheck'; |
require Message::Field::Structured; |
| 16 |
use overload '==' => sub { $_[0]->{date_time} == $_[1] }, |
push @ISA, qw(Message::Field::Structured); |
| 17 |
'<=' => sub { $_[0]->{date_time} <= $_[1] }, |
use Time::Local 'timegm_nocheck'; |
| 18 |
'>=' => sub { $_[0]->{date_time} >= $_[1] }, |
use overload '==' => sub { $_[0]->{date_time} == $_[1] }, |
| 19 |
'0+' => sub { $_[0]->{date_time} }, |
'<=' => sub { $_[0]->{date_time} <= $_[1] }, |
| 20 |
fallback => 1; |
'>=' => sub { $_[0]->{date_time} >= $_[1] }, |
| 21 |
|
'0+' => sub { $_[0]->{date_time} }, |
| 22 |
%REG = %Message::Util::REG; |
fallback => 1; |
| 23 |
## RFC 822/2822 Internet Message Format |
|
| 24 |
$REG{M_dt_rfc822} = qr!(?:[A-Za-z]+ ## Day of week |
{ |
| 25 |
[\x09\x20,]*)? ([0-9]+) ## Day |
%REG = %Message::Util::REG; |
| 26 |
[\x09\x20/-]* ([A-Za-z]+) ## Month |
my $_ALPHA = q{[A-Za-z]}; |
| 27 |
[\x09\x20/-]* ([0-9]+) ## Year |
$_ALPHA = q{[A-Za-z\x{0080}-\x{7FFFFFFF}]} if defined $^V && $^V gt v5.7; |
| 28 |
[\x09\x20:Tt-]+ ([0-9]+) ## Hour |
## RFC 822/2822 Internet Message Format |
| 29 |
[\x09\x20:]+ ([0-9]+) ## Minute |
$REG{M_dt_rfc822} = qr!(?:[A-Za-z]+ ## Day of week |
| 30 |
[\x09\x20:]* ([0-9]+)? ## Second |
[\x09\x20,]*)? ([0-9]+) ## Day |
| 31 |
([\x09\x20 0-9A-Za-z+-]+)!x; ## Zone |
[\x09\x20/-]* ($_ALPHA+) ## Month |
| 32 |
## RFC 3339 Internet Date/Time Format (A profile of ISO 8601) |
[\x09\x20/-]* ([0-9]+) ## Year |
| 33 |
$REG{M_dt_rfc3339} = qr! ([0-9]{4,}) ## Year |
[\x09\x20:Tt-]+ ([0-9]+) ## Hour |
| 34 |
[\x09\x20.:/-]+ ([0-9]+) ## Month |
[\x09\x20:]+ ([0-9]+) ## Minute |
| 35 |
[\x09\x20.:/-]+ ([0-9]+) ## Day |
[\x09\x20:]* ([0-9]+)? ## Second |
| 36 |
(?:[\x09\x20.:Tt-]+ ([0-9]+) ## Hour |
([\x09\x20 0-9A-Za-z+-]+)!x; ## Zone |
| 37 |
[\x09\x20.:]+ ([0-9]+) ## Minute |
## RFC 3339 Internet Date/Time Format (A profile of ISO 8601) |
| 38 |
(?:[\x09\x20.:]+ ([0-9]+) ## Second |
$REG{M_dt_rfc3339} = qr! ([0-9]{4,}) ## Year |
| 39 |
(?:[\x09\x20.:]+ ([0-9]+))?)?)? ## frac. |
[\x09\x20.:/-]+ ([0-9]+) ## Month |
| 40 |
([\x09\x20 0-9A-Za-z:.+-]*) !x; ## Zone. |
[\x09\x20.:/-]+ ([0-9]+) ## Day |
| 41 |
## RFC 733 ARPA Internet Message Format |
(?:[\x09\x20.:Tt-]+ ([0-9]+) ## Hour |
| 42 |
$REG{M_dt_rfc733} = qr!(?:[A-Za-z]+ ## Day of week |
[\x09\x20.:]+ ([0-9]+) ## Minute |
| 43 |
[\x09\x20,]*)? ([0-9]+) ## Day |
(?:[\x09\x20.:]+ ([0-9]+) ## Second |
| 44 |
[\x09\x20/-]* ([A-Za-z]+) ## Month |
(?:[\x09\x20.:]+ ([0-9]+))?)?)? ## frac. |
| 45 |
[\x09\x20/-]* ([0-9]+) ## Year |
([\x09\x20 0-9A-Za-z:.+-]*) !x; ## Zone. |
| 46 |
[\x09\x20:Tt-]+ ([0-9][0-9]) ## Hour |
## RFC 733 ARPA Internet Message Format |
| 47 |
[\x09\x20:]* ([0-9][0-9]) ## Minute |
$REG{M_dt_rfc733} = qr!(?:[A-Za-z]+ ## Day of week |
| 48 |
[\x09\x20:]* ([0-9][0-9])? ## Second |
[\x09\x20,]*)? ([0-9]+) ## Day |
| 49 |
([\x09\x20 0-9A-Za-z+-]+)!x; ## Zone |
[\x09\x20/-]* ([A-Za-z]+) ## Month |
| 50 |
## RFC 724 ARPA Internet Message Format (slash-date) |
[\x09\x20/-]* ([0-9]+) ## Year |
| 51 |
$REG{M_dt_rfc724} = qr!(?:[A-Za-z]+ ## Day of week |
[\x09\x20:Tt-]+ ([0-9][0-9]) ## Hour |
| 52 |
[\x09\x20,]*)? ([0-9][0-9]?) ## Month |
[\x09\x20:]* ([0-9][0-9]) ## Minute |
| 53 |
[\x09\x20/]+ ([0-9][0-9]?) ## Day |
[\x09\x20:]* ([0-9][0-9])? ## Second |
| 54 |
[\x09\x20/]+ ([0-9]{2,}) ## Year |
([\x09\x20 0-9A-Za-z+-]+)!x; ## Zone |
| 55 |
[\x09\x20:Tt-]+ ([0-9][0-9]) ## Hour |
## RFC 724 ARPA Internet Message Format (slash-date) |
| 56 |
[\x09\x20:]* ([0-9][0-9]) ## Minute |
$REG{M_dt_rfc724} = qr!(?:[A-Za-z]+ ## Day of week |
| 57 |
[\x09\x20:]* ([0-9][0-9])? ## Second |
[\x09\x20,]*)? ([0-9][0-9]?) ## Month |
| 58 |
([\x09\x20 0-9A-Za-z+-]+)!x; ## Zone |
[\x09\x20/]+ ([0-9][0-9]?) ## Day |
| 59 |
|
[\x09\x20/]+ ([0-9]{2,}) ## Year |
| 60 |
=head1 CONSTRUCTORS |
[\x09\x20:Tt-]+ ([0-9][0-9]) ## Hour |
| 61 |
|
[\x09\x20:]* ([0-9][0-9]) ## Minute |
| 62 |
The following methods construct new objects: |
[\x09\x20:]* ([0-9][0-9])? ## Second |
| 63 |
|
([\x09\x20 0-9A-Za-z+-]+)!x; ## Zone |
| 64 |
=over 4 |
} |
| 65 |
|
|
| 66 |
=cut |
=head1 CONSTRUCTORS |
| 67 |
|
|
| 68 |
## Initialize of this class -- called by constructors |
The following methods construct new objects: |
| 69 |
%DEFAULT = ( |
|
| 70 |
-_MEMBERS => [qw|date_time secfrac|], |
=over 4 |
| 71 |
-_METHODS => [qw|unix_time second_fraction |
|
| 72 |
comment_add comment_count comment_item comment_delete|], |
=cut |
| 73 |
-date_format => 'string', ## 'unix' / 1*ALPHA |
|
| 74 |
#field_param_name |
## Initialize of this class -- called by constructors |
| 75 |
#field_name |
%DEFAULT = ( |
| 76 |
#format |
-_MEMBERS => [qw|date_time secfrac|], |
| 77 |
#hook_encode_string |
-_METHODS => [qw|unix_time second_fraction |
| 78 |
#hook_decode_string |
comment_add comment_count comment_item comment_delete|], |
| 79 |
-output_comment => 1, |
-date_format => 'string', ## 'unix' / 1*ALPHA |
| 80 |
-fmt2str => { |
#field_param_name |
| 81 |
CC => sub { sprintf $_[2]->{_fmt}, ## Support AD only |
#field_name |
| 82 |
(($_[1]->{$_[2]->{_prefix}.'tm'}->[5] + 1899) / 100) + 1 }, |
#format |
| 83 |
YYYY => sub { $_[2]->{_fmt} =~ tr/2/4/; |
#hook_encode_string |
| 84 |
sprintf $_[2]->{_fmt}, |
#hook_decode_string |
| 85 |
$_[1]->{$_[2]->{_prefix}.'tm'}->[5] + 1900 }, |
-output_comment => 1, |
| 86 |
YY => sub { sprintf $_[2]->{_fmt}, |
-use_comment => 1, |
| 87 |
substr ($_[1]->{$_[2]->{_prefix}.'tm'}->[5], -2) }, |
-use_military_zone => +1, ## +1 / -1 / 0 |
| 88 |
MM => sub { sprintf $_[2]->{_fmt}, |
#zone => [+1, 0, 0], |
| 89 |
$_[1]->{$_[2]->{_prefix}.'tm'}->[4] + 1 }, |
-zone_default_string => '-0000', |
| 90 |
Mon => sub { qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) |
); |
| 91 |
[$_[1]->{$_[2]->{_prefix}.'tm'}->[4]] }, |
|
| 92 |
Month => sub { qw(January February March April May June |
%MONTH = ( |
| 93 |
July August September October November December) |
JAN => 1, JANUARY => 1, |
| 94 |
[$_[1]->{$_[2]->{_prefix}.'tm'}->[4]] }, |
FEB => 2, FEBRUARY => 2, |
| 95 |
DD => sub { sprintf $_[2]->{_fmt}, $_[1]->{$_[2]->{_prefix}.'tm'}->[3] }, |
MAR => 3, MARCH => 3, |
| 96 |
Wdy => sub { qw(Sun Mon Tue Wed Thu Fri Sat) |
APR => 4, APRIL => 4, |
| 97 |
[$_[1]->{$_[2]->{_prefix}.'tm'}->[6]] }, |
MAY => 5, |
| 98 |
Weekday => sub { qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday) |
JUN => 6, JUNE => 6, |
| 99 |
[$_[1]->{$_[2]->{_prefix}.'tm'}->[6]] }, |
JUL => 7, JULY => 7, |
| 100 |
shun => sub { |
AUG => 8, AUGUST => 8, |
| 101 |
my @alphabet = split /:/, $_[2]->{alphabet} || 'abcc'; |
SEP => 9, SEPTEMBER => 9, SEPT => 9, |
| 102 |
my $day = $_[1]->{$_[2]->{_prefix}.'tm'}->[3]; |
OCT => 10, OCTOBER => 10, |
| 103 |
$day <= 10? $alphabet[0]: ## 1 - 10 joujun |
NOV => 11, NOVEMBER => 11, |
| 104 |
$day <= 20? $alphabet[1]: ## 11 - 20 chuujun |
DEC => 12, DECEMBER => 12, |
| 105 |
$alphabet[2]; ## 21 - 31 gejun |
); |
| 106 |
}, |
|
| 107 |
HH => sub { sprintf $_[2]->{_fmt}, $_[1]->{$_[2]->{_prefix}.'tm'}->[2] }, |
if (defined $^V) { |
| 108 |
TT => sub { sprintf $_[2]->{_fmt}, $_[1]->{$_[2]->{_prefix}.'tm'}->[1] }, |
use utf8; |
| 109 |
SS => sub { sprintf $_[2]->{_fmt}, $_[1]->{$_[2]->{_prefix}.'tm'}->[0] }, |
%MONTH = (%MONTH, |
| 110 |
unix => sub { $_[1]->{$_[2]->{_prefix}.'unix'} }, |
qw(睦月 1 霞初月 1 暮新月 1 太郎月 1 子日月 1 初春月 1 |
| 111 |
frac => sub { $_[0]->{secfrac} }, |
初空月 1 早緑月 1 年端月 1 年初月 1 孟春 1 祝月 1 |
| 112 |
zsign => sub { $_[1]->{zone}->[0] > 0 ? '+' : '-' }, |
元月 1 端月 1 |
| 113 |
zHH => sub { sprintf $_[2]->{_fmt}, $_[1]->{zone}->[1] }, |
|
| 114 |
zTT => sub { sprintf $_[2]->{_fmt}, $_[1]->{zone}->[2] }, |
如月 2 初花月 2 梅月 2 梅見月 2 雪消月 2 小草生月 2 |
| 115 |
}, |
仲春 2 令月 2 仲陽 2 |
| 116 |
-use_comment => 1, |
|
| 117 |
-use_military_zone => +1, ## +1 / -1 / 0 |
弥生 3 桜月 3 晩春 3 早花咲月 3 染色月 3 花見月 3 |
| 118 |
#zone => [+1, 0, 0], |
春惜月 3 雛月 3 夢見月 3 季春 3 暮春 3 |
| 119 |
-zone_default_string => '-0000', |
|
| 120 |
); |
卯月 4 卯花月 4 得鳥羽月 4 夏初月 4 花残月 4 孟夏 4 |
| 121 |
|
麦秋 4 初夏 4 首夏 4 |
| 122 |
%MONTH = ( |
|
| 123 |
JAN => 1, JANUARY => 1, |
五月 5 皐月 5 早月 5 菖蒲月 5 五色月 5 狭雲月 5 早苗月 5 |
| 124 |
FEB => 2, FEBRUARY => 2, |
田草月 5 橘月 5 雨月 5 仲夏 5 星月 5 鶉月 5 早稲月 5 |
| 125 |
MAR => 3, MARCH => 3, |
|
| 126 |
APR => 4, APRIL => 4, |
水無月 6 弥涼暮月 6 風待月 6 涼暮月 6 蝉羽月 6 常夏月 6 |
| 127 |
MAY => 5, |
鳴神月 6 松風月 6 季夏 6 晩夏 6 林鐘 6 |
| 128 |
JUN => 6, JUNE => 6, |
|
| 129 |
JUL => 7, JULY => 7, |
文月 7 秋初月 7 七夕月 7 親月 7 文披月 7 書披月 7 |
| 130 |
AUG => 8, AUGUST => 8, |
愛合月 7 女郎花月 7 初秋 7 孟秋 7 新秋 7 |
| 131 |
SEP => 9, SEPTEMBER => 9, SEPT => 9, |
|
| 132 |
OCT => 10, OCTOBER => 10, |
葉月 8 初月 8 秋風月 8 草津月 8 木染月 8 月見月 8 萩月 8 |
| 133 |
NOV => 11, NOVEMBER => 11, |
紅染月 8 仲秋 8 清秋 8 |
| 134 |
DEC => 12, DECEMBER => 12, |
|
| 135 |
); |
長月 9 玄月 9 色どり月 9 菊咲月 9 菊月 9 寝覚月 9 暮秋 9 |
| 136 |
|
紅葉月 9 季秋 9 晩秋 9 |
| 137 |
%ZONE = ( ## NA = Northern America |
|
| 138 |
ADT => [-1, 3, 0], ## (NA)Atlantic Daylight 733 |
神無月 10 神有月 10 神去月 10 小春 10 時雨月 10 初霜月 10 |
| 139 |
CHST => [-1, 10, 0], ## Alaska-Hawaii Standard |
孟冬 10 初冬 10 |
| 140 |
AST => [-1, 4, 0], ## (NA)Atlantic Standard 733 |
|
| 141 |
AT => [-1, 2, 0], ## Azores |
霜月 11 神楽月 11 神帰月 11 霜降月 11 子月 11 雪待月 11 |
| 142 |
BDT => [-1, 10, 0], ## 733 |
仲冬 11 朔月 11 露ごもりの葉月 11 |
| 143 |
BST => [-1, 11, 0], ## 733 |
|
| 144 |
#BST => [+1, 1, 0], ## British Summer |
師走 12 除月 12 弟月 12 親子月 12 限月 12 暮来月 12 年積月 12 |
| 145 |
#BST => [-1, 3, 0], ## Brazil Standard |
春待月 12 梅初月 12 季冬 12 晩冬 12 極月 12 臘月 12 蠟月 12 蝋月 12 |
| 146 |
BT => [+1, 3, 0], ## Baghdad |
) |
| 147 |
CADT => [+1, 10, 30], ## Central Australian Daylight |
); |
| 148 |
CAST => [+1, 9, 30], ## Central Australian Standard |
} |
| 149 |
CAT => [-1, 10, 0], ## Central Alaska |
|
| 150 |
CCT => [+1, 8, 0], ## China Coast |
{ |
| 151 |
CDT => [-1, 5, 0], ## (NA)Central Daylight 733, 822 |
my $_p2f = sub { my ($s, $n) = @_; $s eq 'none'? q(%d): $s eq 'SP'? qq(%${n}d): qq(%0${n}d) }; |
| 152 |
CET => [+1, 1, 0], ## Central European |
my $_tm = sub { $_[0]->{local}?'tm_local':'tm' }; |
| 153 |
CEST => [+1, 2, 0], ## Central European Daylight |
## &$function ({format's parameters}, {caller's parameters}) |
| 154 |
CST => [-1, 6, 0], ## (NA)Central Standard 733, 822 |
%FMT2STR = ( |
| 155 |
EADT => [+1, 11, 0], ## Eastern Australian Daylight |
CC => sub { sprintf &$_p2f ($_[0]->{pad}, 2), ## BUG: Support AD only |
| 156 |
EADT => [+1, 10, 0], ## Eastern Australian Standard |
(($_[1]->{ &$_tm ($_[0]) }->[5] + 1899) / 100) + 1 }, |
| 157 |
ECT => [+1, 1, 0], ## Central European (French) |
YYYY => sub { sprintf &$_p2f ($_[0]->{pad}, 4), |
| 158 |
EDT => [-1, 4, 0], ## (NA)Eastern Daylight 733, 822 |
$_[1]->{ &$_tm ($_[0]) }->[5] + 1900 }, |
| 159 |
EEST => [+1, 3, 0], ## Eastern European Summer |
YY => sub { sprintf &$_p2f ($_[0]->{pad}, 2), |
| 160 |
EET => [+1, 2, 0], ## Eastern Europe 1947 |
$_[1]->{ &$_tm ($_[0]) }->[5] % 100 }, |
| 161 |
EST => [-1, 5, 0], ## (NA)Eastern Standard 733, 822 |
MM => sub { sprintf &$_p2f ($_[0]->{pad}, 2), |
| 162 |
EWT => [-1, 4, 0], ## U.S. Eastern War Time |
$_[1]->{ &$_tm ($_[0]) }->[4] + 1 }, |
| 163 |
FST => [+1, 2, 0], ## French Summer |
Mon => sub { qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) |
| 164 |
FWT => [+1, 1, 0], ## French Winter |
[ $_[1]->{ &$_tm ($_[0]) }->[4] ] }, |
| 165 |
GDT => [+1, 1, 0], ## 724 |
Month => sub { qw(January February March April May June |
| 166 |
GMT => [+1, 0, 0], ## Greenwich Mean 733, 822 |
July August September October November December) |
| 167 |
#GST => [-1, 3, 0], ## Greenland Standard |
[ $_[1]->{ &$_tm ($_[0]) }->[4] ] }, |
| 168 |
GST => [+1, 10, 0], ## Guam Standard |
DD => sub { sprintf &$_p2f ($_[0]->{pad}, 2), |
| 169 |
HDT => [-1, 9, 0], ## Hawaii Daylight 733 |
$_[1]->{ &$_tm ($_[0]) }->[3] }, |
| 170 |
HKT => [+1, 8, 0], ## Hong Kong |
Wdy => sub { qw(Sun Mon Tue Wed Thu Fri Sat) |
| 171 |
HST => [-1, 10, 0], ## Hawaii Standard 733 |
[ $_[1]->{ &$_tm ($_[0]) }->[6] ] }, |
| 172 |
IDLE => [+1, 12, 0], ## International Date Line East |
Weekday => sub { |
| 173 |
IDLW => [-1, 12, 0], ## International Date Line West |
(split /:/, $_[0]->{name} |
| 174 |
IDT => [+1, 3, 0], |
|| q(Sunday:Monday:Tuesday:Wednesday:Thursday:Friday:Saturday)) |
| 175 |
IST => [+1, 2, 0], ## Israel standard |
[ $_[1]->{ &$_tm ($_[0]) }->[6] ] }, |
| 176 |
#IST => [+1, 5, 30], ## Indian standard |
shun => sub { |
| 177 |
IT => [+1, 3, 30], ## Iran |
my @alphabet = split /:/, $_[0]->{alphabet} || 'a:b:c:c'; |
| 178 |
JST => [+1, 9, 0], ## Japan Central Standard |
my $day = $_[1]->{ &$_tm ($_[0]) }->[3]; |
| 179 |
JT => [+1, 7, 30], ## Java |
$day < 10? $alphabet[0]: ## 1 - 9 joujun |
| 180 |
KDT => [+1, 10, 0], ## Korean Daylight |
$day < 20? $alphabet[1]: ## 10 - 19 chuujun |
| 181 |
KST => [+1, 9, 0], ## Korean Standard |
$day < 30? $alphabet[2]: ## 20 - 29 gejun |
| 182 |
LCL => [-1, 0, 0], ## (unknown zone used by LSMTP) |
defined $alphabet[3] ? |
| 183 |
LOCAL => [-1, 0, 0], ## local time zone |
$alphabet[3]: $alphabet[2]; ## 30 - 31 gejun |
| 184 |
LT => [-1, 0, 0], ## Luna Time [RFC 1607] |
}, |
| 185 |
MDT => [-1, 6, 0], ## (NA)Mountain Daylight 733, 822 |
HH => sub { sprintf &$_p2f ($_[0]->{pad}, 2), |
| 186 |
MET => [+1, 0, 0], ## Middle European |
$_[1]->{ &$_tm ($_[0]) }->[2] }, |
| 187 |
METDST => [+1, 2, 0], |
TT => sub { sprintf &$_p2f ($_[0]->{pad}, 2), |
| 188 |
MEST => [+1, 2, 0], ## Middle European Summer |
$_[1]->{ &$_tm ($_[0]) }->[1] }, |
| 189 |
MEWT => [+1, 0, 0], ## Middle European Winter |
SS => sub { sprintf &$_p2f ($_[0]->{pad}, 2), |
| 190 |
MEZ => [+1, 0, 0], ## Central European (German) |
$_[1]->{ &$_tm ($_[0]) }->[0] }, |
| 191 |
MST => [-1, 7, 0], ## (NA)Mountain Standard 733, 822 |
unix => sub { sprintf &$_p2f ($_[0]->{pad}, 10), |
| 192 |
MT => [-1, 0, 0], ## Mars Time [RFC 1607] |
$_[1]->{ $_[0]->{local}?'time_local':'time' } }, |
| 193 |
NDT => [-1, 2, 30], ## Newfoundland Daylight |
frac => sub { $_[1]->{ $_[0]->{local}?'secfrac_local':'secfrac' } }, |
| 194 |
NFT => [-1, 3, 30], ## Newfoundland Standard |
zsign => sub { $_[1]->{option}->{zone}->[0] > 0 ? '+' : '-' }, |
| 195 |
NST => [-1, 3, 30], ## Newfoundland Standard 733 |
zHH => sub { sprintf &$_p2f ($_[0]->{pad}, 2), $_[1]->{option}->{zone}->[1] }, |
| 196 |
#NST => [-1, 6, 30], ## North Sumatra |
zTT => sub { sprintf &$_p2f ($_[0]->{pad}, 2), $_[1]->{option}->{zone}->[2] }, |
| 197 |
NT => [-1, 11, 0], ## Nome |
comment => sub { $_[1]->{comment} }, |
| 198 |
NZD => [+1, 13, 0], ## New Zealand Daylight |
); |
| 199 |
NZT => [+1, 12, 0], ## New Zealand |
} |
| 200 |
NZDT => [+1, 13, 0], ## New Zealand Daylight |
|
| 201 |
NZST => [+1, 12, 0], ## New Zealand Standard |
%ZONE = ( ## NA = Northern America |
| 202 |
PDT => [-1, 7, 0], ## (NA)Pacific Daylight 733, 822 |
ADT => [-1, 3, 0], ## (NA)Atlantic Daylight 733 |
| 203 |
PST => [-1, 8, 0], ## (NA)Pacific Standard 733, 822 |
CHST => [-1, 10, 0], ## Alaska-Hawaii Standard |
| 204 |
SET => [+1, 1, 0], ## Seychelles |
AST => [-1, 4, 0], ## (NA)Atlantic Standard 733 |
| 205 |
SST => [+1, 2, 0], ## Swedish Summer |
AT => [-1, 2, 0], ## Azores |
| 206 |
#SST => [+1, 7, 0], ## South Sumatra |
BDT => [-1, 10, 0], ## 733 |
| 207 |
SWT => [+1, 1, 0], ## Swedish Winter |
BST => [-1, 11, 0], ## 733 |
| 208 |
UKR => [+1, 2, 0], ## Ukraine |
#BST => [+1, 1, 0], ## British Summer |
| 209 |
UT => [+1, 0, 0], ## Universal Time 822 |
#BST => [-1, 3, 0], ## Brazil Standard |
| 210 |
UTC => [+1, 0, 0], ## Coordinated Universal Time |
BT => [+1, 3, 0], ## Baghdad |
| 211 |
WADT => [+1, 8, 0], ## West Australian Daylight |
CADT => [+1, 10, 30], ## Central Australian Daylight |
| 212 |
WAT => [-1, 0, 0], ## West Africa |
CAST => [+1, 9, 30], ## Central Australian Standard |
| 213 |
WET => [+1, 0, 0], ## Western European |
CAT => [-1, 10, 0], ## Central Alaska |
| 214 |
WST => [+1, 8, 0], ## West Australian Standard |
CCT => [+1, 8, 0], ## China Coast |
| 215 |
YDT => [-1, 8, 0], ## Yukon Daylight 733 |
CDT => [-1, 5, 0], ## (NA)Central Daylight 733, 822 |
| 216 |
YST => [-1, 9, 0], ## Yukon Standard 733 |
CET => [+1, 1, 0], ## Central European |
| 217 |
Z => [+1, 0, 0], ## 822, ISO 8601 |
CEST => [+1, 2, 0], ## Central European Daylight |
| 218 |
ZP4 => [+1, 4, 0], ## Z+4 |
CST => [-1, 6, 0], ## (NA)Central Standard 733, 822 |
| 219 |
ZP5 => [+1, 5, 0], ## Z+5 |
EADT => [+1, 11, 0], ## Eastern Australian Daylight |
| 220 |
ZP6 => [+1, 6, 0], ## Z+6 |
EADT => [+1, 10, 0], ## Eastern Australian Standard |
| 221 |
); |
ECT => [+1, 1, 0], ## Central European (French) |
| 222 |
|
EDT => [-1, 4, 0], ## (NA)Eastern Daylight 733, 822 |
| 223 |
## -use_military_zone => +1 / -1 / 0 |
EEST => [+1, 3, 0], ## Eastern European Summer |
| 224 |
## Whether military zone names are understood or not. |
EET => [+1, 2, 0], ## Eastern Europe 1947 |
| 225 |
## +1 Admits them and treats as standard value. (eg. "A" = +0100) |
EST => [-1, 5, 0], ## (NA)Eastern Standard 733, 822 |
| 226 |
## -1 Admits them but treats as negative value. (eg. "A" = -0100) |
EWT => [-1, 4, 0], ## U.S. Eastern War Time |
| 227 |
## 0 They are ignored and zone is set as -0000. (eg. "A" = -0000) |
FST => [+1, 2, 0], ## French Summer |
| 228 |
## Because of typo in BNF comment of RFCs 733 and 822, |
FWT => [+1, 1, 0], ## French Winter |
| 229 |
## quite a few implemention use these values incorrectly. |
GDT => [+1, 1, 0], ## 724 |
| 230 |
## As a result, these zone names carry no worthful information. |
GMT => [+1, 0, 0], ## Greenwich Mean 733, 822 |
| 231 |
## RFC 2822 recommends these names be taken as '-0000' (i.e. |
#GST => [-1, 3, 0], ## Greenland Standard |
| 232 |
## unknown zone). |
GST => [+1, 10, 0], ## Guam Standard |
| 233 |
|
HDT => [-1, 9, 0], ## Hawaii Daylight 733 |
| 234 |
sub _set_military_zone_name ($) { |
HKT => [+1, 8, 0], ## Hong Kong |
| 235 |
my $self = shift; |
HST => [-1, 10, 0], ## Hawaii Standard 733 |
| 236 |
my $mode = $self->{option}->{use_military_zone}; |
IDLE => [+1, 12, 0], ## International Date Line East |
| 237 |
my $i = 0; |
IDLW => [-1, 12, 0], ## International Date Line West |
| 238 |
if ($mode == 0) { |
IDT => [+1, 3, 0], |
| 239 |
for my $letter ('A'..'Y') {$ZONE{$letter} = [-1, 0, 0]} return; |
IST => [+1, 2, 0], ## Israel standard |
| 240 |
} |
#IST => [+1, 5, 30], ## Indian standard |
| 241 |
for my $letter ('Z', 'A'..'I', 'K'..'M') { |
IT => [+1, 3, 30], ## Iran |
| 242 |
$ZONE{$letter} = [+1*$mode, $i++, 0]; |
JST => [+1, 9, 0], ## Japan Central Standard |
| 243 |
} $i = 1; |
JT => [+1, 7, 30], ## Java |
| 244 |
for my $letter ('N'..'Y') { |
KDT => [+1, 10, 0], ## Korean Daylight |
| 245 |
$ZONE{$letter} = [-1*$mode, $i++, 0]; |
KST => [+1, 9, 0], ## Korean Standard |
| 246 |
} |
LCL => [-1, 0, 0], ## (unknown zone used by LSMTP) |
| 247 |
} |
LOCAL => [-1, 0, 0], ## local time zone |
| 248 |
|
LT => [-1, 0, 0], ## Luna Time [RFC 1607] |
| 249 |
sub _init ($;%) { |
MDT => [-1, 6, 0], ## (NA)Mountain Daylight 733, 822 |
| 250 |
my $self = shift; |
MET => [+1, 0, 0], ## Middle European |
| 251 |
my $DEFAULT = Message::Util::make_clone (\%DEFAULT); |
METDST => [+1, 2, 0], |
| 252 |
my %option = @_; |
MEST => [+1, 2, 0], ## Middle European Summer |
| 253 |
$self->SUPER::_init (%$DEFAULT, %option); |
MEWT => [+1, 0, 0], ## Middle European Winter |
| 254 |
$self->{date_time} = $option{unix} if defined $option{unix}; |
MEZ => [+1, 0, 0], ## Central European (German) |
| 255 |
$self->{secfrac} = $option{frac} if defined $option{frac}; |
MST => [-1, 7, 0], ## (NA)Mountain Standard 733, 822 |
| 256 |
unless (ref $self->{option}->{zone}) { |
MT => [-1, 0, 0], ## Mars Time [RFC 1607] |
| 257 |
my $zone = $self->{option}->{zone} || ''; #$main::ENV{TZ} || ''; |
NDT => [-1, 2, 30], ## Newfoundland Daylight |
| 258 |
## Since _zone_string_to_array does not provide full support |
NFT => [-1, 3, 30], ## Newfoundland Standard |
| 259 |
## of parsing TZ format (eg. daytime), not seeing it might be |
NST => [-1, 3, 30], ## Newfoundland Standard 733 |
| 260 |
## better way. |
#NST => [-1, 6, 30], ## North Sumatra |
| 261 |
if (length $zone) { |
NT => [-1, 11, 0], ## Nome |
| 262 |
$self->{option}->{zone} = [ $self->_zone_string_to_array ($zone) ]; |
NZD => [+1, 13, 0], ## New Zealand Daylight |
| 263 |
} else { |
NZT => [+1, 12, 0], ## New Zealand |
| 264 |
my $time = time; |
NZDT => [+1, 13, 0], ## New Zealand Daylight |
| 265 |
my $ltime = timegm_nocheck (localtime ($time)); |
NZST => [+1, 12, 0], ## New Zealand Standard |
| 266 |
my $o = int ( ($ltime - $time) / 60); |
PDT => [-1, 7, 0], ## (NA)Pacific Daylight 733, 822 |
| 267 |
my @zone; |
PST => [-1, 8, 0], ## (NA)Pacific Standard 733, 822 |
| 268 |
$zone[2] = $o % 60; $o = int ( $o / 60 ); |
SET => [+1, 1, 0], ## Seychelles |
| 269 |
$zone[1] = $o % 24; |
SST => [+1, 2, 0], ## Swedish Summer |
| 270 |
$zone[0] = $o >= 0 ? +1 : -1; |
#SST => [+1, 7, 0], ## South Sumatra |
| 271 |
$self->{option}->{zone} = \@zone; |
SWT => [+1, 1, 0], ## Swedish Winter |
| 272 |
} |
UKR => [+1, 2, 0], ## Ukraine |
| 273 |
} |
UT => [+1, 0, 0], ## Universal Time 822 |
| 274 |
|
UTC => [+1, 0, 0], ## Coordinated Universal Time |
| 275 |
my $format = $self->{option}->{format}; |
WADT => [+1, 8, 0], ## West Australian Daylight |
| 276 |
if ($format =~ /mail-rfc2822/) { |
WAT => [-1, 0, 0], ## West Africa |
| 277 |
$self->{option}->{use_military_zone} = 0; |
WET => [+1, 0, 0], ## Western European |
| 278 |
} |
WST => [+1, 8, 0], ## West Australian Standard |
| 279 |
|
YDT => [-1, 8, 0], ## Yukon Daylight 733 |
| 280 |
$self->_set_military_zone_name; |
YST => [-1, 9, 0], ## Yukon Standard 733 |
| 281 |
} |
Z => [+1, 0, 0], ## 822, ISO 8601 |
| 282 |
|
ZP4 => [+1, 4, 0], ## Z+4 |
| 283 |
=item $date = Message::Field::Date->new ([%options]) |
ZP5 => [+1, 5, 0], ## Z+5 |
| 284 |
|
ZP6 => [+1, 6, 0], ## Z+6 |
| 285 |
Constructs a new object. You might pass some options as parameters |
); |
| 286 |
to the constructor. |
|
| 287 |
|
## -use_military_zone => +1 / -1 / 0 |
| 288 |
=cut |
## Whether military zone names are understood or not. |
| 289 |
|
## +1 Admits them and treats as standard value. (eg. "A" = +0100) |
| 290 |
## Inherited |
## -1 Admits them but treats as negative value. (eg. "A" = -0100) |
| 291 |
|
## 0 They are ignored and zone is set as -0000. (eg. "A" = -0000) |
| 292 |
=item $date = Message::Field::Date->parse ($field-body, [%options]) |
## Because of typo in BNF comment of RFCs 733 and 822, |
| 293 |
|
## quite a few implemention use these values incorrectly. |
| 294 |
Constructs a new object with given field body. You might pass |
## As a result, these zone names carry no worthful information. |
| 295 |
some options as parameters to the constructor. |
## RFC 2822 recommends these names be taken as '-0000' (i.e. |
| 296 |
|
## unknown zone). |
| 297 |
=cut |
|
| 298 |
|
sub _set_military_zone_name ($) { |
| 299 |
sub parse ($$;%) { |
my $self = shift; |
| 300 |
my $class = shift; |
my $mode = $self->{option}->{use_military_zone}; |
| 301 |
my $self = bless {}, $class; |
my $i = 0; |
| 302 |
my $body = shift; |
if ($mode == 0) { |
| 303 |
$self->_init (@_); |
for my $letter ('A'..'Y') {$ZONE{$letter} = [-1, 0, 0]} return; |
| 304 |
($body, @{$self->{comment}}) |
} |
| 305 |
= $self->Message::Util::delete_comment_to_array ($body) |
for my $letter ('Z', 'A'..'I', 'K'..'M') { |
| 306 |
if $self->{option}->{use_comment}; |
$ZONE{$letter} = [+1*$mode, $i++, 0]; |
| 307 |
$body =~ s/^$REG{WSP}+//; $body =~ s/$REG{WSP}+$//; |
} $i = 1; |
| 308 |
if ($self->{option}->{date_format} eq 'unix') { |
for my $letter ('N'..'Y') { |
| 309 |
$self->{date_time} = int ($body); |
$ZONE{$letter} = [-1*$mode, $i++, 0]; |
| 310 |
} elsif (!$body) { |
} |
| 311 |
return $self; |
} |
| 312 |
} elsif ($body =~ /^$REG{M_dt_rfc822}$/x) { |
|
| 313 |
my ($day, $month, $year, $hour, $minute, $second, $zone) |
sub _init ($;%) { |
| 314 |
= ($1, uc $2, $3, $4, $5, $6, uc $7); |
my $self = shift; |
| 315 |
$month = $MONTH{$month} || 1; |
my $DEFAULT = Message::Util::make_clone (\%DEFAULT); |
| 316 |
$year = $self->_obvious_year ($year) if length($year)<4; |
my %option = @_; |
| 317 |
my ($zone_sign, $zone_hour, $zone_minute) = $self->_zone_string_to_array ($zone); |
$self->SUPER::_init (%$DEFAULT, %option); |
| 318 |
eval '$self->{date_time} = timegm_nocheck |
$self->{date_time} = $option{unix} if defined $option{unix}; |
| 319 |
($second, $minute-($zone_sign*$zone_minute), $hour-($zone_sign*$zone_hour), |
$self->{secfrac} = $option{frac} if defined $option{frac}; |
| 320 |
$day, $month-1, $year);'; |
unless (ref $self->{option}->{zone}) { |
| 321 |
$self->{secfrac} = ''; |
my $zone = $self->{option}->{zone} || ''; #$main::ENV{TZ} || ''; |
| 322 |
$self->{option}->{zone} = [$zone_sign, $zone_hour, $zone_minute]; |
## Since _zone_string_to_array does not provide full support |
| 323 |
} elsif ($body =~ /^$REG{M_dt_rfc3339}$/x) { |
## of parsing TZ format (eg. daytime), not seeing it might be |
| 324 |
my ($year,$month,$day,$hour,$minute,$second,$secfrac,$zone) |
## better way. |
| 325 |
= ($1, $2, $3, $4, $5, $6, $7, $8); |
if (length $zone) { |
| 326 |
my ($zone_sign, $zone_hour, $zone_minute) = $self->_zone_string_to_array ($zone); |
$self->{option}->{zone} = [ $self->_zone_string_to_array ($zone) ]; |
| 327 |
eval '$self->{date_time} = timegm_nocheck |
} else { |
| 328 |
($second, $minute-($zone_sign*$zone_minute), $hour-($zone_sign*$zone_hour), |
my $time = time; |
| 329 |
$day, $month-1, $year);'; |
my $ltime = timegm_nocheck (localtime ($time)); |
| 330 |
$self->{secfrac} = $secfrac; |
my $o = int ( ($ltime - $time) / 60); |
| 331 |
$self->{option}->{zone} = [$zone_sign, $zone_hour, $zone_minute]; |
my @zone; |
| 332 |
} elsif ($body =~ /^$REG{M_dt_rfc733}$/x) { |
$zone[2] = $o % 60; $o = int ( $o / 60 ); |
| 333 |
my ($day, $month, $year, $hour, $minute, $second, $zone) |
$zone[1] = $o % 24; |
| 334 |
= ($1, uc $2, $3, $4, $5, $6, uc $7); |
$zone[0] = $o >= 0 ? +1 : -1; |
| 335 |
$month = $MONTH{$month} || 1; |
$self->{option}->{zone} = \@zone; |
| 336 |
$year = $self->_obvious_year ($year) if length($year)<4; |
} |
| 337 |
my ($zone_sign, $zone_hour, $zone_minute) = $self->_zone_string_to_array ($zone); |
} |
| 338 |
eval '$self->{date_time} = timegm_nocheck |
|
| 339 |
($second, $minute-($zone_sign*$zone_minute), $hour-($zone_sign*$zone_hour), |
my $format = $self->{option}->{format}; |
| 340 |
$day, $month-1, $year);'; |
if ($format =~ /mail-rfc2822/) { |
| 341 |
$self->{secfrac} = ''; |
$self->{option}->{use_military_zone} = 0; |
| 342 |
$self->{option}->{zone} = [$zone_sign, $zone_hour, $zone_minute]; |
} |
| 343 |
} elsif ($body =~ /^$REG{M_dt_rfc724}$/x) { |
|
| 344 |
my ($month, $day, $year, $hour, $minute, $second, $zone) |
$self->_set_military_zone_name; |
| 345 |
= ($1, $2, $3, $4, $5, $6, uc $7); |
} |
| 346 |
$year = $self->_obvious_year ($year) if length($year)<4; |
|
| 347 |
my ($zone_sign, $zone_hour, $zone_minute) = $self->_zone_string_to_array ($zone); |
=item $date = Message::Field::Date->new ([%options]) |
| 348 |
eval '$self->{date_time} = timegm_nocheck |
|
| 349 |
($second, $minute-($zone_sign*$zone_minute), $hour-($zone_sign*$zone_hour), |
Constructs a new object. You might pass some options as parameters |
| 350 |
$day, $month-1, $year);'; |
to the constructor. |
| 351 |
$self->{secfrac} = ''; |
|
| 352 |
$self->{option}->{zone} = [$zone_sign, $zone_hour, $zone_minute]; |
=cut |
| 353 |
#} elsif ($body =~ /^[0-9]+$/) { |
|
| 354 |
# $self->{date_time} = $&; |
## Inherited |
| 355 |
} else { |
|
| 356 |
## From HTTP::Date (revision 1.40) by Gisle Aas |
=item $date = Message::Field::Date->parse ($field-body, [%options]) |
| 357 |
#$body =~ s/^\s+//; # kill leading space |
|
| 358 |
$body =~ s/^(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat)[a-z]*,?\s*//i; # Useless weekday |
Constructs a new object with given field body. You might pass |
| 359 |
my ($day, $month, $year, $hour, $minute, $second); |
some options as parameters to the constructor. |
| 360 |
my ($secfrac, $zone, $ampm) = ('', $self->{option}->{zone_default_string}); |
|
| 361 |
|
=cut |
| 362 |
# Then we are able to check for most of the formats with this regexp |
|
| 363 |
(($day,$month,$year,$hour,$minute,$second,$zone) = |
sub parse ($$;%) { |
| 364 |
$body =~ m"^ |
my $class = shift; |
| 365 |
(\d\d?) # day |
my $self = bless {}, $class; |
| 366 |
(?:\s+|[-\/]) |
my $body = shift; |
| 367 |
(\w+) # month |
$self->_init (@_); |
| 368 |
(?:\s+|[-\/]) |
($body, @{$self->{comment}}) |
| 369 |
(\d+) # year |
= $self->Message::Util::delete_comment_to_array ($body) |
| 370 |
(?: |
if $self->{option}->{use_comment}; |
| 371 |
(?:\s+|:) # separator before clock |
$body =~ s/^$REG{WSP}+//; $body =~ s/$REG{WSP}+$//; |
| 372 |
(\d\d?):(\d\d) # hour:min |
if ($self->{option}->{date_format} eq 'unix') { |
| 373 |
(?::(\d\d))? # optional seconds |
$self->{date_time} = int ($body); |
| 374 |
)? # optional clock |
} elsif (!$body) { |
| 375 |
\s* |
return $self; |
| 376 |
([-+]?\d{2,4}|(?![APap][Mm]\b)[A-Za-z]+)? # timezone |
} elsif ($body =~ /^$REG{M_dt_rfc822}$/x) { |
| 377 |
$"x) |
my ($day, $month, $year, $hour, $minute, $second, $zone) |
| 378 |
|
= ($1, uc $2, $3, $4, $5, $6, uc $7); |
| 379 |
|| |
$month = $MONTH{$month} || 1; |
| 380 |
|
$year = $self->_obvious_year ($year) if length($year)<4; |
| 381 |
# Try the ctime and asctime format |
my ($zone_sign, $zone_hour, $zone_minute) = $self->_zone_string_to_array ($zone); |
| 382 |
(($month, $day, $hour, $minute, $second, $zone, $year) = |
eval '$self->{date_time} = timegm_nocheck |
| 383 |
$body =~ m"^ |
($second, $minute-($zone_sign*$zone_minute), $hour-($zone_sign*$zone_hour), |
| 384 |
(\w{1,3}) # month |
$day, $month-1, $year);'; |
| 385 |
\s+ |
$self->{secfrac} = ''; |
| 386 |
(\d\d?) # day |
$self->{option}->{zone} = [$zone_sign, $zone_hour, $zone_minute]; |
| 387 |
\s+ |
} elsif ($body =~ /^$REG{M_dt_rfc3339}$/x) { |
| 388 |
(\d\d?):(\d\d) # hour:min |
my ($year,$month,$day,$hour,$minute,$second,$secfrac,$zone) |
| 389 |
(?::(\d\d))? # optional seconds |
= ($1, $2, $3, $4, $5, $6, $7, $8); |
| 390 |
\s+ |
my ($zone_sign, $zone_hour, $zone_minute) = $self->_zone_string_to_array ($zone); |
| 391 |
(?:([A-Za-z]+)\s+)? # optional timezone |
eval '$self->{date_time} = timegm_nocheck |
| 392 |
(\d+) # year |
($second, $minute-($zone_sign*$zone_minute), $hour-($zone_sign*$zone_hour), |
| 393 |
$"x) |
$day, $month-1, $year);'; |
| 394 |
|
$self->{secfrac} = $secfrac; |
| 395 |
|| |
$self->{option}->{zone} = [$zone_sign, $zone_hour, $zone_minute]; |
| 396 |
|
} elsif ($body =~ /^$REG{M_dt_rfc733}$/x) { |
| 397 |
# Then the Unix 'ls -l' date format |
my ($day, $month, $year, $hour, $minute, $second, $zone) |
| 398 |
(($month, $day, $year, $hour, $minute, $second) = |
= ($1, uc $2, $3, $4, $5, $6, uc $7); |
| 399 |
$body =~ m"^ |
$month = $MONTH{$month} || 1; |
| 400 |
(\w{3}) # month |
$year = $self->_obvious_year ($year) if length($year)<4; |
| 401 |
\s+ |
my ($zone_sign, $zone_hour, $zone_minute) = $self->_zone_string_to_array ($zone); |
| 402 |
(\d\d?) # day |
eval '$self->{date_time} = timegm_nocheck |
| 403 |
\s+ |
($second, $minute-($zone_sign*$zone_minute), $hour-($zone_sign*$zone_hour), |
| 404 |
(?: |
$day, $month-1, $year);'; |
| 405 |
(\d\d\d\d) | # year |
$self->{secfrac} = ''; |
| 406 |
(\d{1,2}):(\d{2}) # hour:min |
$self->{option}->{zone} = [$zone_sign, $zone_hour, $zone_minute]; |
| 407 |
(?::(\d\d))? # optional seconds |
} elsif ($body =~ /^$REG{M_dt_rfc724}$/x) { |
| 408 |
) |
my ($month, $day, $year, $hour, $minute, $second, $zone) |
| 409 |
$"x) |
= ($1, $2, $3, $4, $5, $6, uc $7); |
| 410 |
|
$year = $self->_obvious_year ($year) if length($year)<4; |
| 411 |
|| |
my ($zone_sign, $zone_hour, $zone_minute) = $self->_zone_string_to_array ($zone); |
| 412 |
|
eval '$self->{date_time} = timegm_nocheck |
| 413 |
# ISO 8601 format '1996-02-29 12:00:00 -0100' and variants |
($second, $minute-($zone_sign*$zone_minute), $hour-($zone_sign*$zone_hour), |
| 414 |
(($year, $month, $day, $hour, $minute, $second, $secfrac, $zone) = |
$day, $month-1, $year);'; |
| 415 |
$body =~ m"^ |
$self->{secfrac} = ''; |
| 416 |
(\d{4}) # year |
$self->{option}->{zone} = [$zone_sign, $zone_hour, $zone_minute]; |
| 417 |
[-\/]? |
#} elsif ($body =~ /^[0-9]+$/) { |
| 418 |
(\d\d?) # numerical month |
# $self->{date_time} = $&; |
| 419 |
[-\/]? |
} else { |
| 420 |
(\d\d?) # day |
## From HTTP::Date (revision 1.40) by Gisle Aas |
| 421 |
(?: |
#$body =~ s/^\s+//; # kill leading space |
| 422 |
(?:\s+|[-:Tt]) # separator before clock |
$body =~ s/^(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat)[a-z]*,?\s*//i; # Useless weekday |
| 423 |
(\d\d?):?(\d\d) # hour:min |
my ($day, $month, $year, $hour, $minute, $second); |
| 424 |
(?: |
my ($secfrac, $zone, $ampm) = ('', $self->{option}->{zone_default_string}); |
| 425 |
:? |
|
| 426 |
(\d\d) |
# Then we are able to check for most of the formats with this regexp |
| 427 |
(?:\.?(\d+))? ## optional second frac. |
(($day,$month,$year,$hour,$minute,$second,$zone) = |
| 428 |
)? # optional seconds |
$body =~ m"^ |
| 429 |
)? # optional clock |
(\d\d?) # day |
| 430 |
\s* |
(?:\s+|[-\/]) |
| 431 |
([-+]?\d\d?:?(:?\d\d)? |
(\w+) # month |
| 432 |
|Z|z)? # timezone (Z is 'zero meridian', i.e. GMT) |
(?:\s+|[-\/]) |
| 433 |
|
(\d+) # year |
| 434 |
$"x) |
(?: |
| 435 |
|
(?:\s+|:) # separator before clock |
| 436 |
|| |
(\d\d?):(\d\d) # hour:min |
| 437 |
|
(?::(\d\d))? # optional seconds |
| 438 |
# ISO 8601 like format '96-02-29 2:0:0 -0100' and variants |
)? # optional clock |
| 439 |
(($year, $month, $day, $hour, $minute, $second, $secfrac, $zone) = |
\s* |
| 440 |
$body =~ m"^ |
([-+]?\d{2,4}|(?![APap][Mm]\b)[A-Za-z]+)? # timezone |
| 441 |
(\d+) # year |
$"x) |
| 442 |
[-/] |
|
| 443 |
(\d\d?) # numerical month |
|| |
| 444 |
[-/] |
|
| 445 |
(\d\d?) # day |
# Try the ctime and asctime format |
| 446 |
(?: |
(($month, $day, $hour, $minute, $second, $zone, $year) = |
| 447 |
(?:\s+|[-:Tt]) # separator before clock |
$body =~ m"^ |
| 448 |
(\d\d?):(\d+) # hour:min |
(\w{1,3}) # month |
| 449 |
(?: |
\s+ |
| 450 |
: |
(\d\d?) # day |
| 451 |
(\d+) |
\s+ |
| 452 |
(?:\.(\d+)) ## optional second frac. |
(\d\d?):(\d\d) # hour:min |
| 453 |
)? # optional seconds |
(?::(\d\d))? # optional seconds |
| 454 |
)? # optional clock |
\s+ |
| 455 |
\s* |
(?:([A-Za-z]+)\s+)? # optional timezone |
| 456 |
([-+]?\d+(:\d+)? |
(\d+) # year |
| 457 |
|Z|z)? # timezone (Z is 'zero meridian', i.e. GMT) |
$"x) |
| 458 |
|
|
| 459 |
$"x) |
|| |
| 460 |
|
|
| 461 |
|| |
# Then the Unix 'ls -l' date format |
| 462 |
|
(($month, $day, $year, $hour, $minute, $second) = |
| 463 |
# Windows 'dir' 11-12-96 03:52PM |
$body =~ m"^ |
| 464 |
(($month, $day, $year, $hour, $minute, $ampm) = |
(\w{3}) # month |
| 465 |
$body =~ m"^ |
\s+ |
| 466 |
(\d{2}) # numerical month |
(\d\d?) # day |
| 467 |
- |
\s+ |
| 468 |
(\d{2}) # day |
(?: |
| 469 |
- |
(\d\d\d\d) | # year |
| 470 |
(\d{2}) # year |
(\d{1,2}):(\d{2}) # hour:min |
| 471 |
\s+ |
(?::(\d\d))? # optional seconds |
| 472 |
(\d\d?):(\d\d)([APap][Mm]) # hour:min AM or PM |
) |
| 473 |
$"x) |
$"x) |
| 474 |
|
|
| 475 |
#|| |
|| |
| 476 |
#return; # unrecognized format |
|
| 477 |
; |
# ISO 8601 format '1996-02-29 12:00:00 -0100' and variants |
| 478 |
|
(($year, $month, $day, $hour, $minute, $second, $secfrac, $zone) = |
| 479 |
$day ||= 1; |
$body =~ m"^ |
| 480 |
# Translate month name to number |
(\d{4}) # year |
| 481 |
$month ||= 1; |
[-\/]? |
| 482 |
$month = $MONTH{uc $month} |
(\d\d?) # numerical month |
| 483 |
|| int ($month); |
[-\/]? |
| 484 |
|
(\d\d?) # day |
| 485 |
# If the year is missing, we assume first date before the current, |
(?: |
| 486 |
# because of the formats we support such dates are mostly present |
(?:\s+|[-:Tt]) # separator before clock |
| 487 |
# on "ls -l" listings. |
(\d\d?):?(\d\d) # hour:min |
| 488 |
unless (defined $year) { |
(?: |
| 489 |
my $cur_mon; |
:? |
| 490 |
($cur_mon, $year) = (localtime)[4, 5]; |
(\d\d) |
| 491 |
$year += 1900; $cur_mon++; |
(?:\.?(\d+))? ## optional second frac. |
| 492 |
$year-- if $month > $cur_mon; |
)? # optional seconds |
| 493 |
} elsif (length($year) < 3) { |
)? # optional clock |
| 494 |
$year = $self->_obvious_year ($year); |
\s* |
| 495 |
} |
([-+]?\d\d?:?(:?\d\d)? |
| 496 |
|
|Z|z)? # timezone (Z is 'zero meridian', i.e. GMT) |
| 497 |
# Make sure clock elements are defined |
|
| 498 |
$hour = 0 unless defined($hour); |
$"x) |
| 499 |
$minute = 0 unless defined($minute); |
|
| 500 |
$second = 0 unless defined($second); |
|| |
| 501 |
|
|
| 502 |
# Compensate for AM/PM |
# ISO 8601 like format '96-02-29 2:0:0 -0100' and variants |
| 503 |
if ($ampm) { |
(($year, $month, $day, $hour, $minute, $second, $secfrac, $zone) = |
| 504 |
$ampm = uc $ampm; |
$body =~ m"^ |
| 505 |
$hour = 0 if $hour == 12 && $ampm eq 'AM'; |
(\d+) # year |
| 506 |
$hour += 12 if $ampm eq 'PM' && $hour != 12; |
[-/] |
| 507 |
} |
(\d\d?) # numerical month |
| 508 |
|
[-/] |
| 509 |
my ($zone_sign, $zone_hour, $zone_minute) = $self->_zone_string_to_array ($zone); |
(\d\d?) # day |
| 510 |
eval '$self->{date_time} = timegm_nocheck |
(?: |
| 511 |
($second, $minute-($zone_sign*$zone_minute), $hour-($zone_sign*$zone_hour), |
(?:\s+|[-:Tt]) # separator before clock |
| 512 |
$day, $month-1, $year);'; |
(\d\d?):(\d+) # hour:min |
| 513 |
$self->{secfrac} = $secfrac; |
(?: |
| 514 |
$self->{option}->{zone} = [$zone_sign, $zone_hour, $zone_minute]; |
: |
| 515 |
} |
(\d+) |
| 516 |
$self; |
(?:\.(\d+)) ## optional second frac. |
| 517 |
} |
)? # optional seconds |
| 518 |
|
)? # optional clock |
| 519 |
sub zone ($;$) { |
\s* |
| 520 |
my $self = shift; |
([-+]?\d+(:\d+)? |
| 521 |
my $newzone = shift; |
|Z|z)? # timezone (Z is 'zero meridian', i.e. GMT) |
| 522 |
if (ref $newzone) { |
|
| 523 |
$self->{option}->{zone} = $newzone; |
$"x) |
| 524 |
} elsif (length $newzone) { |
|
| 525 |
$self->{option}->{zone} = [$self->_zone_string_to_array ($newzone)]; |
|| |
| 526 |
} |
|
| 527 |
$self->{option}->{zone}; |
# Windows 'dir' 11-12-96 03:52PM |
| 528 |
} |
(($month, $day, $year, $hour, $minute, $ampm) = |
| 529 |
|
$body =~ m"^ |
| 530 |
## Find "obvious" year |
(\d{2}) # numerical month |
| 531 |
sub _obvious_year ($$) { |
- |
| 532 |
my $self = shift; |
(\d{2}) # day |
| 533 |
my $year = shift; |
- |
| 534 |
if ($self->{option}->{format} =~ /mail|news/) { |
(\d{2}) # year |
| 535 |
## RFC 2822 |
\s+ |
| 536 |
if ( 0 <=$year && $year < 50) {$year += 2000} |
(\d\d?):(\d\d)([APap][Mm]) # hour:min AM or PM |
| 537 |
elsif (50 < $year && $year < 1000) {$year += 1900} |
$"x) |
| 538 |
} else { |
|
| 539 |
## RFC 2616 |
#|| |
| 540 |
my $cur_yr = (localtime)[5] + 1900; |
#return; # unrecognized format |
| 541 |
my $m = $cur_yr % 100; |
; |
| 542 |
my $tmp = $year; |
|
| 543 |
$year += $cur_yr - $m; |
$day ||= 1; |
| 544 |
$m -= $tmp; |
# Translate month name to number |
| 545 |
$year += ($m > 0) ? 100 : -100 if abs($m) > 50; |
$month ||= 1; |
| 546 |
} |
$month = $MONTH{uc $month} |
| 547 |
$year; |
|| int ($month); |
| 548 |
} |
|
| 549 |
|
# If the year is missing, we assume first date before the current, |
| 550 |
=back |
# because of the formats we support such dates are mostly present |
| 551 |
|
# on "ls -l" listings. |
| 552 |
=head1 METHODS |
unless (defined $year) { |
| 553 |
|
my $cur_mon; |
| 554 |
=over 4 |
($cur_mon, $year) = (localtime)[4, 5]; |
| 555 |
|
$year += 1900; $cur_mon++; |
| 556 |
|
$year-- if $month > $cur_mon; |
| 557 |
=head2 $self->unix_time ([$new_time]) |
} elsif (length($year) < 3) { |
| 558 |
|
$year = $self->_obvious_year ($year); |
| 559 |
Returns or set the unix-time (seconds from the Epoch). |
} |
| 560 |
|
|
| 561 |
=cut |
# Make sure clock elements are defined |
| 562 |
|
$hour = 0 unless defined($hour); |
| 563 |
sub unix_time ($;$) { |
$minute = 0 unless defined($minute); |
| 564 |
my $self = shift; |
$second = 0 unless defined($second); |
| 565 |
my $new_time = shift; |
|
| 566 |
if (defined $new_time) { |
# Compensate for AM/PM |
| 567 |
$self->{date_time} = $new_time + 0; |
if ($ampm) { |
| 568 |
} |
$ampm = uc $ampm; |
| 569 |
$self->{date_time}; |
$hour = 0 if $hour == 12 && $ampm eq 'AM'; |
| 570 |
} |
$hour += 12 if $ampm eq 'PM' && $hour != 12; |
| 571 |
|
} |
| 572 |
sub set_datetime ($@) { |
|
| 573 |
my $self = shift; |
my ($zone_sign, $zone_hour, $zone_minute) = $self->_zone_string_to_array ($zone); |
| 574 |
my ($year,$month,$day,$hour,$minute,$second,%misc) = @_; |
eval '$self->{date_time} = timegm_nocheck |
| 575 |
my ($zone_sign, $zone_hour, $zone_minute) |
($second, $minute-($zone_sign*$zone_minute), $hour-($zone_sign*$zone_hour), |
| 576 |
= $self->_zone_string_to_array ($misc{zone}); |
$day, $month-1, $year);'; |
| 577 |
eval '$self->{date_time} = timegm_nocheck |
$self->{secfrac} = $secfrac; |
| 578 |
($second, $minute-($zone_sign*$zone_minute), $hour-($zone_sign*$zone_hour), |
$self->{option}->{zone} = [$zone_sign, $zone_hour, $zone_minute]; |
| 579 |
$day, $month-1, $year);'; |
} |
| 580 |
$self->{secfrac} = $misc{secfrac}; |
$self; |
| 581 |
$self->{option}->{zone} = [$zone_sign, $zone_hour, $zone_minute]; |
} |
| 582 |
} |
|
| 583 |
|
sub zone ($;$) { |
| 584 |
=head2 $self->second_fraction ([$new_fraction]) |
my $self = shift; |
| 585 |
|
my $newzone = shift; |
| 586 |
Returns or set the decimal fraction of a second. |
if (ref $newzone) { |
| 587 |
Value is a string containing of only [0-9] |
$self->{option}->{zone} = $newzone; |
| 588 |
or empty string. |
} elsif (length $newzone) { |
| 589 |
|
$self->{option}->{zone} = [$self->_zone_string_to_array ($newzone)]; |
| 590 |
Note that this implemention is temporary and in the near future |
} |
| 591 |
it can be changed. |
$self->{option}->{zone}; |
| 592 |
|
} |
| 593 |
=cut |
|
| 594 |
|
## Find "obvious" year |
| 595 |
sub second_fraction ($;$) { |
sub _obvious_year ($$) { |
| 596 |
my $self = shift; |
my $self = shift; |
| 597 |
my $new_fraction = shift; |
my $year = shift; |
| 598 |
if (defined $new_fraction) { |
if ($self->{option}->{format} =~ /mail|news/) { |
| 599 |
$self->{secfrac} = $new_fraction unless $new_fraction =~ /[^0-9]/; |
## RFC 2822 |
| 600 |
} |
if ( 0 <=$year && $year < 50) {$year += 2000} |
| 601 |
$self->{secfrac}; |
elsif (50 < $year && $year < 1000) {$year += 1900} |
| 602 |
} |
} else { |
| 603 |
|
## RFC 2616 |
| 604 |
=item $field-body = $date->stringify () |
my $cur_yr = (localtime)[5] + 1900; |
| 605 |
|
my $m = $cur_yr % 100; |
| 606 |
Returns C<field-body> as a string. |
my $tmp = $year; |
| 607 |
|
$year += $cur_yr - $m; |
| 608 |
=cut |
$m -= $tmp; |
| 609 |
|
$year += ($m > 0) ? 100 : -100 if abs($m) > 50; |
| 610 |
sub stringify ($;%) { |
} |
| 611 |
my $self = shift; |
$year; |
| 612 |
my %o = @_; |
} |
| 613 |
my %option = %{$self->{option}}; |
|
| 614 |
for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}} |
=back |
| 615 |
unless ($option{format_template}) { |
|
| 616 |
if ($option{format} =~ /mail-rfc2822|news-usefor|mail-rfc822\+rfc1123|news-son-of-rfc1036|mime/) { |
=head1 METHODS |
| 617 |
$option{format_template} = '%Wdy(local);, %DD(local); %Mon(local); %YYYY(local); %HH(local);:%TT(local);:%SS(local); %zsign;%zHH;%zTT;'; |
|
| 618 |
} elsif ($option{format} =~ /http/) { |
=over 4 |
| 619 |
$option{format_template} = '%Wdy;, %DD; %Mon; %YYYY; %HH;:%TT;:%SS; GMT'; |
|
| 620 |
} elsif ($option{format} =~ /mail-rfc822|news-rfc1036/) { |
|
| 621 |
$option{format_template} = '%Wdy(local);, %DD(local); %Mon(local); %YY(local); (%YYYY(local);) %HH(local);:%TT(local);:%SS(local); %zsign;%zHH;%zTT;'; |
=head2 $self->unix_time ([$new_time]) |
| 622 |
} elsif ($option{format} =~ /news-rfc850/) { |
|
| 623 |
$option{format_template} = '%Weekday;, %DD;-%Mon;-%YY; %HH;:%TT;:%SS; GMT'; |
Returns or set the unix-time (seconds from the Epoch). |
| 624 |
} elsif ($option{format} =~ /asctime/) { |
|
| 625 |
$option{format_template} = '%Wdy; %Mon; %DD(pad=>SP); %HH;:%MM;:%SS; %YYYY;'; |
=cut |
| 626 |
#} elsif ($option{format} =~ /date\(1\)/) { |
|
| 627 |
# $option{format_template} = '%Wdy; %Mon; %DD(pad=>SP); %HH;:%MM;:%SS; GMT %YYYY;'; |
sub unix_time ($;$) { |
| 628 |
} elsif ($option{format} =~ /un[i*]x/) { ## ;-) |
my $self = shift; |
| 629 |
$option{format_template} = '%unix;'; |
my $new_time = shift; |
| 630 |
} else { ## RFC 3339 (IETF's ISO 8601) |
if (defined $new_time) { |
| 631 |
$option{format_template} = '%YYYY(local);-%MM(local);-%DD(local);T%HH(local);:%TT(local);:%SS(local);%frac(prefix=>.);%zsign;%zHH;:%zTT;'; |
$self->{date_time} = $new_time + 0; |
| 632 |
} |
} |
| 633 |
} |
$self->{date_time}; |
| 634 |
$self->_date2str (\%option) |
} |
| 635 |
. (($option{output_comment} && @{$self->{comment}} > 0)? |
|
| 636 |
' ' . $self->_comment_stringify: ''); |
sub set_datetime ($@) { |
| 637 |
} |
my $self = shift; |
| 638 |
*as_string = \&stringify; |
my ($year,$month,$day,$hour,$minute,$second,%misc) = @_; |
| 639 |
*as_plain_string = \&stringify; |
my ($zone_sign, $zone_hour, $zone_minute) |
| 640 |
## You should use stringify instead of as_rfc2822_time |
= $self->_zone_string_to_array ($misc{zone}); |
| 641 |
sub as_rfc2822_time ($@) { |
eval '$self->{date_time} = timegm_nocheck |
| 642 |
shift->stringify (-format => 'mail-rfc2822', @_); |
($second, $minute-($zone_sign*$zone_minute), $hour-($zone_sign*$zone_hour), |
| 643 |
} |
$day, $month-1, $year);'; |
| 644 |
|
$self->{secfrac} = $misc{secfrac}; |
| 645 |
sub _date2str ($\%\%) { |
$self->{option}->{zone} = [$zone_sign, $zone_hour, $zone_minute]; |
| 646 |
my $self = shift; |
} |
| 647 |
my $option = shift; |
|
| 648 |
my $gparam = shift; |
=head2 $self->second_fraction ([$new_fraction]) |
| 649 |
my $template = $option->{format_template}; |
|
| 650 |
my $time = $self->{date_time}; |
Returns or set the decimal fraction of a second. |
| 651 |
$time = $option->{date_time} if defined $option->{date_time}; |
Value is a string containing of only [0-9] |
| 652 |
my $zone = $option->{zone}; |
or empty string. |
| 653 |
if (ref $zone) { } |
|
| 654 |
elsif (length $zone) {$zone = [$self->_zone_string_to_array ($zone)]} |
Note that this implemention is temporary and in the near future |
| 655 |
my $l_time = $time + $zone->[0] * ($zone->[1] * 60 + $zone->[2]) * 60; |
it can be changed. |
| 656 |
my %time = (unix => $time, |
|
| 657 |
tm => [gmtime ($time)], |
=cut |
| 658 |
l_unix => $l_time, |
|
| 659 |
l_tm => [gmtime ($l_time)], |
sub second_fraction ($;$) { |
| 660 |
zone => $zone); |
my $self = shift; |
| 661 |
$template =~ s{%([A-Za-z0-9_]+)(?:\(([A-Za-z0-9,.:\x09\x20=>_-]*)\))?;}{ |
my $new_fraction = shift; |
| 662 |
my ($f, $a) = ($1, $2); |
if (defined $new_fraction) { |
| 663 |
my $function = $option->{fmt2str}->{$f}; |
$self->{secfrac} = $new_fraction unless $new_fraction =~ /[^0-9]/; |
| 664 |
if (ref $function) { |
} |
| 665 |
my %a; |
$self->{secfrac}; |
| 666 |
for (split /[\x09\x20]*,[\x09\x20]*/, $a) { |
} |
| 667 |
if (/^([^=]+)=>(.+)$/) {$a{$1} = $2} |
|
| 668 |
else {$a{$_} = 1} |
=item $field-body = $date->stringify () |
| 669 |
} |
|
| 670 |
$a{_prefix} = $a{local}? 'l_': ''; |
Returns C<field-body> as a string. |
| 671 |
$a{_fmt} = $a{pad} eq 'SP'? '%2d': |
|
| 672 |
$a{pad} eq 'none'? '%d': |
=cut |
| 673 |
'%02d'; |
|
| 674 |
my $r = &$function ($self, \%time, \%a, $gparam); |
sub stringify ($;%) { |
| 675 |
length $r? $a{prefix}.$r.$a{suffix}: ''; |
my $self = shift; |
| 676 |
} elsif (length $function) { |
my %o = @_; |
| 677 |
$function; |
my %option = %{$self->{option}}; |
| 678 |
} else { |
for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}} |
| 679 |
"[$f: undef]"; |
unless ($option{format_template}) { |
| 680 |
} |
if ($option{format} =~ /mail-rfc2822|news-usefor|mail-rfc822\+rfc1123|news-son-of-rfc1036|mime/) { |
| 681 |
}gex; |
$option{format_template} = '%Wdy(local);, %DD(local); %Mon(local); %YYYY(local); %HH(local);:%TT(local);:%SS(local); %zsign;%zHH;%zTT;%comment(prefix=>" ");'; |
| 682 |
$template; |
} elsif ($option{format} =~ /http/) { |
| 683 |
} |
$option{format_template} = '%Wdy;, %DD; %Mon; %YYYY; %HH;:%TT;:%SS; GMT'; |
| 684 |
|
} elsif ($option{format} =~ /mail-rfc822|news-rfc1036/) { |
| 685 |
|
$option{format_template} = '%Wdy(local);, %DD(local); %Mon(local); %YY(local); (%YYYY(local);) %HH(local);:%TT(local);:%SS(local); %zsign;%zHH;%zTT;%comment(prefix=>" ");'; |
| 686 |
|
} elsif ($option{format} =~ /news-rfc850/) { |
| 687 |
sub _zone_string_to_array ($$;$) { |
$option{format_template} = '%Weekday;, %DD;-%Mon;-%YY; %HH;:%TT;:%SS; GMT'; |
| 688 |
my $self = shift; |
} elsif ($option{format} =~ /asctime/) { |
| 689 |
my $zone = shift; |
$option{format_template} = '%Wdy; %Mon; %DD(pad=>SP); %HH;:%MM;:%SS; %YYYY;'; |
| 690 |
return (+1, 0, 0) unless defined $zone; |
#} elsif ($option{format} =~ /date\(1\)/) { |
| 691 |
my $format = shift; |
# $option{format_template} = '%Wdy; %Mon; %DD(pad=>SP); %HH;:%MM;:%SS; GMT %YYYY;'; |
| 692 |
my @azone = [+1, 0, 0]; |
} elsif ($option{format} =~ /un[i*]x/) { ## ;-) |
| 693 |
$zone =~ tr/\x09\x20//d; |
$option{format_template} = '%unix;'; |
| 694 |
if ($zone =~ /^[^0-9+-]+(?:([+-]?)([0-9]{1,2}))(?::([0-9]{1,2}))?/) { |
} else { ## RFC 3339 (IETF's ISO 8601) |
| 695 |
## $ENV{TZ} format, but is not fully supported |
$option{format_template} = '%YYYY(local);-%MM(local);-%DD(local);T%HH(local);:%TT(local);:%SS(local);%frac(prefix=>.);%zsign;%zHH;:%zTT;%comment(prefix=>" ");'; |
| 696 |
my ($s, $h, $m) = ($1, $2, $3); |
} |
| 697 |
$s ||= '+'; $s =~ tr/+-/-+/; |
} |
| 698 |
@azone = ("${s}1", 0+$h, 0+$m); |
my $zone = $option{zone}; |
| 699 |
} elsif ($zone =~ /([+-])([0-9][0-9])([0-9][0-9])/) { |
$zone = [ $self->_zone_string_to_array ($zone) ] if not ref $zone && length $zone; |
| 700 |
@azone = ("${1}1", $2, $3); |
$zone = [+0, 0, 0] unless ref $zone; |
| 701 |
} elsif ($zone =~ /([+-]?)([0-9]+)(?:[:.-]([0-9]+))?/) { |
my $l_time = $self->{date_time} + $zone->[0] * ($zone->[1] * 60 + $zone->[2]) * 60; |
| 702 |
@azone = ("${1}1", $2, 0+$3); |
my $c = ''; |
| 703 |
} else { $zone =~ tr/-//d; |
$c = $self->_comment_stringify |
| 704 |
if (ref $ZONE{$zone}) {@azone = @{$ZONE{$zone}}} |
if $option{output_comment} && @{ $self->{comment} } > 0; |
| 705 |
elsif ($zone) {@azone = (-1, 0, 0)} |
Message::Util::sprintxf ($option{format_template}, { |
| 706 |
} |
comment => $c, |
| 707 |
# } |
fmt2str => \%FMT2STR, |
| 708 |
@azone; |
option => \%option, |
| 709 |
} |
time => $self->{date_time}, |
| 710 |
|
time_local => $l_time, |
| 711 |
=item $option-value = $date->option ($option-name) |
tm => [ gmtime $self->{date_time} ], |
| 712 |
|
tm_local => [ gmtime $l_time ], |
| 713 |
Gets option value. |
secfrac => $self->{secfrac}, |
| 714 |
|
secfrac_local => $self->{secfrac}, ## Not supported yet |
| 715 |
=item $date->option ($option-name, $option-value, ...) |
}); |
| 716 |
|
} |
| 717 |
Set option value(s). You can pass multiple option name-value pair |
*as_string = \&stringify; |
| 718 |
as parameter when setting. |
*as_plain_string = \&stringify; |
| 719 |
|
## You should use stringify instead of as_rfc2822_time |
| 720 |
=item $clone = $date->clone () |
sub as_rfc2822_time ($@) { |
| 721 |
|
shift->stringify (-format => 'mail-rfc2822', @_); |
| 722 |
Returns a copy of the object. |
} |
| 723 |
|
|
| 724 |
=cut |
sub _zone_string_to_array ($$;$) { |
| 725 |
|
my $self = shift; |
| 726 |
## option, clone, method_available: Inherited |
my $zone = shift; |
| 727 |
|
return (+1, 0, 0) unless defined $zone; |
| 728 |
=head1 EXAMPLE |
my $format = shift; |
| 729 |
|
my @azone = [+1, 0, 0]; |
| 730 |
use Message::Field::Date; |
$zone =~ tr/\x09\x20//d; |
| 731 |
|
if ($zone =~ /^[^0-9+-]+(?:([+-]?)([0-9]{1,2}))(?::([0-9]{1,2}))?/) { |
| 732 |
print Message::Field::Date->new (unix => time, |
## $ENV{TZ} format, but is not fully supported |
| 733 |
-zone => '+0900'),"\n"; ## Thu, 16 May 2002 17:53:44 +0900 |
my ($s, $h, $m) = ($1, $2, $3); |
| 734 |
print Message::Field::Date->new (unix => time, |
$s ||= '+'; $s =~ tr/+-/-+/; |
| 735 |
-format_template => ## Century: 21, Year: 02, Month: 05 |
@azone = ("${s}1", 0+$h, 0+$m); |
| 736 |
'Century: %CC;, Year: %YY;, Month: %MM;'),"\n"; |
} elsif ($zone =~ /([+-])([0-9][0-9])([0-9][0-9])/) { |
| 737 |
|
@azone = ("${1}1", $2, $3); |
| 738 |
my $field_body = '04 Feb 2002 00:12:33 CST'; |
} elsif ($zone =~ /([+-]?)([0-9]+)(?:[:.-]([0-9]+))?/) { |
| 739 |
my $field = Message::Field::Date->parse ($field_body); |
@azone = ("${1}1", $2, 0+$3); |
| 740 |
|
} else { $zone =~ tr/-//d; |
| 741 |
print "RFC 2822:\t", $field->stringify (-format => 'mail-rfc2822'), "\n"; |
if (ref $ZONE{$zone}) {@azone = @{$ZONE{$zone}}} |
| 742 |
print "HTTP preferred:\t", $field->stringify (-format => 'http-1.1'), "\n"; |
elsif ($zone) {@azone = (-1, 0, 0)} |
| 743 |
print "ISO 8601:\t", $field->stringify (-format => 'mail-cpim'), "\n"; |
} |
| 744 |
## RFC 2822: Mon, 04 Feb 2002 00:12:33 -0600 |
# } |
| 745 |
## HTTP preferred: Mon, 04 Feb 2002 06:12:33 GMT |
@azone; |
| 746 |
## ISO 8601: 2002-02-04T00:12:33-06:00 |
} |
| 747 |
|
|
| 748 |
=head1 LICENSE |
=item $option-value = $date->option ($option-name) |
| 749 |
|
|
| 750 |
Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>. |
Gets option value. |
| 751 |
|
|
| 752 |
This program is free software; you can redistribute it and/or modify |
=item $date->option ($option-name, $option-value, ...) |
| 753 |
it under the terms of the GNU General Public License as published by |
|
| 754 |
the Free Software Foundation; either version 2 of the License, or |
Set option value(s). You can pass multiple option name-value pair |
| 755 |
(at your option) any later version. |
as parameter when setting. |
| 756 |
|
|
| 757 |
This program is distributed in the hope that it will be useful, |
=item $clone = $date->clone () |
| 758 |
but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
| 759 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
Returns a copy of the object. |
| 760 |
GNU General Public License for more details. |
|
| 761 |
|
=cut |
| 762 |
You should have received a copy of the GNU General Public License |
|
| 763 |
along with this program; see the file COPYING. If not, write to |
## option, clone, method_available: Inherited |
| 764 |
the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
|
| 765 |
Boston, MA 02111-1307, USA. |
=head1 EXAMPLE |
| 766 |
|
|
| 767 |
=head1 CHANGE |
use Message::Field::Date; |
| 768 |
|
|
| 769 |
See F<ChangeLog>. |
print Message::Field::Date->new (unix => time, |
| 770 |
$Date$ |
-zone => '+0900'),"\n"; ## Thu, 16 May 2002 17:53:44 +0900 |
| 771 |
|
print Message::Field::Date->new (unix => time, |
| 772 |
=cut |
-format_template => ## Century: 21, Year: 02, Month: 05 |
| 773 |
|
'Century: %CC;, Year: %YY;, Month: %MM;'),"\n"; |
| 774 |
1; |
|
| 775 |
|
my $field_body = '04 Feb 2002 00:12:33 CST'; |
| 776 |
|
my $field = Message::Field::Date->parse ($field_body); |
| 777 |
|
|
| 778 |
|
print "RFC 2822:\t", $field->stringify (-format => 'mail-rfc2822'), "\n"; |
| 779 |
|
print "HTTP preferred:\t", $field->stringify (-format => 'http-1.1'), "\n"; |
| 780 |
|
print "ISO 8601:\t", $field->stringify (-format => 'mail-cpim'), "\n"; |
| 781 |
|
## RFC 2822: Mon, 04 Feb 2002 00:12:33 -0600 |
| 782 |
|
## HTTP preferred: Mon, 04 Feb 2002 06:12:33 GMT |
| 783 |
|
## ISO 8601: 2002-02-04T00:12:33-06:00 |
| 784 |
|
|
| 785 |
|
=head1 LICENSE |
| 786 |
|
|
| 787 |
|
Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>. |
| 788 |
|
|
| 789 |
|
This program is free software; you can redistribute it and/or modify |
| 790 |
|
it under the terms of the GNU General Public License as published by |
| 791 |
|
the Free Software Foundation; either version 2 of the License, or |
| 792 |
|
(at your option) any later version. |
| 793 |
|
|
| 794 |
|
This program is distributed in the hope that it will be useful, |
| 795 |
|
but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 796 |
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 797 |
|
GNU General Public License for more details. |
| 798 |
|
|
| 799 |
|
You should have received a copy of the GNU General Public License |
| 800 |
|
along with this program; see the file COPYING. If not, write to |
| 801 |
|
the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 802 |
|
Boston, MA 02111-1307, USA. |
| 803 |
|
|
| 804 |
|
=head1 CHANGE |
| 805 |
|
|
| 806 |
|
See F<ChangeLog>. |
| 807 |
|
$Date$ |
| 808 |
|
|
| 809 |
|
=cut |
| 810 |
|
|
| 811 |
|
1; |
Parent Directory
| 
Revision Log
| 
Patch