File Coverage

blib/lib/Net/DNS/Extlang/Time.pm
Criterion Covered Total %
statement 33 43 76.7
branch 8 20 40.0
condition 0 3 0.0
subroutine 9 9 100.0
pod n/a
total 50 75 66.6


line stmt bran cond sub pod time code
1             ## RRSIG time stamp for T and T6
2             package Net::DNS::Extlang::Time;
3              
4             our $VERSION = '0.1';
5             =head1 NAME
6              
7             Net::DNS::Extlang::Time - Helper routines for timestamps
8              
9             Called only from Extlang generated code. No user servicable parts.
10              
11             =cut
12 1     1   760034 use base qw(Exporter);
  1         5  
  1         141  
13 1     1   8 use vars qw(@EXPORT);
  1         3  
  1         74  
14             @EXPORT = qw(_encodetime _string2time);
15              
16 1     1   11 use strict;
  1         5  
  1         45  
17 1     1   9 use Carp;
  1         5  
  1         112  
18 1     1   713 use Time::Local;
  1         1565  
  1         57  
19 1     1   6 use constant UTIL => defined eval 'require Scalar::Util';
  1         3  
  1         53  
20              
21             my $y1998 = timegm( 0, 0, 0, 1, 0, 1998 );
22             my $y2026 = timegm( 0, 0, 0, 1, 0, 2026 );
23             my $y2082 = $y2026 << 1;
24             my $y2054 = $y2082 - $y1998;
25             my $m2026 = int( 0x80000000 - $y2026 );
26             my $m2054 = int( 0x80000000 - $y2054 );
27             my $t2082 = int( $y2082 & 0x7FFFFFFF );
28             my $t2100 = 1960058752;
29              
30             sub _string2time { ## parse time specification string
31 2     2   130272 my $arg = shift;
32 2 50       10 croak 'undefined time' unless defined $arg;
33 2 50       11 return int($arg) if length($arg) < 12;
34 2         24 my ( $y, $m, @dhms ) = unpack 'a4 a2 a2 a2 a2 a2', $arg . '00';
35 2 50 0     11 unless ( $arg gt '20380119031407' ) { # calendar folding
36 2 50       23 return timegm( reverse(@dhms), $m - 1, $y ) if $y < 2026;
37 0         0 return timegm( reverse(@dhms), $m - 1, $y - 56 ) + $y2026;
38             } elsif ( $y > 2082 ) {
39             my $z = timegm( reverse(@dhms), $m - 1, $y - 84 ); # expunge 29 Feb 2100
40             return $z < 1456790400 ? $z + $y2054 : $z + $y2054 - 86400;
41             }
42 0         0 return ( timegm( reverse(@dhms), $m - 1, $y - 56 ) + $y2054 ) - $y1998;
43             }
44              
45             # return encoded time
46             sub _encodetime {
47 6     6   27900 my $time = shift;
48              
49 6 50       30 return undef unless $time;
50 6         33 return UTIL ? Scalar::Util::dualvar( $time, _time2string($time) ) : _time2string($time);
51             }
52              
53             sub _time2string { ## format time specification string
54 6     6   16 my $arg = shift;
55 6 50       22 croak 'undefined time' unless defined $arg;
56 6         18 my $ls31 = int( $arg & 0x7FFFFFFF );
57 6 50       33 if ( $arg & 0x80000000 ) {
    50          
58              
59 0 0       0 if ( $ls31 > $t2082 ) {
60 0 0       0 $ls31 += 86400 unless $ls31 < $t2100; # expunge 29 Feb 2100
61 0         0 my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 + $m2054 ) )[0 .. 5] );
62 0         0 return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1984, $mm + 1, @dhms;
63             }
64              
65 0         0 my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 + $m2026 ) )[0 .. 5] );
66 0         0 return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1956, $mm + 1, @dhms;
67              
68              
69             } elsif ( $ls31 > $y2026 ) {
70 0         0 my ( $yy, $mm, @dhms ) = reverse( ( gmtime( $ls31 - $y2026 ) )[0 .. 5] );
71 0         0 return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1956, $mm + 1, @dhms;
72             }
73              
74 6         52 my ( $yy, $mm, @dhms ) = reverse( ( gmtime $ls31 )[0 .. 5] );
75 6         86 return sprintf '%d%02d%02d%02d%02d%02d', $yy + 1900, $mm + 1, @dhms;
76             }
77             1;
78             __END__