| 1 | | | | | package POSIX::strftime::Compiler; |
| 2 | | | | | |
| 3 | | | | | use 5.008001; |
| 4 | | | | | use strict; |
| 5 | | | | | use warnings; |
| 6 | | | | | use Carp; |
| 7 | | | | | use Time::Local qw//; |
| 8 | | | | | use POSIX qw//; |
| 9 | | | | | use base qw/Exporter/; |
| 10 | | | | | |
| 11 | | | | | our $VERSION = "0.40"; |
| 12 | | | | | our @EXPORT_OK = qw/strftime/; |
| 13 | | | | | |
| 14 | | | | | use constant { |
| 15 | | | | | SEC => 0, |
| 16 | | | | | MIN => 1, |
| 17 | | | | | HOUR => 2, |
| 18 | | | | | DAY => 3, |
| 19 | | | | | MONTH => 4, |
| 20 | | | | | YEAR => 5, |
| 21 | | | | | WDAY => 6, |
| 22 | | | | | YDAY => 7, |
| 23 | | | | | ISDST => 8, |
| 24 | | | | | ISO_WEEK_START_WDAY => 1, # Monday |
| 25 | | | | | ISO_WEEK1_WDAY => 4, # Thursday |
| 26 | | | | | YDAY_MINIMUM => -366, |
| 27 | | | | | }; |
| 28 | | | | | |
| 29 | | | | | BEGIN { |
| 30 | | | | | *tzoffset = \&_tzoffset; |
| 31 | | | | | *tzname = \&_tzname; |
| 32 | | | | | |
| 33 | | | | | if (eval { require Time::TZOffset; 1; }) { |
| 34 | | | | | no warnings 'redefine'; |
| 35 | | | | | *tzoffset = \&Time::TZOffset::tzoffset; |
| 36 | | | | | } |
| 37 | | | | | } |
| 38 | | | | | |
| 39 | | | | | |
| 40 | | | | | # copy from POSIX/strftime/GNU/PP.pm and modify |
| 41 | | | | | my @offset2zone = qw( |
| 42 | | | | | -1100 0 SST -1100 0 SST |
| 43 | | | | | -1000 0 HAST -0900 1 HADT |
| 44 | | | | | -1000 0 HST -1000 0 HST |
| 45 | | | | | -0930 0 MART -0930 0 MART |
| 46 | | | | | -0900 0 AKST -0800 1 AKDT |
| 47 | | | | | -0900 0 GAMT -0900 0 GAMT |
| 48 | | | | | -0800 0 PST -0700 1 PDT |
| 49 | | | | | -0800 0 PST -0800 0 PST |
| 50 | | | | | -0700 0 MST -0600 1 MDT |
| 51 | | | | | -0700 0 MST -0700 0 MST |
| 52 | | | | | -0600 0 CST -0500 1 CDT |
| 53 | | | | | -0600 0 GALT -0600 0 GALT |
| 54 | | | | | -0500 0 ECT -0500 0 ECT |
| 55 | | | | | -0500 0 EST -0400 1 EDT |
| 56 | | | | | -0500 1 EASST -0600 0 EAST |
| 57 | | | | | -0430 0 VET -0430 0 VET |
| 58 | | | | | -0400 0 AMT -0400 0 AMT |
| 59 | | | | | -0400 0 AST -0300 1 ADT |
| 60 | | | | | -0330 0 NST -0230 1 NDT |
| 61 | | | | | -0300 0 ART -0300 0 ART |
| 62 | | | | | -0300 0 PMST -0200 1 PMDT |
| 63 | | | | | -0300 1 AMST -0400 0 AMT |
| 64 | | | | | -0300 1 WARST -0300 1 WARST |
| 65 | | | | | -0200 0 FNT -0200 0 FNT |
| 66 | | | | | -0200 1 UYST -0300 0 UYT |
| 67 | | | | | -0100 0 AZOT +0000 1 AZOST |
| 68 | | | | | -0100 0 CVT -0100 0 CVT |
| 69 | | | | | +0000 0 GMT +0000 0 GMT |
| 70 | | | | | +0000 0 WET +0100 1 WEST |
| 71 | | | | | +0100 0 CET +0200 1 CEST |
| 72 | | | | | +0100 0 WAT +0100 0 WAT |
| 73 | | | | | +0200 0 EET +0200 0 EET |
| 74 | | | | | +0200 0 IST +0300 1 IDT |
| 75 | | | | | +0200 1 WAST +0100 0 WAT |
| 76 | | | | | +0300 0 FET +0300 0 FET |
| 77 | | | | | +030704 0 zzz +030704 0 zzz |
| 78 | | | | | +0330 0 IRST +0430 1 IRDT |
| 79 | | | | | +0400 0 AZT +0500 1 AZST |
| 80 | | | | | +0400 0 GST +0400 0 GST |
| 81 | | | | | +0430 0 AFT +0430 0 AFT |
| 82 | | | | | +0500 0 DAVT +0700 0 DAVT |
| 83 | | | | | +0500 0 MVT +0500 0 MVT |
| 84 | | | | | +0530 0 IST +0530 0 IST |
| 85 | | | | | +0545 0 NPT +0545 0 NPT |
| 86 | | | | | +0600 0 BDT +0600 0 BDT |
| 87 | | | | | +0630 0 CCT +0630 0 CCT |
| 88 | | | | | +0700 0 ICT +0700 0 ICT |
| 89 | | | | | +0800 0 HKT +0800 0 HKT |
| 90 | | | | | +0845 0 CWST +0845 0 CWST |
| 91 | | | | | +0900 0 JST +0900 0 JST |
| 92 | | | | | +0930 0 CST +0930 0 CST |
| 93 | | | | | +1000 0 PGT +1000 0 PGT |
| 94 | | | | | +1030 1 CST +0930 0 CST |
| 95 | | | | | +1100 0 CAST +0800 0 WST |
| 96 | | | | | +1100 0 NCT +1100 0 NCT |
| 97 | | | | | +1100 1 EST +1000 0 EST |
| 98 | | | | | +1100 1 LHST +1030 0 LHST |
| 99 | | | | | +1130 0 NFT +1130 0 NFT |
| 100 | | | | | +1200 0 FJT +1200 0 FJT |
| 101 | | | | | +1300 0 TKT +1300 0 TKT |
| 102 | | | | | +1300 1 NZDT +1200 0 NZST |
| 103 | | | | | +1345 1 CHADT +1245 0 CHAST |
| 104 | | | | | +1400 0 LINT +1400 0 LINT |
| 105 | | | | | +1400 1 WSDT +1300 0 WST |
| 106 | | | | | ); |
| 107 | | | | | |
| 108 | | | | | sub _tzoffset { |
| 109 | | | | | my $diff = (exists $ENV{TZ} and $ENV{TZ} =~ m!^(?:GMT|UTC)$!) |
| 110 | | | | | ? 0 |
| 111 | | | | | : Time::Local::timegm(@_) - Time::Local::timelocal(@_); |
| 112 | | | | | sprintf '%+03d%02u', $diff/60/60, $diff/60%60; |
| 113 | | | | | } |
| 114 | | | | | |
| 115 | | | | | sub _tzname { |
| 116 | | | | | return $ENV{TZ} if exists $ENV{TZ} and $ENV{TZ} =~ m!^(?:GMT|UTC)$!; |
| 117 | | | | | |
| 118 | | | | | my $diff = tzoffset(@_); |
| 119 | | | | | |
| 120 | | | | | my @t1 = my @t2 = @_; |
| 121 | | | | | @t1[3,4] = (1, 1); # winter |
| 122 | | | | | my $diff1 = tzoffset(@t1); |
| 123 | | | | | @t2[3,4] = (1, 7); # summer |
| 124 | | | | | my $diff2 = tzoffset(@t2); |
| 125 | | | | | |
| 126 | | | | | for (my $i=0; $i < @offset2zone; $i += 6) { |
| 127 | | | | | next unless $offset2zone[$i] eq $diff1 and $offset2zone[$i+3] eq $diff2; |
| 128 | | | | | return $diff2 eq $diff ? $offset2zone[$i+5] : $offset2zone[$i+2]; |
| 129 | | | | | } |
| 130 | | | | | |
| 131 | | | | | if ($diff =~ /^([+-])(\d\d)$/) { |
| 132 | | | | | return sprintf 'GMT%s%d', $1 eq '-' ? '+' : '-', $2; |
| 133 | | | | | }; |
| 134 | | | | | |
| 135 | | | | | return 'Etc'; |
| 136 | | | | | } |
| 137 | | | | | |
| 138 | | | | | sub iso_week_days { |
| 139 | | | | | my ($yday, $wday) = @_; |
| 140 | | | | | |
| 141 | | | | | # Add enough to the first operand of % to make it nonnegative. |
| 142 | | | | | my $big_enough_multiple_of_7 = (int(- YDAY_MINIMUM / 7) + 2) * 7; |
| 143 | | | | | return ($yday |
| 144 | | | | | - ($yday - $wday + ISO_WEEK1_WDAY + $big_enough_multiple_of_7) % 7 |
| 145 | | | | | + ISO_WEEK1_WDAY - ISO_WEEK_START_WDAY); |
| 146 | | | | | } |
| 147 | | | | | |
| 148 | | | | | sub isleap { |
| 149 | | | | | my $year = shift; |
| 150 | | | | | return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0 |
| 151 | | | | | } |
| 152 | | | | | |
| 153 | | | | | sub isodaysnum { |
| 154 | | | | | my @t = @_; |
| 155 | | | | | |
| 156 | | | | | my $year = ($t[YEAR] + ($t[YEAR] < 0 ? 1900 % 400 : 1900 % 400 - 400)); |
| 157 | | | | | my $year_adjust = 0; |
| 158 | | | | | my $days = iso_week_days($t[YDAY], $t[WDAY]); |
| 159 | | | | | |
| 160 | | | | | if ($days < 0) { |
| 161 | | | | | # This ISO week belongs to the previous year. |
| 162 | | | | | $year_adjust = -1; |
| 163 | | | | | $days = iso_week_days($t[YDAY] + (365 + isleap($year -1)), $t[WDAY]); |
| 164 | | | | | } |
| 165 | | | | | else { |
| 166 | | | | | my $d = iso_week_days($t[YDAY] - (365 + isleap($year)), $t[WDAY]); |
| 167 | | | | | if ($d >= 0) { |
| 168 | | | | | # This ISO week belongs to the next year. */ |
| 169 | | | | | $year_adjust = 1; |
| 170 | | | | | $days = $d; |
| 171 | | | | | } |
| 172 | | | | | } |
| 173 | | | | | |
| 174 | | | | | return ($days, $year_adjust); |
| 175 | | | | | } |
| 176 | | | | | |
| 177 | | | | | sub isoyearnum { |
| 178 | | | | | my ($days, $year_adjust) = isodaysnum(@_); |
| 179 | | | | | return $_[YEAR] + 1900 + $year_adjust; |
| 180 | | | | | } |
| 181 | | | | | |
| 182 | | | | | sub isoweeknum { |
| 183 | | | | | my ($days, $year_adjust) = isodaysnum(@_); |
| 184 | | | | | return int($days / 7) + 1; |
| 185 | | | | | } |
| 186 | | | | | |
| 187 | | | | | our %FORMAT_CHARS = map { $_ => 1 } split //, q!%aAbBcCdDeFGghHIjklmMnNpPrRsStTuUVwWxXyYzZ!; |
| 188 | | | | | |
| 189 | | | | | our %SPRINTF_CHARS = ( |
| 190 | | | | | '%' => [q!%s!, q!%!], |
| 191 | | | | | 'a' => [q!%s!, q!$weekday_abbr[$_[WDAY]]!], |
| 192 | | | | | 'A' => [q!%s!, q!$weekday_name[$_[WDAY]]!], |
| 193 | | | | | 'b' => [q!%s!, q!$month_abbr[$_[MONTH]]!], |
| 194 | | | | | 'B' => [q!%s!, q!$month_name[$_[MONTH]]!], |
| 195 | | | | | 'c' => [q!%s %s %2d %02d:%02d:%02d %04d!, |
| 196 | | | | | q!$weekday_abbr[$_[WDAY]], $month_abbr[$_[MONTH]], $_[DAY], $_[HOUR], $_[MIN], $_[SEC], $_[YEAR]+1900!], |
| 197 | | | | | 'C' => [q!%02d!, q!($_[YEAR]+1900)/100!], |
| 198 | | | | | 'd' => [q!%02d!, q!$_[DAY]!], |
| 199 | | | | | 'D' => [q!%02d/%02d/%02d!, q!$_[MONTH]+1,$_[DAY],$_[YEAR]%100!], |
| 200 | | | | | 'e' => [q!%2d!, q!$_[DAY]!], |
| 201 | | | | | 'F' => [q!%04d-%02d-%02d!, q!$_[YEAR]+1900,$_[MONTH]+1,$_[DAY]!], |
| 202 | | | | | 'h' => [q!%s!, q!$month_abbr[$_[MONTH]]!], |
| 203 | | | | | 'H' => [q!%02d!, q!$_[HOUR]!], |
| 204 | | | | | 'I' => [q!%02d!, q!$_[HOUR]%12 || 1!], |
| 205 | | | | | 'j' => [q!%03d!, q!$_[YDAY]+1!], |
| 206 | | | | | 'k' => [q!%2d!, q!$_[HOUR]!], |
| 207 | | | | | 'l' => [q!%2d!, q!$_[HOUR]%12 || 1!], |
| 208 | | | | | 'm' => [q!%02d!, q!$_[MONTH]+1!], |
| 209 | | | | | 'M' => [q!%02d!, q!$_[MIN]!], |
| 210 | | | | | 'n' => [q!%s!, q!"\n"!], |
| 211 | | | | | 'N' => [q!%s!, q!substr(sprintf('%.9f', $_[SEC] - int $_[SEC]), 2)!], |
| 212 | | | | | 'p' => [q!%s!, q!$_[HOUR] > 0 && $_[HOUR] < 13 ? "AM" : "PM"!], |
| 213 | | | | | 'P' => [q!%s!, q!$_[HOUR] > 0 && $_[HOUR] < 13 ? "am" : "pm"!], |
| 214 | | | | | 'r' => [q!%02d:%02d:%02d %s!, q!$_[HOUR]%12 || 1, $_[MIN], $_[SEC], $_[HOUR] > 0 && $_[HOUR] < 13 ? "AM" : "PM"!], |
| 215 | | | | | 'R' => [q!%02d:%02d!, q!$_[HOUR], $_[MIN]!], |
| 216 | | | | | 'S' => [q!%02d!, q!$_[SEC]!], |
| 217 | | | | | 't' => [q!%s!, q!"\t"!], |
| 218 | | | | | 'T' => [q!%02d:%02d:%02d!, q!$_[HOUR], $_[MIN], $_[SEC]!], |
| 219 | | | | | 'u' => [q!%d!, q!$_[WDAY] || 7!], |
| 220 | | | | | 'w' => [q!%d!, q!$_[WDAY]!], |
| 221 | | | | | 'x' => [q!%02d/%02d/%02d!, q!$_[MONTH]+1,$_[DAY],$_[YEAR]%100!], |
| 222 | | | | | 'X' => [q!%02d:%02d:%02d!, q!$_[HOUR], $_[MIN], $_[SEC]!], |
| 223 | | | | | 'y' => [q!%02d!, q!$_[YEAR]%100!], |
| 224 | | | | | 'Y' => [q!%02d!, q!$_[YEAR]+1900!], |
| 225 | | | | | '%' => [q!%s!, q!'%'!], |
| 226 | | | | | ); |
| 227 | | | | | |
| 228 | | | | | if ( eval { require Time::TZOffset; 1 } ) { |
| 229 | | | | | $SPRINTF_CHARS{z} = [q!%s!,q!Time::TZOffset::tzoffset(@_)!]; |
| 230 | | | | | } |
| 231 | | | | | |
| 232 | | | | | our %LOCALE_CHARS = ( |
| 233 | | | | | '%' => [q!'%%'!], |
| 234 | | | | | 'a' => [q!$weekday_abbr[$_[WDAY]]!,1], |
| 235 | | | | | 'A' => [q!$weekday_name[$_[WDAY]]!,1], |
| 236 | | | | | 'b' => [q!$month_abbr[$_[MONTH]]!], |
| 237 | | | | | 'B' => [q!$month_name[$_[MONTH]]!], |
| 238 | | | | | 'c' => [q!$weekday_abbr[$_[WDAY]] . ' ' . $month_abbr[$_[MONTH]] . ' ' . substr(' '.$_[DAY],-2) . ' %H:%M:%S %Y'!,1], |
| 239 | | | | | 'C' => [q!substr('0'.int(($_[YEAR]+1900)/100), -2)!], #century |
| 240 | | | | | 'h' => [q!$month_abbr[$_[MONTH]]!], |
| 241 | | | | | 'N' => [q!substr(sprintf('%.9f', $_[SEC] - int $_[SEC]), 2)!], |
| 242 | | | | | 'n' => [q!"\n"!], |
| 243 | | | | | 'p' => [q!$_[HOUR] > 0 && $_[HOUR] < 13 ? "AM" : "PM"!], |
| 244 | | | | | 'P' => [q!$_[HOUR] > 0 && $_[HOUR] < 13 ? "am" : "pm"!], |
| 245 | | | | | 'r' => [q!sprintf('%02d:%02d:%02d %s',$_[HOUR]%12 || 1, $_[MIN], $_[SEC], $_[HOUR] > 0 && $_[HOUR] < 13 ? "AM" : "PM")!], |
| 246 | | | | | 't' => [q!"\t"!], |
| 247 | | | | | 'x' => [q!'%m/%d/%y'!], |
| 248 | | | | | 'X' => [q!'%H:%M:%S'!], |
| 249 | | | | | 'z' => [q!'%z'!,1], |
| 250 | | | | | 'Z' => [q!'%Z'!,1], |
| 251 | | | | | ); |
| 252 | | | | | |
| 253 | | | | | if ( $^O =~ m!^(MSWin32|cygwin)$!i ) { |
| 254 | | | | | %LOCALE_CHARS = ( |
| 255 | | | | | %LOCALE_CHARS, |
| 256 | | | | | 'D' => [q!'%m/%d/%y'!], |
| 257 | | | | | 'F' => [q!'%Y-%m-%d'!], |
| 258 | | | | | 'G' => [q!substr('0000'. isoyearnum(@_), -4)!,1], |
| 259 | | | | | 'R' => [q!'%H:%M'!], |
| 260 | | | | | 'T' => [q!'%H:%M:%S'!], |
| 261 | | | | | 'V' => [q!substr('0'.isoweeknum(@_),-2)!,1], |
| 262 | | | | | 'e' => [q!substr(' '.$_[DAY],-2)!], |
| 263 | | | | | 'g' => [q!substr('0'.isoyearnum(@_)%100,-2)!,1], |
| 264 | | | | | 'k' => [q!substr(' '.$_[HOUR],-2)!], |
| 265 | | | | | 'l' => [q!substr(' '.($_[HOUR]%12 || 1),-2)!], |
| 266 | | | | | 's' => [q!int(Time::Local::timegm(@_))!,1], |
| 267 | | | | | 'u' => [q!$_[WDAY] || 7!,1], |
| 268 | | | | | 'z' => [q!tzoffset(@_)!,1], |
| 269 | | | | | 'Z' => [q!tzname(@_)!,1], |
| 270 | | | | | ); |
| 271 | | | | | } |
| 272 | | | | | elsif ( $^O =~ m!^solaris$!i ) { |
| 273 | | | | | $LOCALE_CHARS{s} = [q!int(Time::Local::timegm(@_))!,1]; |
| 274 | | | | | } |
| 275 | | | | | |
| 276 | | | | | my $sprintf_char_handler = sub { |
| 277 | | | | | my ($char,$args) = @_; |
| 278 | | | | | return q|! . '%%' .q!| if $char eq ''; #last % |
| 279 | | | | | return q|! . '%%| . $char . q|' . q!| if ! exists $FORMAT_CHARS{$char}; #escape %% |
| 280 | | | | | my ($format, $code) = @{$SPRINTF_CHARS{$char}}; |
| 281 | | | | | push @$args, $code; |
| 282 | | | | | return $format; |
| 283 | | | | | }; |
| 284 | | | | | |
| 285 | | | | | my $char_handler = sub { |
| 286 | | | | | my ($char,$need9char_ref) = @_; |
| 287 | | | | | return q|! . '%%' .q!| if $char eq ''; #last % |
| 288 | | | | | return q|! . '%%| . $char . q|' . q!| if ! exists $FORMAT_CHARS{$char}; #escape %% |
| 289 | | | | | return q|! . '%| . $char . q|' . q!| if ! exists $LOCALE_CHARS{$char}; #stay |
| 290 | | | | | my ($code,$flag) = @{$LOCALE_CHARS{$char}}; |
| 291 | | | | | $$need9char_ref++ if $flag; |
| 292 | | | | | q|! . | . $code . q| . q!|; |
| 293 | | | | | }; |
| 294 | | | | | |
| 295 | | | | | sub compile { |
| 296 | | | | | my ($fmt) = @_; |
| 297 | | | | | |
| 298 | | | | | my @weekday_name = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday); |
| 299 | | | | | my @weekday_abbr = qw(Sun Mon Tue Wed Thu Fri Sat); |
| 300 | | | | | my @month_name = qw(January February March April May June July August September October November December); |
| 301 | | | | | my @month_abbr = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); |
| 302 | | | | | |
| 303 | | | | | $fmt =~ s/!/\\!/g; |
| 304 | | | | | $fmt =~ s!\%E([cCxXyY])!%$1!g; |
| 305 | | | | | $fmt =~ s!\%O([deHImMSuUVwWy])!%$1!g; |
| 306 | | | | | |
| 307 | | | | | my $sprintf_fmt = $fmt; |
| 308 | | | | | my $disable_sprintf=0; |
| 309 | | | | | my $sprintf_code = ''; |
| 310 | | | | | while ( $sprintf_fmt =~ m~ (?:\%([\%\+a-zA-Z])) ~gx ) { |
| 311 | | | | | if ( exists $FORMAT_CHARS{$1} && ! exists $SPRINTF_CHARS{$1} ) { |
| 312 | | | | | $disable_sprintf++ |
| 313 | | | | | } |
| 314 | | | | | } |
| 315 | | | | | if ( !$disable_sprintf ) { |
| 316 | | | | | my @args; |
| 317 | | | | | $sprintf_fmt =~ s! |
| 318 | | | | | (?: |
| 319 | | | | | \%([\%\+a-zA-Z]|$) |
| 320 | | | | | ) |
| 321 | | | | | ! $sprintf_char_handler->($1,\@args) !egx; |
| 322 | | | | | $sprintf_code = q~if ( @_ == 9 ) { |
| 323 | | | | | return sprintf(q!~ . $sprintf_fmt . q~!,~ . join(",", @args) . q~); |
| 324 | | | | | }~; |
| 325 | | | | | } |
| 326 | | | | | |
| 327 | | | | | my $posix_fmt = $fmt; |
| 328 | | | | | my $need9char=0; |
| 329 | | | | | $posix_fmt =~ s! |
| 330 | | | | | (?: |
| 331 | | | | | \%([\%\+a-zA-Z]|$) |
| 332 | | | | | ) |
| 333 | | | | | ! $char_handler->($1,\$need9char) !egx; |
| 334 | | | | | |
| 335 | | | | | my $need9char_code=''; |
| 336 | | | | | if ( $need9char ) { |
| 337 | | | | | $need9char_code = q~if ( @_ == 6 ) { |
| 338 | | | | | my $sec = $_[0]; |
| 339 | | | | | @_ = gmtime Time::Local::timegm(@_); |
| 340 | | | | | $_[0] = $sec; |
| 341 | | | | | }~; |
| 342 | | | | | } |
| 343 | | | | | my $code = q~sub { |
| 344 | | | | | if ( @_ != 9 && @_ != 6 ) { |
| 345 | | | | | Carp::croak 'Usage: strftime(sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)'; |
| 346 | | | | | } |
| 347 | | | | | ~ . $sprintf_code . q~ |
| 348 | | | | | ~ . $need9char_code . q~ |
| 349 | | | | | POSIX::strftime(q!~ . $posix_fmt . q~!,@_); |
| 350 | | | | | }~; |
| 351 | | | | | my $sub = eval $code; ## no critic |
| 352 | | | | | die $@ ."\n=====\n".$code."\n=====\n" if $@; |
| 353 | | | | | wantarray ? ($sub,$code) : $sub; |
| 354 | | | | | } |
| 355 | | | | | |
| 356 | | | | | my %STRFTIME; |
| 357 | | | | | sub strftime { |
| 358 | | | | | my $fmt = shift; |
| 359 | | | | | ($STRFTIME{$fmt} ||= compile($fmt))->(@_); |
| 360 | | | | | } |
| 361 | | | | | |
| 362 | | | | | sub new { |
| 363 | | | | | my $class = shift; |
| 364 | | | | | my $fmt = shift; |
| 365 | | | | | my ($sub,$code) = compile($fmt); |
| 366 | | | | | bless [$sub,$code], $class; |
| 367 | | | | | } |
| 368 | | | | | |
| 369 | | | | | sub to_string { |
| 370 | | | | | my $self = shift; |
| 371 | | | | | $self->[0]->(@_); |
| 372 | | | | | } |
| 373 | | | | | |
| 374 | | | | | sub code_ref { |
| 375 | | | | | my $self = shift; |
| 376 | | | | | $self->[0]; |
| 377 | | | | | } |
| 378 | | | | | |
| 379 | | | | | 1; |
| 380 | | | | | __END__ |
| 381 | | | | | |
| 382 | | | | | =encoding utf-8 |
| 383 | | | | | |
| 384 | | | | | =head1 NAME |
| 385 | | | | | |
| 386 | | | | | POSIX::strftime::Compiler - GNU C library compatible strftime for loggers and servers |
| 387 | | | | | |
| 388 | | | | | =head1 SYNOPSIS |
| 389 | | | | | |
| 390 | | | | | use POSIX::strftime::Compiler qw/strftime/; |
| 391 | | | | | |
| 392 | | | | | say strftime('%a, %d %b %Y %T %z',localtime): |
| 393 | | | | | |
| 394 | | | | | my $psc = POSIX::strftime::Compiler->new($fmt); |
| 395 | | | | | say $psc->to_string(localtime); |
| 396 | | | | | |
| 397 | | | | | =head1 DESCRIPTION |
| 398 | | | | | |
| 399 | | | | | POSIX::strftime::Compiler provides GNU C library compatible strftime(3). But this module will not affected |
| 400 | | | | | by the system locale. This feature is useful when you want to write loggers, servers and portable applications. |
| 401 | | | | | |
| 402 | | | | | For generate same result strings on any locale, POSIX::strftime::Compiler wraps POSIX::strftime and |
| 403 | | | | | converts some format characters to perl code |
| 404 | | | | | |
| 405 | | | | | =head1 FUNCTION |
| 406 | | | | | |
| 407 | | | | | =over 4 |
| 408 | | | | | |
| 409 | | | | | =item strftime($fmt:String, @time) |
| 410 | | | | | |
| 411 | | | | | Generate formatted string from a format and time. |
| 412 | | | | | |
| 413 | | | | | my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(); |
| 414 | | | | | strftime('%d/%b/%Y:%T %z',$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst): |
| 415 | | | | | |
| 416 | | | | | Compiled codes are stored in C<%POSIX::strftime::Compiler::STRFTIME>. This function is not exported by default. |
| 417 | | | | | |
| 418 | | | | | =back |
| 419 | | | | | |
| 420 | | | | | =head1 METHODS |
| 421 | | | | | |
| 422 | | | | | =over 4 |
| 423 | | | | | |
| 424 | | | | | =item new($fmt) |
| 425 | | | | | |
| 426 | | | | | create instance of POSIX::strftime::Compiler |
| 427 | | | | | |
| 428 | | | | | =item to_string(@time) |
| 429 | | | | | |
| 430 | | | | | Generate formatted string from time. |
| 431 | | | | | |
| 432 | | | | | =back |
| 433 | | | | | |
| 434 | | | | | =head1 FORMAT CHARACTERS |
| 435 | | | | | |
| 436 | | | | | POSIX::strftime::Compiler supports almost all characters that GNU strftime(3) supports. |
| 437 | | | | | But C<%E[cCxXyY]> and C<%O[deHImMSuUVwWy]> are not supported, just remove E and O prefix. |
| 438 | | | | | |
| 439 | | | | | =head1 A RECOMMEND MODULE |
| 440 | | | | | |
| 441 | | | | | =over |
| 442 | | | | | |
| 443 | | | | | =item L<Time::TZOffset> |
| 444 | | | | | |
| 445 | | | | | If L<Time::TZOffset> is available, P::s::Compiler use it for more faster time zone offset calculation. |
| 446 | | | | | I strongly recommend you to install this if you use C<%z>. |
| 447 | | | | | |
| 448 | | | | | =back |
| 449 | | | | | |
| 450 | | | | | =head1 PERFORMANCE ISSUES ON WINDOWS |
| 451 | | | | | |
| 452 | | | | | Windows and Cygwin and some system may not support C<%z> and C<%Z>. For these system, |
| 453 | | | | | POSIX::strftime::Compiler calculate time zone offset and find zone name. This is not fast. |
| 454 | | | | | If you need performance on Windows and Cygwin, please install L<Time::TZOffset> |
| 455 | | | | | |
| 456 | | | | | =head1 SEE ALSO |
| 457 | | | | | |
| 458 | | | | | =over 4 |
| 459 | | | | | |
| 460 | | | | | =item L<POSIX::strftime::GNU> |
| 461 | | | | | |
| 462 | | | | | POSIX::strftime::Compiler is built on POSIX::strftime::GNU::PP code |
| 463 | | | | | |
| 464 | | | | | =item L<POSIX> |
| 465 | | | | | |
| 466 | | | | | =item L<Apache::LogFormat::Compiler> |
| 467 | | | | | |
| 468 | | | | | =back |
| 469 | | | | | |
| 470 | | | | | =head1 LICENSE |
| 471 | | | | | |
| 472 | | | | | Copyright (C) Masahiro Nagano. |
| 473 | | | | | |
| 474 | | | | | Format specification is based on strftime(3) manual page which is a part of the Linux man-pages project. |
| 475 | | | | | |
| 476 | | | | | This library is free software; you can redistribute it and/or modify |
| 477 | | | | | it under the same terms as Perl itself. |
| 478 | | | | | |
| 479 | | | | | =head1 AUTHOR |
| 480 | | | | | |
| 481 | | | | | Masahiro Nagano E<lt>kazeburo@gmail.comE<gt> |
| 482 | | | | | |
| 483 | | | | | =cut |
| 484 | | | | | |