| 1 | package Time::Seconds; |
| 2 | use strict; |
| 3 | |
| 4 | our $VERSION = '1.34'; |
| 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 | '=' => \© |
| 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 |