Open-ILS/src/perlmods/lib/OpenILS/Utils/DateTime.pm

   1 package OpenILS::Utils::DateTime;
   2
   3 use Time::Local;
   4 use Errno;
   5 use POSIX;
   6 use FileHandle;
   7 use Digest::MD5 qw(md5 md5_hex md5_base64);
   8 use Exporter;
   9 use DateTime;
  10 use DateTime::Duration;
  11 use DateTime::Format::ISO8601;
  12 use DateTime::TimeZone;
  13
  14 =head1 NAME
  15
  16 OpenILS::Utils::DateTime;
  17
  18 =head1 DESCRIPTION
  19
  20 This contains several routines for doing date and time calculation. This
  21 is derived from the date/time routines from OpenSRF::Utils.
  22
  23 =head1 VERSION
  24
  25 =cut
  26
  27 our $VERSION = 1.000;
  28
  29 use vars qw/@ISA $AUTOLOAD %EXPORT_TAGS @EXPORT_OK @EXPORT/;
  30 push @ISA, 'Exporter';
  31
  32 %EXPORT_TAGS = (
  33         datetime        => [qw(clean_ISO8601 gmtime_ISO8601 interval_to_seconds seconds_to_interval)],
  34 );
  35 Exporter::export_ok_tags('datetime');  # add aa, cc and dd to @EXPORT_OK
  36
  37 our $date_parser = DateTime::Format::ISO8601->new;
  38
  39 =head1 METHODS
  40
  41
  42 =cut
  43
  44 sub AUTOLOAD {
  45         my $self = shift;
  46         my $type = ref($self) or return undef;
  47
  48         my $name = $AUTOLOAD;
  49         $name =~ s/.*://;   # strip fully-qualified portion
  50
  51         if (defined($_[0])) {
  52                 return $self->{$name} = shift;
  53         }
  54         return $self->{$name};
  55 }
  56
  57 =head2 $thing->interval_to_seconds('interval', ['context']) OR interval_to_seconds('interval', ['context'])
  58
  59 =head2 $thing->seconds_to_interval($seconds) OR seconds_to_interval($seconds)
  60
  61 Returns the number of seconds for any interval passed, or the interval for the seconds.
  62 This is the generic version of B<interval> listed below.
  63
  64 The interval must match the regex I</\s*\+?\s*(\d+)\s*(\w{1})\w*\s*/g>, for example
  65 B<2 weeks, 3 d and 1hour + 17 Months> or
  66 B<1 year, 5 Months, 2 weeks, 3 days and 1 hour of seconds> meaning 46148400 seconds.
  67
  68         my $expire_time = time() + $thing->interval_to_seconds('17h 9m');
  69
  70 The time size indicator may be one of
  71
  72 =over 2
  73
  74 =item s[econd[s]]
  75
  76 for seconds
  77
  78 =item m[inute[s]]
  79
  80 for minutes
  81
  82 =item h[our[s]]
  83
  84 for hours
  85
  86 =item d[ay[s]]
  87
  88 for days
  89
  90 =item w[eek[s]]
  91
  92 for weeks
  93
  94 =item M[onth[s]]
  95
  96 for months (really (365 * 1d)/12 ... that may get smarter, though)
  97
  98 =item y[ear[s]]
  99
 100 for years (this is 365 * 1d)
 101
 102 Passing in an optional 'context' (DateTime object) will give you the number of seconds for the passed interval *starting from* the given date (e.g. '1 month' from a context of 'February 1' would return the number of seconds needed to get to 'March 1', not the generic calculation of 1/12 of the seconds in a normal year).
 103
 104 =back
 105
 106 =cut
 107 sub interval_to_seconds {
 108     my $class = shift; # throwaway
 109     my $interval = ($class eq __PACKAGE__) ? shift : $class;
 110     my $context = shift;
 111
 112     $interval =~ s/(\d{2}):(\d{2}):(\d{2})/ $1 h $2 min $3 s /go;
 113
 114     $interval =~ s/and/,/g;
 115     $interval =~ s/,/ /g;
 116
 117     my $amount;
 118     if ($context) {
 119         my $dur = DateTime::Duration->new();
 120         while ($interval =~ /\s*([\+-]?)\s*(\d+)\s*(\w+)\s*/g) {
 121             my ($sign, $count, $type) = ($1, $2, $3);
 122             my $func = ($sign eq '-') ? 'subtract' : 'add';
 123             if ($type =~ /^s/) {
 124                 $type = 'seconds';
 125             } elsif ($type =~ /^m(?!o)/oi) {
 126                 $type = 'minutes';
 127             } elsif ($type =~ /^h/) {
 128                 $type = 'hours';
 129             } elsif ($type =~ /^d/oi) {
 130                 $type = 'days';
 131             } elsif ($type =~ /^w/oi) {
 132                 $type = 'weeks';
 133             } elsif ($type =~ /^mo/io) {
 134                 $type = 'months';
 135             } elsif ($type =~ /^y/oi) {
 136                 $type = 'years';
 137             }
 138             $dur->$func($type => $count);
 139         }
 140         my $later = $context->clone->add_duration($dur);
 141         $amount = $later->subtract_datetime_absolute($context)->in_units( 'seconds' );
 142     } else {
 143         $amount = 0;
 144         while ($interval =~ /\s*([\+-]?)\s*(\d+)\s*(\w+)\s*/g) {
 145             my ($sign, $count, $type) = ($1, $2, $3);
 146             $count = "$sign$count" if ($sign);
 147             $amount += $count if ($type =~ /^s/);
 148             $amount += 60 * $count if ($type =~ /^m(?!o)/oi);
 149             $amount += 60 * 60 * $count if ($type =~ /^h/);
 150             $amount += 60 * 60 * 24 * $count if ($type =~ /^d/oi);
 151             $amount += 60 * 60 * 24 * 7 * $count if ($type =~ /^w/oi);
 152             $amount += ((60 * 60 * 24 * 365)/12) * $count if ($type =~ /^mo/io);
 153             $amount += 60 * 60 * 24 * 365 * $count if ($type =~ /^y/oi);
 154         }
 155     }
 156     return $amount;
 157 }
 158
 159 sub seconds_to_interval {
 160         my $self = shift;
 161         my $interval = shift || $self;
 162
 163         my $limit = shift || 's';
 164         $limit =~ s/^(.)/$1/o;
 165
 166         my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s,$string);
 167         my ($year, $month, $week, $day, $hour, $minute, $second) =
 168                 ('year','Month','week','day', 'hour', 'minute', 'second');
 169
 170         if ($y = int($interval / (60 * 60 * 24 * 365))) {
 171                 $string = "$y $year". ($y > 1 ? 's' : '');
 172                 $ym = $interval % (60 * 60 * 24 * 365);
 173         } else {
 174                 $ym = $interval;
 175         }
 176         return $string if ($limit eq 'y');
 177
 178         if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
 179                 $string .= ($string ? ', ':'')."$M $month". ($M > 1 ? 's' : '');
 180                 $Mm = $ym % ((60 * 60 * 24 * 365)/12);
 181         } else {
 182                 $Mm = $ym;
 183         }
 184         return $string if ($limit eq 'M');
 185
 186         if ($w = int($Mm / 604800)) {
 187                 $string .= ($string ? ', ':'')."$w $week". ($w > 1 ? 's' : '');
 188                 $wm = $Mm % 604800;
 189         } else {
 190                 $wm = $Mm;
 191         }
 192         return $string if ($limit eq 'w');
 193
 194         if ($d = int($wm / 86400)) {
 195                 $string .= ($string ? ', ':'')."$d $day". ($d > 1 ? 's' : '');
 196                 $dm = $wm % 86400;
 197         } else {
 198                 $dm = $wm;
 199         }
 200         return $string if ($limit eq 'd');
 201
 202         if ($h = int($dm / 3600)) {
 203                 $string .= ($string ? ', ' : '')."$h $hour". ($h > 1 ? 's' : '');
 204                 $hm = $dm % 3600;
 205         } else {
 206                 $hm = $dm;
 207         }
 208         return $string if ($limit eq 'h');
 209
 210         if ($m = int($hm / 60)) {
 211                 $string .= ($string ? ', ':'')."$m $minute". ($m > 1 ? 's' : '');
 212                 $mm = $hm % 60;
 213         } else {
 214                 $mm = $hm;
 215         }
 216         return $string if ($limit eq 'm');
 217
 218         if ($s = int($mm)) {
 219                 $string .= ($string ? ', ':'')."$s $second". ($s > 1 ? 's' : '');
 220         } else {
 221                 $string = "0s" unless ($string);
 222         }
 223         return $string;
 224 }
 225
 226 sub gmtime_ISO8601 {
 227         my $self = shift;
 228         my @date = gmtime;
 229
 230         my $y = $date[5] + 1900;
 231         my $M = $date[4] + 1;
 232         my $d = $date[3];
 233         my $h = $date[2];
 234         my $m = $date[1];
 235         my $s = $date[0];
 236
 237         return sprintf('%d-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d+00:00', $y, $M, $d, $h, $m, $s);
 238 }
 239
 240 =head2 clean_ISO8601($date_string)
 241
 242 Given a date string or a date/time string in a variety of ad-hoc
 243 formats, returns an ISO8601-formatted date/time string.
 244
 245 The date portion of the input is expected to consist of a four-digit
 246 year, followed by a two-digit month, followed by a two-digit year,
 247 with each part optionally separated by a hyphen.  If there is
 248 only a date portion, it will be normalized to use hyphens.
 249
 250 If there is no time portion in the input, "T00:00:00" is appended
 251 before the results are returned.
 252
 253 For example, "20180917" would become "2018-09-17T00:00:00".
 254
 255 If the input does not have a recognizable date, it is simply
 256 returned as is.
 257
 258 If there is a time portion, it is expected to consist of two-digit
 259 hour, minutes, and seconds delimited by colons.  That time is
 260 appended to the return with "T" separting the date and time
 261 portions.
 262
 263 If there is an ISO8601-style numeric timezone offset, it is
 264 normalized and appended to the return. If there is no timezone
 265 offset supplied in the input, the offset of the server's
 266 time zone is append to the return. Note that as implied above,
 267 if only a date is supplied, the return value does not include a
 268 timezone offset.
 269
 270 For example, for a server running in U.S. Eastern Daylight
 271 Savings time, "20180917 08:31:15" would become "2018-09-17T08:31:15-04:00".
 272
 273 =cut
 274
 275 sub clean_ISO8601 {
 276         my $self = shift;
 277         my $date = shift || $self;
 278         if ($date =~ /^\s*(\d{4})-?(\d{2})-?(\d{2})/o) {
 279                 my $new_date = "$1-$2-$3";
 280
 281                 if ($date =~/(\d{2}):(\d{2}):(\d{2})/o) {
 282                         $new_date .= "T$1:$2:$3";
 283
 284                         my $z;
 285                         if ($date =~ /([-+]{1})([0-9]{1,2})(?::?([0-9]{1,2}))*\s*$/o) {
 286                                 $z = sprintf('%s%0.2d%0.2d',$1,$2,$3)
 287                         } elsif ($date =~ /Z\s*$/) {
 288                                 $z = "+00:00";
 289                         } else {
 290                                 $z =  DateTime::TimeZone::offset_as_string(
 291                                         DateTime::TimeZone
 292                                                 ->new( name => 'local' )
 293                                                 ->offset_for_datetime(
 294                                                         $date_parser->parse_datetime($new_date)
 295                                                 )
 296                                 );
 297                         }
 298
 299                         if (length($z) > 3 && index($z, ':') == -1) {
 300                                 substr($z,3,0) = ':';
 301                                 substr($z,6,0) = ':' if (length($z) > 6);
 302                         }
 303
 304                         $new_date .= $z;
 305                 } else {
 306                         $new_date .= "T00:00:00";
 307                 }
 308
 309                 return $new_date;
 310         }
 311         return $date;
 312 }
 313
 314 1;