File Coverage

blib/lib/Data/Quantity/Time/Date.pm
Criterion Covered Total %
statement 83 136 61.0
branch 7 44 15.9
condition 2 9 22.2
subroutine 24 32 75.0
pod 0 18 0.0
total 116 239 48.5


line stmt bran cond sub pod time code
1             ### Data::Quantity::Time::Date - A calendar day on earth during the modern epoch
2              
3             ### Change History
4             # 2001-02-21 Added Mon dd, yy format.
5             # 2001-02-07 Added yymmdd format.
6             # 2000-03-29 Added Month dd, yyyy format.
7             # 1999-12-05 Added mm/dd/yy format.
8             # 1999-11-22 Added mm/dd/yyyy format.
9             # 1999-08-13
10             # 1999-03-28 Added default format and error handling for readable method
11             # 1998-12-02 Created. -Simon
12              
13             package Data::Quantity::Time::Date;
14              
15             require 5;
16 1     1   6350 use strict;
  1         3  
  1         34  
17 1     1   5 use Carp;
  1         1  
  1         51  
18              
19 1     1   151610 use Time::Local;
  1         2860  
  1         88  
20 1     1   1237 use Time::JulianDay;
  1         6865  
  1         101  
21 1     1   861 use Time::ParseDate;
  1         7788  
  1         89  
22              
23 1     1   12 use vars qw( $VERSION );
  1         2  
  1         61  
24             $VERSION = 0.001;
25              
26 1     1   635 use Data::Quantity::Number::Integer '-isasubclass';
  1         4  
  1         11  
27              
28 1     1   522 use Data::Quantity::Time::Timestamp;
  1         3  
  1         13  
29 1     1   614 use Data::Quantity::Time::Year;
  1         3  
  1         17  
30 1     1   806 use Data::Quantity::Time::MonthOfYear;
  1         3  
  1         9  
31 1     1   681 use Data::Quantity::Time::DayOfMonth;
  1         3  
  1         11  
32 1     1   495 use Data::Quantity::Time::DayOfWeek;
  1         3  
  1         9  
33 1     1   489 use Data::Quantity::Time::YearAndMonth;
  1         4  
  1         11  
