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   213739 use Mojo::Base -strict;
  8         20  
  8         46  
3              
4             our $VERSION = 0.101;
5              
6 8     8   979 use Carp qw(carp croak);
  8         13  
  8         347  
7 8     8   3204 use Mojar::ClassShare 'have';
  8         4006  
  8         44  
8 8         681 use Mojar::Cron::Util qw(balance life_to_zero normalise_local normalise_utc
9 8     8   2938 time_to_zero zero_to_time utc_to_ts local_to_ts);
  8         31  
10 8     8   63 use POSIX 'strftime';
  8         14  
  8         46  
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 4977 my $class = shift;
33 256         278 my $self;
34 256 100       531 if (ref $class) {
    100          
    100          
35             # Clone
36 71         124 $self = [ @$class ];
37 71         94 $class = ref $class;
38 71 50       119 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       4 croak "Non-ref argument to new ($self)" unless ref($self = shift);
47             }
48             else {
49 183         338 $self = [ @_ ];
50             }
51 256         342 bless $self => $class;
52 256         406 return $self->normalise; # Calculate weekday etc
53             }
54              
55             sub from_string {
56 10     10 1 10241 my ($class, $iso_date) = @_;
57 10   66     48 $class = ref $class || $class;
58 10 50       91 if ($iso_date
59             =~ /^(\d{4})-(\d{2})-(\d{2})(?:T|\s)(\d{2}):(\d{2}):(\d{2})Z?$/) {
60 10         43 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 2143 my ($class, $timestamp, $is_local) = @_;
67 171   33     452 $class = ref $class || $class;
68 171 100       548 my @parts = $is_local ? localtime $timestamp
69             : gmtime $timestamp;
70 171         362 return $class->new( time_to_zero @parts );
71             }
72              
73 3     3 1 16 sub now { shift->from_timestamp(time, @_) }
74              
75             # Public methods
76              
77             sub copy {
78 34     34 1 50 my ($self, $original) = @_;
79 34 50       59 return unless ref $original;
80 34 50       50 return $self->clone(@_) unless ref $self;
81 34         56 @$self = @$original;
82 34         47 return $self;
83             }
84              
85             sub reset_parts {
86 354     354 0 485 my ($self, $end) = @_;
87 354         686 $$self[$_] = 0 for 0 .. $end;
88 354         499 return $self;
89             }
90              
91             sub weekday {
92 176     176 0 218 my $self = shift;
93 176         283 return +($self->normalise(@$self))[6];
94             }
95              
96             sub normalise {
97 1330     1330 1 1478 my $self = shift;
98 1330 100       2555 my @parts = @_ ? @_ : @$self;
99 1330         2496 @parts = time_to_zero normalise_utc zero_to_time @parts;
100 1330 100       2929 return @parts if @_; # operating on argument
101              
102 1154         1824 @$self = @parts; # operating on invocant
103 1154         2008 return $self;
104             }
105              
106             sub to_timestamp {
107 154     154 0 543 my ($self, $is_local) = @_;
108 154 50       291 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 129 my $self = shift;
114 95 50 66     186 $self = shift if @_ and ref $_[0];
115 95   100     285 return strftime pop || '%Y-%m-%d %H:%M:%S', zero_to_time @$self;
116             }
117              
118             1;
119             __END__