cpan/Time-Piece/Seconds.pm

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