File Coverage

blib/lib/Mojar/Cron/Datetime.pm
Criterion Covered Total %
statement 56 57 98.2
branch 19 26 73.0
condition 7 11 63.6
subroutine 15 15 100.0
pod 6 10 60.0
total 103 119 86.5


line stmt bran cond sub pod time code
1             package Mojar::Cron::Datetime;
2 8     8   19660 use Mojo::Base -strict;
  8         9  
  8         39  
3              
4             our $VERSION = 0.101;
5              
6 8     8   742 use Carp qw(carp croak);
  8         8  
  8         325  
7 8     8   2931 use Mojar::ClassShare 'have';
  8         3010  
  8         46  
8 8         554 use Mojar::Cron::Util qw(balance life_to_zero normalise_local normalise_utc
9 8     8   2544 time_to_zero zero_to_time utc_to_ts local_to_ts);
  8         11  
10 8     8   34 use POSIX 'strftime';
  8         8  
  8         28  
11              
12             our @TimeFields = qw(sec min hour day month year);
13              
14             # Normal maxima (soft limits)
15             %Mojar::Cron::Datetime::Max = (
16             sec => 59,
17             min => 59,
18             hour => 23,
19             day => 30,
20             month => 11,
21             weekday => 6
22             );
23             @Mojar::Cron::Datetime::Max =
24             @Mojar::Cron::Datetime::Max{qw(sec min hour day month weekday)};
25              
26             # Class attributes
27             # (not usable on objects)
28              
29             # Constructors
30              
31             sub new {
32 256     256 1 2243 my $class = shift;
33 256         156 my $self;
34 256 100       474 if (ref $class) {
    100          
    100          
35             # Clone
36 71         96 $self = [ @$class ];
37 71         86 $class = ref $class;
38 71 50       104 carp sprintf 'Useless arguments to new (%s)', join ',', @_ if @_;
39             }
40             elsif (@_ == 0) {
41             # Zero member
42 1         3 $self = [0,0,0, 0,0,0];
43             }
44             elsif (@_ == 1) {
45             # Pre-generated
46 1 50       3 croak "Non-ref argument to new ($self)" unless ref($self = shift);
47             }
48             else {
49 183         272 $self = [ @_ ];
50             }
51 256         239 bless $self => $class;
52 256         286 return $self->normalise; # Calculate weekday etc
53             }
54              
55             sub from_string {
56 10     10 1 5066 my ($class, $iso_date) = @_;
57 10   66     38 $class = ref $class || $class;
58 10 50       54 if ($iso_date
59             =~ /^(\d{4})-(\d{2})-(\d{2})(?:T|\s)(\d{2}):(\d{2}):(\d{2})Z?$/) {
60 10         29 return $class->new(life_to_zero($6, $5, $4, $3, $2, $1));
61             }
62 0         0 croak "Failed to parse datetime string ($iso_date)";
63             }
64              
65             sub from_timestamp {
66 171     171 0 1559 my ($class, $timestamp, $is_local) = @_;
67 171   33     441 $class = ref $class || $class;
68 171 100       466 my @parts = $is_local ? localtime $timestamp
69             : gmtime $timestamp;
70 171         339 return $class->new( time_to_zero @parts );
71             }
72              
73 3     3 1 12 sub now { shift->from_timestamp(time, @_) }
74              
75             # Public methods
76              
77             sub copy {
78 34     34 1 29 my ($self, $original) = @_;
79 34 50       48 return unless ref $original;
80 34 50       45 return $self->clone(@_) unless ref $self;
81 34         46 @$self = @$original;
82 34         39 return $self;
83             }
84              
85             sub reset_parts {
86 354     354 0 277 my ($self, $end) = @_;
87 354         575 $$self[$_] = 0 for 0 .. $end;
88 354         377 return $self;
89             }
90              
91             sub weekday {
92 176     176 0 127 my $self = shift;
93 176         200 return +($self->normalise(@$self))[6];
94             }
95              
96             sub normalise {
97 1330     1330 1 893 my $self = shift;
98 1330 100       2195 my @parts = @_ ? @_ : @$self;
99 1330         1807 @parts = time_to_zero normalise_utc zero_to_time @parts;
100 1330 100       2905 return @parts if @_; # operating on argument
101              
102 1154         1596 @$self = @parts; # operating on invocant
103 1154         1740 return $self;
104             }
105              
106             sub to_timestamp {
107 154     154 0 418 my ($self, $is_local) = @_;
108 154 50       306 return $is_local ? local_to_ts zero_to_time @$self
109             : utc_to_ts zero_to_time @$self;
110             }
111              
112             sub to_string {
113 95     95 1 72 my $self = shift;
114 95 50 66     156 $self = shift if @_ and ref $_[0];
115 95   100     294 return strftime pop || '%Y-%m-%d %H:%M:%S', zero_to_time @$self;
116             }
117              
118             1;
119             __END__