LP#1635737 Add optional context to interval_to_seconds
[OpenSRF.git] / src / perl / lib / OpenSRF / Utils.pm
1 package OpenSRF::Utils;
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 OpenSRF::Utils
17
18 =head1 DESCRIPTION
19
20 This is a container package for methods that are useful to derived modules.
21 It has no constructor, and is generally not useful by itself... but this
22 is where most of the generic methods live.
23
24 =head1 VERSION
25
26 =cut
27
28 our $VERSION = 1.000;
29
30 use vars qw/@ISA $AUTOLOAD %EXPORT_TAGS @EXPORT_OK @EXPORT/;
31 push @ISA, 'Exporter';
32
33 %EXPORT_TAGS = (
34         common          => [qw(interval_to_seconds seconds_to_interval sendmail tree_filter)],
35         daemon          => [qw(safe_fork set_psname daemonize)],
36         datetime        => [qw(clense_ISO8601 cleanse_ISO8601 gmtime_ISO8601 interval_to_seconds seconds_to_interval)],
37 );
38 Exporter::export_ok_tags('common','daemon','datetime');  # add aa, cc and dd to @EXPORT_OK
39
40 our $date_parser = DateTime::Format::ISO8601->new;
41
42 =head1 METHODS
43
44
45 =cut
46
47 sub AUTOLOAD {
48         my $self = shift;
49         my $type = ref($self) or return undef;
50
51         my $name = $AUTOLOAD;
52         $name =~ s/.*://;   # strip fully-qualified portion
53
54         if (defined($_[0])) {
55                 return $self->{$name} = shift;
56         }
57         return $self->{$name};
58 }
59
60
61 sub _sub_builder {
62         my $self = shift;
63         my $class = ref($self) || $self;
64         my $part = shift;
65         unless ($class->can($part)) {
66                 *{$class.'::'.$part} =
67                         sub {
68                                 my $self = shift;
69                                 my $new_val = shift;
70                                 if ($new_val) {
71                                         $$self{$part} = $new_val;
72                                 }
73                                 return $$self{$part};
74                 };
75         }
76 }
77
78 sub tree_filter {
79         my $tree = shift;
80         my $field = shift;
81         my $filter = shift;
82
83         my @things = $filter->($tree);
84         for my $v ( @{$tree->$field} ){
85                 push @things, $filter->($v);
86                 push @things, tree_filter($v, $field, $filter);
87         }
88         return @things
89 }
90
91 #sub standalone_ipc_cache {
92 #       my $self = shift;
93 #       my $class = ref($self) || $self;
94 #       my $uniquifier = shift || return undef;
95 #       my $expires = shift || 3600;
96
97 #       return new Cache::FileCache ( { namespace => $class.'::'.$uniquifier, default_expires_in => $expires } );
98 #}
99
100 sub sendmail {
101         my $self = shift;
102         my $message = shift || $self;
103
104         open SM, '|/usr/sbin/sendmail -U -t' or return 0;
105         print SM $message;
106         close SM or return 0;
107         return 1;
108 }
109
110 sub __strip_comments {
111         my $self = shift;
112         my $config_file = shift;
113         my ($line, @done);
114         while (<$config_file>) {
115                 s/^\s*(.*)\s*$/$1/o if (lc($$self{keep_space}) ne 'true');
116                 /^(.*)$/o;
117                 $line .= $1;
118                 # keep new lines if keep_space is true
119                 if ($line =~ /^$/o && (lc($$self{keep_space}) ne 'true')) {
120                         $line = '';
121                         next;
122                 }
123                 if (/^([^<]+)\s*<<\s*(\w+)\s*$/o) {
124                         $line = "$1 = ";
125                         my $breaker = $2;
126                         while (<$config_file>) {
127                                 chomp;
128                                 last if (/^$breaker/);
129                                 $line .= $_;
130                         }
131                 }
132
133                 if ($line =~ /^#/ && $line !~ /^#\s*include\s+/o) {
134                         $line = '';
135                         next;
136                 }
137                 if ($line =~ /\\$/o) {
138                         chomp $line;
139                         $line =~ s/^\s*(.*)\s*\\$/$1/o;
140                         next;
141                 }
142                 push @done, $line;
143                 $line = '';
144         }
145         return @done;
146 }
147
148
149 =head2 $thing->encrypt(@stuff)
150
151 Returns a one way hash (MD5) of the values appended together.
152
153 =cut
154
155 sub encrypt {
156         my $self = shift;
157         return md5_hex(join('',@_));
158 }
159
160 =head2 $utils_obj->es_time('field') OR noo_es_time($timestamp)
161
162 Returns the epoch-second style timestamp for the value stored in
163 $utils_obj->{field}.  Returns B<0> for an empty or invalid date stamp, and
164 assumes a PostgreSQL style datestamp to be supplied.
165
166 =cut
167
168 sub es_time {
169         my $self = shift;
170         my $part = shift;
171         my $es_part = $part.'_ES';
172         return $$self{$es_part} if (exists($$self{$es_part}) && defined($$self{$es_part}) && $$self{$es_part});
173         if (!$$self{$part} or $$self{$part} !~ /\d+/) {
174                 return 0;
175
176         }
177         my @tm = reverse($$self{$part} =~ /([\d\.]+)/og);
178         if ($tm[5] > 0) {
179                 $tm[5] -= 1;
180         }
181
182         return $$self{$es_part} = noo_es_time($$self{$part});
183 }
184
185 =head2 noo_es_time($timestamp) (non-OO es_time)
186
187 Returns the epoch-second style timestamp for the B<$timestamp> passed
188 in.  Returns B<0> for an empty or invalid date stamp, and
189 assumes a PostgreSQL style datestamp to be supplied.
190
191 =cut
192
193 sub noo_es_time {
194         my $timestamp = shift;
195
196         my @tm = reverse($timestamp =~ /([\d\.]+)/og);
197         if ($tm[5] > 0) {
198                 $tm[5] -= 1;
199         }
200         return timelocal(int($tm[1]), int($tm[2]), int($tm[3]), int($tm[4]) || 1, int($tm[5]), int($tm[6]) || 2002 );
201 }
202
203
204 =head2 $thing->interval_to_seconds('interval', ['context']) OR interval_to_seconds('interval', ['context'])
205
206 =head2 $thing->seconds_to_interval($seconds) OR seconds_to_interval($seconds)
207
208 Returns the number of seconds for any interval passed, or the interval for the seconds.
209 This is the generic version of B<interval> listed below.
210
211 The interval must match the regex I</\s*\+?\s*(\d+)\s*(\w{1})\w*\s*/g>, for example
212 B<2 weeks, 3 d and 1hour + 17 Months> or
213 B<1 year, 5 Months, 2 weeks, 3 days and 1 hour of seconds> meaning 46148400 seconds.
214
215         my $expire_time = time() + $thing->interval_to_seconds('17h 9m');
216
217 The time size indicator may be one of
218
219 =over 2
220
221 =item s[econd[s]]
222
223 for seconds
224
225 =item m[inute[s]]
226
227 for minutes
228
229 =item h[our[s]]
230
231 for hours
232
233 =item d[ay[s]]
234
235 for days
236
237 =item w[eek[s]]
238
239 for weeks
240
241 =item M[onth[s]]
242
243 for months (really (365 * 1d)/12 ... that may get smarter, though)
244
245 =item y[ear[s]]
246
247 for years (this is 365 * 1d)
248
249 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).
250
251 =back
252
253 =cut
254 sub interval_to_seconds {
255     my $class = shift; # throwaway
256     my $interval = ($class eq __PACKAGE__) ? shift : $class;
257     my $context = shift;
258
259     $interval =~ s/(\d{2}):(\d{2}):(\d{2})/ $1 h $2 min $3 s /go;
260
261     $interval =~ s/and/,/g;
262     $interval =~ s/,/ /g;
263
264     my $amount;
265     if ($context) {
266         my $dur = DateTime::Duration->new();
267         while ($interval =~ /\s*([\+-]?)\s*(\d+)\s*(\w+)\s*/g) {
268             my ($sign, $count, $type) = ($1, $2, $3);
269             my $func = ($sign eq '-') ? 'subtract' : 'add';
270             if ($type =~ /^s/) {
271                 $type = 'seconds';
272             } elsif ($type =~ /^m(?!o)/oi) {
273                 $type = 'minutes';
274             } elsif ($type =~ /^h/) {
275                 $type = 'hours';
276             } elsif ($type =~ /^d/oi) {
277                 $type = 'days';
278             } elsif ($type =~ /^w/oi) {
279                 $type = 'weeks';
280             } elsif ($type =~ /^mo/io) {
281                 $type = 'months';
282             } elsif ($type =~ /^y/oi) {
283                 $type = 'years';
284             }
285             $dur->$func($type => $count);
286         }
287         my $later = $context->clone->add_duration($dur);
288         $amount = $later->subtract_datetime_absolute($context)->in_units( 'seconds' );
289     } else {
290         $amount = 0;
291         while ($interval =~ /\s*([\+-]?)\s*(\d+)\s*(\w+)\s*/g) {
292             my ($sign, $count, $type) = ($1, $2, $3);
293             $count = "$sign$count" if ($sign);
294             $amount += $count if ($type =~ /^s/);
295             $amount += 60 * $count if ($type =~ /^m(?!o)/oi);
296             $amount += 60 * 60 * $count if ($type =~ /^h/);
297             $amount += 60 * 60 * 24 * $count if ($type =~ /^d/oi);
298             $amount += 60 * 60 * 24 * 7 * $count if ($type =~ /^w/oi);
299             $amount += ((60 * 60 * 24 * 365)/12) * $count if ($type =~ /^mo/io);
300             $amount += 60 * 60 * 24 * 365 * $count if ($type =~ /^y/oi);
301         }
302     }
303     return $amount;
304 }
305
306 sub seconds_to_interval {
307         my $self = shift;
308         my $interval = shift || $self;
309
310         my $limit = shift || 's';
311         $limit =~ s/^(.)/$1/o;
312
313         my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s,$string);
314         my ($year, $month, $week, $day, $hour, $minute, $second) =
315                 ('year','Month','week','day', 'hour', 'minute', 'second');
316
317         if ($y = int($interval / (60 * 60 * 24 * 365))) {
318                 $string = "$y $year". ($y > 1 ? 's' : '');
319                 $ym = $interval % (60 * 60 * 24 * 365);
320         } else {
321                 $ym = $interval;
322         }
323         return $string if ($limit eq 'y');
324
325         if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
326                 $string .= ($string ? ', ':'')."$M $month". ($M > 1 ? 's' : '');
327                 $Mm = $ym % ((60 * 60 * 24 * 365)/12);
328         } else {
329                 $Mm = $ym;
330         }
331         return $string if ($limit eq 'M');
332
333         if ($w = int($Mm / 604800)) {
334                 $string .= ($string ? ', ':'')."$w $week". ($w > 1 ? 's' : '');
335                 $wm = $Mm % 604800;
336         } else {
337                 $wm = $Mm;
338         }
339         return $string if ($limit eq 'w');
340
341         if ($d = int($wm / 86400)) {
342                 $string .= ($string ? ', ':'')."$d $day". ($d > 1 ? 's' : '');
343                 $dm = $wm % 86400;
344         } else {
345                 $dm = $wm;
346         }
347         return $string if ($limit eq 'd');
348
349         if ($h = int($dm / 3600)) {
350                 $string .= ($string ? ', ' : '')."$h $hour". ($h > 1 ? 's' : '');
351                 $hm = $dm % 3600;
352         } else {
353                 $hm = $dm;
354         }
355         return $string if ($limit eq 'h');
356
357         if ($m = int($hm / 60)) {
358                 $string .= ($string ? ', ':'')."$m $minute". ($m > 1 ? 's' : '');
359                 $mm = $hm % 60;
360         } else {
361                 $mm = $hm;
362         }
363         return $string if ($limit eq 'm');
364
365         if ($s = int($mm)) {
366                 $string .= ($string ? ', ':'')."$s $second". ($s > 1 ? 's' : '');
367         } else {
368                 $string = "0s" unless ($string);
369         }
370         return $string;
371 }
372
373 sub full {
374         my $self = shift;
375         $$self{empty} = 0;
376 }
377
378 =head2 $utils_obj->set_psname('string') OR set_psname('string')
379
380 Sets the name of this process in a B<ps> listing to B<string>.
381
382
383 =cut
384
385 sub set_psname {
386         my $self = shift;
387         my $PS_NAME = shift || $self;
388         $0 = $PS_NAME if ($PS_NAME);
389 }
390
391 sub gmtime_ISO8601 {
392         my $self = shift;
393         my @date = gmtime;
394
395         my $y = $date[5] + 1900;
396         my $M = $date[4] + 1;
397         my $d = $date[3];
398         my $h = $date[2];
399         my $m = $date[1];
400         my $s = $date[0];
401
402         return sprintf('%d-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d+00:00', $y, $M, $d, $h, $m, $s);
403 }
404
405 sub cleanse_ISO8601 {
406         my $self = shift;
407         my $date = shift || $self;
408         if ($date =~ /^\s*(\d{4})-?(\d{2})-?(\d{2})/o) {
409                 my $new_date = "$1-$2-$3";
410
411                 if ($date =~/(\d{2}):(\d{2}):(\d{2})/o) {
412                         $new_date .= "T$1:$2:$3";
413
414                         my $z;
415                         if ($date =~ /([-+]{1})([0-9]{1,2})(?::?([0-9]{1,2}))*\s*$/o) {
416                                 $z = sprintf('%s%0.2d%0.2d',$1,$2,$3)
417                         } else {
418                                 $z =  DateTime::TimeZone::offset_as_string(
419                                         DateTime::TimeZone
420                                                 ->new( name => 'local' )
421                                                 ->offset_for_datetime(
422                                                         $date_parser->parse_datetime($new_date)
423                                                 )
424                                 );
425                         }
426
427                         if (length($z) > 3 && index($z, ':') == -1) {
428                                 substr($z,3,0) = ':';
429                                 substr($z,6,0) = ':' if (length($z) > 6);
430                         }
431                 
432                         $new_date .= $z;
433                 } else {
434                         $new_date .= "T00:00:00";
435                 }
436
437                 return $new_date;
438         }
439         return $date;
440 }
441
442 sub clense_ISO8601 { return cleanse_ISO8601(@_); }
443
444 =head2 $utils_obj->daemonize('ps_name') OR daemonize('ps_name')
445
446 Turns the current process into a daemon.  B<ps_name> is optional, and is used
447 as the argument to I<< set_psname() >> if passed.
448
449
450 =cut
451
452 sub daemonize {
453         my $self = shift;
454         my $PS_NAME = shift || $self;
455         my $pid;
456         if ($pid = safe_fork($self)) {
457                 exit 0;
458         } elsif (defined($pid)) {
459                 set_psname($PS_NAME);
460                 chdir '/';
461                 setsid;
462                 return $$;
463         }
464 }
465
466 =head2 $utils_obj->safe_fork('ps_name') OR safe_fork('ps_name');
467
468 Forks the current process in a retry loop.  B<ps_name> is optional, and is used
469 as the argument to I<< set_psname() >> if passed.
470
471
472 =cut
473
474 sub safe_fork {
475         my $self = shift;
476         my $pid;
477
478 FORK:
479         {
480                 if (defined($pid = fork())) {
481                         srand(time ^ ($$ + ($$ << 15))) unless ($pid);
482                         return $pid;
483                 } elsif ($! == EAGAIN) {
484                         $self->error("Can't fork()!  $!, taking 5 and trying again.") if (ref $self);
485                         sleep 5;
486                         redo FORK;
487                 } else {
488                         $self->error("Can't fork()! $!") if ($! && ref($self));
489                         exit $!;
490                 }
491         }
492 }
493
494 #------------------------------------------------------------------------------------------------------------------------------------
495
496
497 1;