my
(
@MonthLengths
,
@LeapYearMonthLengths
);
my
(
@EndOfLastMonthDayOfYear
,
@EndOfLastMonthDayOfLeapYear
);
BEGIN {
@MonthLengths
=
qw(31 28 31 30 31 30 31 31 30 31 30 31)
;
@LeapYearMonthLengths
=
@MonthLengths
;
$LeapYearMonthLengths
[1]++;
{
my
$x
= 0;
foreach
my
$length
(
@MonthLengths
)
{
push
@EndOfLastMonthDayOfYear
,
$x
;
$x
+=
$length
;
}
}
@EndOfLastMonthDayOfLeapYear
=
@EndOfLastMonthDayOfYear
;
$EndOfLastMonthDayOfLeapYear
[
$_
]++
for
2..11;
}
sub
month_length {
my
(
$year
,
$month
) =
@_
;
return
is_leap_year(
$year
) ?
$LeapYearMonthLengths
[
$month
- 1] :
$MonthLengths
[
$month
- 1]
;
}
sub
is_leap_year {
my
$year
=
shift
;
return
0
if
$year
== DateTimeX::Lite::INFINITY() ||
$year
== DateTimeX::Lite::NEG_INFINITY();
return
0
if
$year
% 4;
return
1
if
$year
% 100;
return
0
if
$year
% 400;
return
1;
}
sub
ymd2rd {
my
(
$y
,
$m
,
$d
) =
@_
;
my
$adj
;
if
(
$m
<= 2 ) {
$y
-= (
$adj
= ( 14 -
$m
) / 12 );
$m
+= 12 *
$adj
;
}
elsif
(
$m
> 14 ) {
$y
+= (
$adj
= (
$m
- 3 ) / 12 );
$m
-= 12 *
$adj
;
}
if
(
$y
< 0 ) {
$d
-= 146097 * (
$adj
= ( 399 -
$y
) / 400 );
$y
+= 400 *
$adj
;
}
$d
+= (
$m
* 367 - 1094 ) / 12 +
$y
% 100 * 1461 / 4 +
(
$y
/ 100 * 36524 +
$y
/ 400 ) - 306;
return
$d
;
}
sub
time_as_seconds {
my
(
$hour
,
$min
,
$sec
) =
@_
;
$hour
||= 0;
$min
||= 0;
$sec
||= 0;
my
$secs
=
$hour
* 3600 +
$min
* 60 +
$sec
;
return
$secs
;
}
sub
normalize_nanoseconds {
if
(
$_
[1] < 0 )
{
my
$overflow
= 1 +
$_
[1] / DateTimeX::Lite::MAX_NANOSECONDS();
$_
[1] +=
$overflow
* DateTimeX::Lite::MAX_NANOSECONDS();
$_
[0] -=
$overflow
;
}
elsif
(
$_
[1] >= DateTimeX::Lite::MAX_NANOSECONDS() )
{
my
$overflow
=
$_
[1] / DateTimeX::Lite::MAX_NANOSECONDS();
$_
[1] -=
$overflow
* DateTimeX::Lite::MAX_NANOSECONDS();
$_
[0] +=
$overflow
;
}
}
sub
normalize_seconds
{
my
$dt
=
shift
;
return
if
$dt
->{utc_rd_secs} >= 0 &&
$dt
->{utc_rd_secs} <= 86399;
if
(
$dt
->{tz}->is_floating )
{
normalize_tai_seconds(
$dt
->{utc_rd_days},
$dt
->{utc_rd_secs} );
}
else
{
normalize_leap_seconds(
$dt
->{utc_rd_days},
$dt
->{utc_rd_secs} );
}
}
sub
normalize_tai_seconds {
return
if
grep
{
$_
== DateTimeX::Lite::INFINITY() ||
$_
== DateTimeX::Lite::NEG_INFINITY() }
@_
[0,1];
my
$adj
;
if
(
$_
[1] < 0 )
{
$adj
= (
$_
[1] - 86399 ) / 86400;
}
else
{
$adj
=
$_
[1] / 86400;
}
$_
[0] +=
$adj
;
$_
[1] -=
$adj
* 86400;
}
sub
rd2ymd
{
my
$d
=
shift
;
my
$rd
=
$d
;
my
$yadj
= 0;
my
(
$c
,
$y
,
$m
);
if
(
$d
> 2**28 - 307 )
{
$d
-=
$yadj
* 146097 - 306;
}
elsif
( (
$d
+= 306 ) <= 0 )
{
$yadj
=
-( -
$d
/ 146097 + 1 );
$d
-=
$yadj
* 146097;
}
$c
= (
$d
* 4 - 1 ) / 146097;
$d
-=
$c
* 146097 / 4;
$y
= (
$d
* 4 - 1 ) / 1461;
$d
-=
$y
* 1461 / 4;
$m
= (
$d
* 12 + 1093 ) / 367;
$d
-= (
$m
* 367 - 1094 ) / 12;
$y
+=
$c
* 100 +
$yadj
* 400;
++
$y
,
$m
-= 12
if
$m
> 12;
if
(
$_
[0] )
{
my
$dow
;
if
(
$rd
< -6 )
{
$dow
= (
$rd
+ 6 ) % 7;
$dow
+=
$dow
? 8 : 1;
}
else
{
$dow
= ( (
$rd
+ 6 ) % 7 ) + 1;
}
my
$doy
= end_of_last_month_day_of_year(
$y
,
$m
);
$doy
+=
$d
;
my
$quarter
;
{
no
integer;
$quarter
=
int
( ( 1 / 3.1 ) *
$m
) + 1;
}
my
$qm
= ( 3 *
$quarter
) - 2;
my
$doq
=
$doy
- end_of_last_month_day_of_year(
$y
,
$qm
);
return
(
$y
,
$m
,
$d
,
$dow
,
$doy
,
$quarter
,
$doq
);
}
return
(
$y
,
$m
,
$d
);
}
sub
end_of_last_month_day_of_year
{
my
(
$y
,
$m
) =
@_
;
$m
--;
return
( is_leap_year(
$y
) ?
$EndOfLastMonthDayOfLeapYear
[
$m
] :
$EndOfLastMonthDayOfYear
[
$m
]
);
}
sub
_seconds_as_components
{
shift
;
my
$secs
=
shift
;
my
$utc_secs
=
shift
;
my
$modifier
=
shift
|| 0;
$secs
-=
$modifier
;
my
$hour
=
$secs
/ 3600;
$secs
-=
$hour
* 3600;
my
$minute
=
$secs
/ 60;
my
$second
=
$secs
- (
$minute
* 60 );
if
(
$utc_secs
&&
$utc_secs
>= 86400 )
{
die
"Invalid UTC RD seconds value: $utc_secs"
if
$utc_secs
> 86401;
$second
+=
$utc_secs
- 86400 + 60;
$minute
= 59;
$hour
--;
$hour
= 23
if
$hour
< 0;
}
return
(
$hour
,
$minute
,
$second
);
}
sub
normalize_leap_seconds {
my
$delta_days
;
if
(
$_
[1] < 0 )
{
$delta_days
= (
$_
[1] - 86399) / 86400;
}
else
{
$delta_days
=
$_
[1] / 86400;
}
my
$new_day
=
$_
[0] +
$delta_days
;
my
$delta_seconds
= ( 86400 *
$delta_days
) +
DateTimeX::Lite::LeapSecond::leap_seconds(
$new_day
) -
DateTimeX::Lite::LeapSecond::leap_seconds(
$_
[0] );
$_
[1] -=
$delta_seconds
;
$_
[0] =
$new_day
;
my
$day_length
= DateTimeX::Lite::LeapSecond::day_length(
$new_day
);
if
(
$_
[1] >=
$day_length
)
{
$_
[1] -=
$day_length
;
$_
[0]++;
}
elsif
(
$_
[1] < 0 )
{
$day_length
= DateTimeX::Lite::LeapSecond::day_length(
$new_day
- 1 );
$_
[1] +=
$day_length
;
$_
[0]--;
}
}
sub
seconds_as_components
{
my
$secs
=
shift
;
my
$utc_secs
=
shift
;
my
$modifier
=
shift
|| 0;
$secs
-=
$modifier
;
my
$hour
=
$secs
/ 3600;
$secs
-=
$hour
* 3600;
my
$minute
=
$secs
/ 60;
my
$second
=
$secs
- (
$minute
* 60 );
if
(
$utc_secs
&&
$utc_secs
>= 86400 )
{
die
"Invalid UTC RD seconds value: $utc_secs"
if
$utc_secs
> 86401;
$second
+=
$utc_secs
- 86400 + 60;
$minute
= 59;
$hour
--;
$hour
= 23
if
$hour
< 0;
}
return
(
$hour
,
$minute
,
$second
);
}
sub
offset_as_seconds {
my
$offset
=
shift
;
return
undef
unless
defined
$offset
;
return
0
if
$offset
eq
'0'
;
my
(
$sign
,
$hours
,
$minutes
,
$seconds
);
if
(
$offset
=~ /^([\+\-])?(\d\d?):(\d\d)(?::(\d\d))?$/ )
{
(
$sign
,
$hours
,
$minutes
,
$seconds
) = ( $1, $2, $3, $4 );
}
elsif
(
$offset
=~ /^([\+\-])?(\d\d)(\d\d)(\d\d)?$/ )
{
(
$sign
,
$hours
,
$minutes
,
$seconds
) = ( $1, $2, $3, $4 );
}
else
{
return
undef
;
}
$sign
=
'+'
unless
defined
$sign
;
return
undef
unless
$hours
>= 0 &&
$hours
<= 99;
return
undef
unless
$minutes
>= 0 &&
$minutes
<= 59;
return
undef
unless
!
defined
(
$seconds
) || (
$seconds
>= 0 &&
$seconds
<= 59 );
my
$total
=
$hours
* 3600 +
$minutes
* 60;
$total
+=
$seconds
if
$seconds
;
$total
*= -1
if
$sign
eq
'-'
;
return
$total
;
}
sub
offset_as_string {
my
$offset
=
shift
;
return
undef
unless
defined
$offset
;
return
undef
unless
$offset
>= -359999 &&
$offset
<= 359999;
my
$sign
=
$offset
< 0 ?
'-'
:
'+'
;
$offset
=
abs
(
$offset
);
my
$hours
=
int
(
$offset
/ 3600 );
$offset
%= 3600;
my
$mins
=
int
(
$offset
/ 60 );
$offset
%= 60;
my
$secs
=
int
(
$offset
);
return
(
$secs
?
sprintf
(
'%s%02d%02d%02d'
,
$sign
,
$hours
,
$mins
,
$secs
) :
sprintf
(
'%s%02d%02d'
,
$sign
,
$hours
,
$mins
)
);
}
1;