34              
35             # undef = Data::Quantity::Time::Date->scale();
36             sub scale {
37 0     0 0 0 return 'Date';
38             }
39              
40             sub type {
41 0     0 0 0 return 'temporal', 'absolute';
42             }
43              
44             # $date = Data::Quantity::Time::Date->current();
45             sub current {
46 0     0 0 0 my $class = shift;
47 0         0 my $date = $class->new_instance;
48 0         0 $date->set_udt( time() );
49 0         0 return $date;
50             }
51              
52             # $quantity->init( $n_val );
53             sub init {
54 1     1 0 6 my $num_q = shift;
55            
56 1         2 my $n_val = shift;
57 1         10 my $numerals = $num_q->numeric_value( $n_val );
58 1 50       4 if ( defined $numerals ) {
59 1         11 $num_q->value( $numerals );
60             } else {
61 0         0 $num_q->set_from_string( $n_val );
62             }
63             }
64              
65             # $date->set_from_string( $value );
66             sub set_from_string {
67 1     1 0 7 my ($date, $value) = @_;
68            
69 1 50       10 if ($value =~ /^\s*(?=1|2)(\d{4})\D?(\d{2})\D?(\d{2})\s*$/) {
70 1         5 my ($year, $month, $day) = ($1, $2, $3);
71 1         6 $date->set_from_raw_ymd($year, $month, $day);
72             } else {
73 0         0 my $udt = Time::ParseDate::parsedate($value, 'DATE_REQUIRED' => 1);
74 0 0       0 if ($udt) {
75 0         0 $date->set_udt($udt);
76             } else {
77 0         0 $date->value( 0 );
78             }
79             }
80             }
81              
82             # $dow_q = $date_q->dow();
83             sub dow {
84 0     0 0 0 my $date_q = shift;
85 0 0       0 my $j_day = $date_q->value or return;
86 0   0     0 Data::Quantity::Time::DayOfWeek->new( day_of_week($j_day) || 7 );
87             }
88              
89             # $y_q, $m_q, $d_q = $date_q->ymd();
90             sub ymd {
91 5     5 0 5 my $date_q = shift;
92 5   50     12 my $j_day = $date_q->value || return;
93 5         19 my ($y, $m, $d) = inverse_julian_day($j_day);
94             return (
95 5         89 Data::Quantity::Time::Year->new( $y ),
96             Data::Quantity::Time::MonthOfYear->new( $m ),
97             Data::Quantity::Time::DayOfMonth->new( $d )
98             );
99             }
100              
101             # $y_q, $m_q, $d_q = $date_q->ymd();
102             sub raw_ymd {
103 0     0 0 0 my $date_q = shift;
104 0   0     0 my $j_day = $date_q->value || return;
105 0         0 return inverse_julian_day($j_day);
106             }
107              
108             # $date_q->set_from_raw_ymd( $y, $m, $d );
109             sub set_from_raw_ymd {
110 1     1 0 2 my $date_q = shift;
111 1         5 $date_q->value( julian_day( @_ ) );
112             }
113              
114             # Data::Quantity::Time::Date->new_from_ymd( $y_q, $m_q, $d_q );
115             sub new_from_ymd {
116 2     2 0 3 my $class = shift;
117 2         6 my $date = $class->new_instance;
118 2         5 $date->set_from_ymd( @_ );
119 2         9 return $date;
120             }
121              
122             # $date->set_from_ymd( $y_q, $m_q, $d_q );
123             sub set_from_ymd {
124 2     2 0 4 my $date_q = shift;
125 2         3 my ($y_q, $m_q, $d_q) = @_;
126 2         4 my ($y, $m, $d) = map { $_->value } ($y_q, $m_q, $d_q);
  6         14  
127 2         9 $date_q->value( julian_day($y, $m, $d) );
128             }
129              
130             # $year_and_month_q = $date_q->year_and_month;
131             sub year_and_month {
132 2     2 0 3 my $date_q = shift;
133 2 50       7 my $j_day = $date_q->value or return;
134 2         7 my ($y, $m, $d) = inverse_julian_day($j_day);
135 2         29 return Data::Quantity::Time::YearAndMonth->new( Data::Quantity::Time::Year->new($y), Data::Quantity::Time::MonthOfYear->new($m) );
136             }
137              
138             # $seconds_since_1970 = $date_q->first_second;
139             sub first_second {
140 1     1 0 3 my $date_q = shift;
141 1 50       4 my $j_day = $date_q->value or return;
142 1         5 return Data::Quantity::Time::Timestamp->new( jd_secondslocal($j_day, 0, 0, 0) );
143             }
144              
145             # $seconds_since_1970 = $date_q->last_second;
146             sub last_second {
147 1     1 0 3 my $date_q = shift;
148 1 50       4 my $j_day = $date_q->value or return;
149 1         6 return Data::Quantity::Time::Timestamp->new( jd_secondslocal($j_day, 23, 59, 59) );
150             }
151              
152             # $seconds_since_1970 = $date_q->get_udt;
153             sub get_udt {
154 0     0 0 0 my $date_q = shift;
155 0 0       0 my $j_day = $date_q->value or return;
156 0         0 return jd_secondslocal($j_day, 0, 0, 0);
157             }
158              
159             # $date_q->set_udt( $seconds_since_1970 );
160             sub set_udt {
161 0     0 0 0 my $date_q = shift;
162 0         0 my $udt = shift;
163            
164 0         0 $date_q->value( local_julian_day($udt) );
165             }
166              
167 1     1   6 use vars qw( $default_readable_format );
  1         2  
  1         676  
