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