cpan/Time-Piece/Seconds.pm

   1 package Time::Seconds;
   2 use strict;
   3
   4 our $VERSION = '1.31';
   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 pretty {
 149     my $s = shift;
 150     my $str = "";
 151     if ($s < 0) {
 152         $s = -$s;
 153         $str = "minus ";
 154     }
 155     if ($s >= ONE_MINUTE) {
 156         if ($s >= ONE_HOUR) {
 157             if ($s >= ONE_DAY) {
 158                 my $days = sprintf("%d", $s->days); # does a "floor"
 159                 $str .= $days . " days, ";
 160                 $s -= ($days * ONE_DAY);
 161             }
 162             my $hours = sprintf("%d", $s->hours);
 163             $str .= $hours . " hours, ";
 164             $s -= ($hours * ONE_HOUR);
 165         }
 166         my $mins = sprintf("%d", $s->minutes);
 167         $str .= $mins . " minutes, ";
 168         $s -= ($mins * ONE_MINUTE);
 169     }
 170     $str .= $s->seconds . " seconds";
 171     return $str;
 172 }
 173
 174 1;
 175 __END__
 176
 177 =encoding utf8
 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 COPYRIGHT AND LICENSE
 248
 249 Copyright 2001, Larry Wall.
 250
 251 This module is free software, you may distribute it under the same terms
 252 as Perl.
 253
 254 =head1 Bugs
 255
 256 Currently the methods aren't as efficient as they could be, for reasons of
 257 clarity. This is probably a bad idea.
 258
 259 =cut