Tick!
[perl.git] / cpan / Time-Piece / Seconds.pm
1 package Time::Seconds;
2 use strict;
3
4 our $VERSION = '1.33';
5
6 use Exporter 5.57 'import';
7
8 our @EXPORT = qw(
9     ONE_MINUTE
10     ONE_HOUR
11     ONE_DAY
12     ONE_WEEK
13     ONE_MONTH
14     ONE_YEAR
15     ONE_FINANCIAL_MONTH
16     LEAP_YEAR
17     NON_LEAP_YEAR
18 );
19
20 our @EXPORT_OK = qw(cs_sec cs_mon);
21
22 use constant {
23     ONE_MINUTE => 60,
24     ONE_HOUR => 3_600,
25     ONE_DAY => 86_400,
26     ONE_WEEK => 604_800,
27     ONE_MONTH => 2_629_744, # ONE_YEAR / 12
28     ONE_YEAR => 31_556_930, # 365.24225 days
29     ONE_FINANCIAL_MONTH => 2_592_000, # 30 days
30     LEAP_YEAR => 31_622_400, # 366 * ONE_DAY
31     NON_LEAP_YEAR => 31_536_000, # 365 * ONE_DAY
32     # hacks to make Time::Piece compile once again
33     cs_sec => 0,
34     cs_mon => 1,
35 };
36
37 use overload
38     'fallback' => 'undef',
39     '0+' => \&seconds,
40     '""' => \&seconds,
41     '<=>' => \&compare,
42     '+' => \&add,
43     '-' => \&subtract,
44     '-=' => \&subtract_from,
45     '+=' => \&add_to,
46     '=' => \&copy;
47
48 sub new {
49     my $class = shift;
50     my ($val) = @_;
51     $val = 0 unless defined $val;
52     bless \$val, $class;
53 }
54
55 sub _get_ovlvals {
56     my ($lhs, $rhs, $reverse) = @_;
57     $lhs = $lhs->seconds;
58
59     if (UNIVERSAL::isa($rhs, 'Time::Seconds')) {
60         $rhs = $rhs->seconds;
61     }
62     elsif (ref($rhs)) {
63         die "Can't use non Seconds object in operator overload";
64     }
65
66     if ($reverse) {
67         return $rhs, $lhs;
68     }
69
70     return $lhs, $rhs;
71 }
72
73 sub compare {
74     my ($lhs, $rhs) = _get_ovlvals(@_);
75     return $lhs <=> $rhs;
76 }
77
78 sub add {
79     my ($lhs, $rhs) = _get_ovlvals(@_);
80     return Time::Seconds->new($lhs + $rhs);
81 }
82
83 sub add_to {
84     my $lhs = shift;
85     my $rhs = shift;
86     $rhs = $rhs->seconds if UNIVERSAL::isa($rhs, 'Time::Seconds');
87     $$lhs += $rhs;
88     return $lhs;
89 }
90
91 sub subtract {
92     my ($lhs, $rhs) = _get_ovlvals(@_);
93     return Time::Seconds->new($lhs - $rhs);
94 }
95
96 sub subtract_from {
97     my $lhs = shift;
98     my $rhs = shift;
99     $rhs = $rhs->seconds if UNIVERSAL::isa($rhs, 'Time::Seconds');
100     $$lhs -= $rhs;
101     return $lhs;
102 }
103
104 sub copy {
105         Time::Seconds->new(${$_[0]});
106 }
107
108 sub seconds {
109     my $s = shift;
110     return $$s;
111 }
112
113 sub minutes {
114     my $s = shift;
115     return $$s / 60;
116 }
117
118 sub hours {
119     my $s = shift;
120     $s->minutes / 60;
121 }
122
123 sub days {
124     my $s = shift;
125     $s->hours / 24;
126 }
127
128 sub weeks {
129     my $s = shift;
130     $s->days / 7;
131 }
132
133 sub months {
134     my $s = shift;
135     $s->days / 30.4368541;
136 }
137
138 sub financial_months {
139     my $s = shift;
140     $s->days / 30;
141 }
142
143 sub years {
144     my $s = shift;
145     $s->days / 365.24225;
146 }
147
148 sub _counted_objects {
149     my ($n, $counted) = @_;
150     my $number = sprintf("%d", $n); # does a "floor"
151     $counted .= 's' if 1 != $number;
152     return ($number, $counted);
153 }
154
155 sub pretty {
156     my $s = shift;
157     my $str = "";
158     if ($s < 0) {
159         $s = -$s;
160         $str = "minus ";
161     }
162     if ($s >= ONE_MINUTE) {
163         if ($s >= ONE_HOUR) {
164             if ($s >= ONE_DAY) {
165                 my ($days, $sd) = _counted_objects($s->days, "day");
166                 $str .= "$days $sd, ";
167                 $s -= ($days * ONE_DAY);
168             }
169             my ($hours, $sh) = _counted_objects($s->hours, "hour");
170             $str .= "$hours $sh, ";
171             $s -= ($hours * ONE_HOUR);
172         }
173         my ($mins, $sm) = _counted_objects($s->minutes, "minute");
174         $str .= "$mins $sm, ";
175         $s -= ($mins * ONE_MINUTE);
176     }
177     $str .= join " ", _counted_objects($s->seconds, "second");
178     return $str;
179 }
180
181 1;
182 __END__
183
184 =encoding utf8
185
186 =head1 NAME
187
188 Time::Seconds - a simple API to convert seconds to other date values
189
190 =head1 SYNOPSIS
191
192     use Time::Piece;
193     use Time::Seconds;
194     
195     my $t = localtime;
196     $t += ONE_DAY;
197     
198     my $t2 = localtime;
199     my $s = $t - $t2;
200     
201     print "Difference is: ", $s->days, "\n";
202
203 =head1 DESCRIPTION
204
205 This module is part of the Time::Piece distribution. It allows the user
206 to find out the number of minutes, hours, days, weeks or years in a given
207 number of seconds. It is returned by Time::Piece when you delta two
208 Time::Piece objects.
209
210 Time::Seconds also exports the following constants:
211
212     ONE_DAY
213     ONE_WEEK
214     ONE_HOUR
215     ONE_MINUTE
216     ONE_MONTH
217     ONE_YEAR
218     ONE_FINANCIAL_MONTH
219     LEAP_YEAR
220     NON_LEAP_YEAR
221
222 Since perl does not (yet?) support constant objects, these constants are in
223 seconds only, so you cannot, for example, do this: C<print ONE_WEEK-E<gt>minutes;>
224
225 =head1 METHODS
226
227 The following methods are available:
228
229     my $val = Time::Seconds->new(SECONDS)
230     $val->seconds;
231     $val->minutes;
232     $val->hours;
233     $val->days;
234     $val->weeks;
235     $val->months;
236     $val->financial_months; # 30 days
237     $val->years;
238     $val->pretty; # gives English representation of the delta
239
240 The usual arithmetic (+,-,+=,-=) is also available on the objects.
241
242 The methods make the assumption that there are 24 hours in a day, 7 days in
243 a week, 365.24225 days in a year and 12 months in a year.
244 (from The Calendar FAQ at http://www.tondering.dk/claus/calendar.html)
245
246 =head1 AUTHOR
247
248 Matt Sergeant, matt@sergeant.org
249
250 Tobias Brox, tobiasb@tobiasb.funcom.com
251
252 Balázs Szabó (dLux), dlux@kapu.hu
253
254 =head1 COPYRIGHT AND LICENSE
255
256 Copyright 2001, Larry Wall.
257
258 This module is free software, you may distribute it under the same terms
259 as Perl.
260
261 =head1 Bugs
262
263 Currently the methods aren't as efficient as they could be, for reasons of
264 clarity. This is probably a bad idea.
265
266 =cut