168             $default_readable_format ||= 'mm/dd/yyyy';
169              
170             # $string = $quantity->readable( @_ );
171             # offer multiple modes, incl POSIX::strftime() or Time::CTime::strftime()
172             sub readable {
173 5     5 0 7 my $date_q = shift;
174 5         6 my $style = shift;
175 5   33     11 $style ||= $default_readable_format;
176 5 50       14 my $j_day = $date_q->value or return;
177 5 50       11 if ( $style eq 'dd Month yy' ) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
178 5         20 my ($y_q, $m_q, $d_q) = $date_q->ymd();
179 5         30 return join ' ', $d_q->readable, $m_q->readable, $y_q->readable;
180             } elsif ( $style eq 'Month dd, yyyy' ) {
181 0           my ($y_q, $m_q, $d_q) = $date_q->ymd();
182 0           return $m_q->readable . ' ' . $d_q->readable . ', ' . $y_q->readable;
183             } elsif ( $style eq 'Mon dd, yyyy' ) {
184 0           my ($y_q, $m_q, $d_q) = $date_q->ymd();
185 0           return $m_q->readable('short') . ' ' . $d_q->readable . ', ' . $y_q->readable;
186             } elsif ( $style eq 'Mon dd, yy' ) {
187 0           my ($y_q, $m_q, $d_q) = $date_q->ymd();
188 0           return $m_q->readable('short') . ' ' . $d_q->readable . ', ' . $y_q->two_digit_window;
189             } elsif ( $style eq 'Day, Mon dd, yy' ) {
190 0           my ($y_q, $m_q, $d_q) = $date_q->ymd();
191 0           my $dow = $date_q->dow();
192 0           return $dow->readable('short') . ', ' . $m_q->readable('short') . ' ' . $d_q->readable . ', ' . $y_q->two_digit_window;
193             } elsif ( $style eq 'Day, Mon dd' ) {
194 0           my ($y_q, $m_q, $d_q) = $date_q->ymd();
195 0           my $dow = $date_q->dow();
196 0           return $dow->readable('short') . ', ' . $m_q->readable('short') . ' ' . $d_q->readable;
197             } elsif ( $style eq 'Mon dd' ) {
198 0           my ($y_q, $m_q, $d_q) = $date_q->ymd();
199 0           return $m_q->readable('short') . ' ' . $d_q->readable;
200             } elsif ( $style eq 'dd Mon yy' ) {
201 0           my ($y_q, $m_q, $d_q) = $date_q->ymd();
202 0           return $d_q->readable . ' ' . $m_q->readable('short') . ' ' . $y_q->two_digit_window;
203             } elsif ( $style eq 'Month yyyy' ) {
204 0           my ($y_q, $m_q, $d_q) = $date_q->ymd();
205 0           return join ' ', $m_q->readable, $y_q->zero_padded;
206             } elsif ( $style eq 'yyyy-mm-dd' ) {
207 0           my ($y_q, $m_q, $d_q) = $date_q->ymd();
208 0           return join '-', $y_q->zero_padded, $m_q->zero_padded, $d_q->zero_padded;
209             } elsif ( $style eq 'mm/dd/yyyy' ) {
210 0           my ($y_q, $m_q, $d_q) = $date_q->ymd();
211 0           return join '/', $m_q->zero_padded, $d_q->zero_padded, $y_q->zero_padded;
212             } elsif ( $style eq 'mm/dd/yy' ) {
213 0           my ($y_q, $m_q, $d_q) = $date_q->ymd();
214 0           return join '/', $m_q->zero_padded, $d_q->zero_padded, $y_q->two_digit_window;
215             } elsif ( $style eq 'yymmdd' ) {
216 0           my ($y_q, $m_q, $d_q) = $date_q->ymd();
217 0           return join '', $y_q->two_digit_window(), $m_q->zero_padded, $d_q->zero_padded;
218             } else {
219 0           croak "Unknown date readable format: '$style'";
220             }
221             }
222              
223             # $value = Data::Quantity::Time::Date->readable_value($number)
224             # $value = Data::Quantity::Time::Date->readable_value($number, $style)
225             sub readable_value {
226 0     0 0   my $class_or_item = shift;
227 0           my $value = shift;
228 0           $class_or_item->new($value)->readable(@_);
229             }
230              
231             1;
232              
233             __END__