cpan/Time-Piece/Seconds.pm

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