added date clenser so we can use DateTime::Format::ISO8601
[Evergreen.git] / OpenSRF / src / perlmods / OpenSRF / Utils.pm
1 package OpenSRF::Utils;
2
3 =head1 NAME 
4
5 OpenSRF::Utils
6
7 =head1 DESCRIPTION 
8
9 This is a container package for methods that are useful to derived modules.
10 It has no constructor, and is generally not useful by itself... but this
11 is where most of the generic methods live.
12  
13
14 =head1 METHODS 
15
16
17 =cut
18
19 use vars qw/@ISA $AUTOLOAD %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION/;
20 push @ISA, 'Exporter';
21
22 $VERSION = do { my @r=(q$Revision$=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
23
24 use Time::Local;
25 use Errno;
26 use POSIX;
27 use FileHandle;
28 #use Cache::FileCache;
29 #use Storable qw(dclone);
30 use Digest::MD5 qw(md5 md5_hex md5_base64);
31 use Exporter;
32
33 # This turns errors into warnings, so daemons don't die.
34 #$Storable::forgive_me = 1;
35
36 %EXPORT_TAGS = (common => [qw(interval_to_seconds seconds_to_interval sendmail)], daemon => [qw(safe_fork set_psname daemonize)]);
37
38 Exporter::export_ok_tags('common','daemon');  # add aa, cc and dd to @EXPORT_OK
39
40 sub AUTOLOAD {
41         my $self = shift;
42         my $type = ref($self) or return undef;
43
44         my $name = $AUTOLOAD;
45         $name =~ s/.*://;   # strip fully-qualified portion
46
47         if (defined($_[0])) {
48                 return $self->{$name} = shift;
49         }
50         return $self->{$name};
51 }
52
53
54 sub _sub_builder {
55         my $self = shift;
56         my $class = ref($self) || $self;
57         my $part = shift;
58         unless ($class->can($part)) {
59                 *{$class.'::'.$part} =
60                         sub {
61                                 my $self = shift;
62                                 my $new_val = shift;
63                                 if ($new_val) {
64                                         $$self{$part} = $new_val;
65                                 }
66                                 return $$self{$part};
67                 };
68         }
69 }
70
71 #sub standalone_ipc_cache {
72 #       my $self = shift;
73 #       my $class = ref($self) || $self;
74 #       my $uniquifier = shift || return undef;
75 #       my $expires = shift || 3600;
76
77 #       return new Cache::FileCache ( { namespace => $class.'::'.$uniquifier, default_expires_in => $expires } );
78 #}
79
80 sub sendmail {
81         my $self = shift;
82         my $message = shift || $self;
83
84         open SM, '|/usr/sbin/sendmail -U -t' or return 0;
85         print SM $message;
86         close SM or return 0;
87         return 1;
88 }
89
90 sub __strip_comments {
91         my $self = shift;
92         my $config_file = shift;
93         my ($line, @done);
94         while (<$config_file>) {
95                 s/^\s*(.*)\s*$/$1/o if (lc($$self{keep_space}) ne 'true');
96                 /^(.*)$/o;
97                 $line .= $1;
98                 # keep new lines if keep_space is true
99                 if ($line =~ /^$/o && (lc($$self{keep_space}) ne 'true')) {
100                         $line = '';
101                         next;
102                 }
103                 if (/^([^<]+)\s*<<\s*(\w+)\s*$/o) {
104                         $line = "$1 = ";
105                         my $breaker = $2;
106                         while (<$config_file>) {
107                                 chomp;
108                                 last if (/^$breaker/);
109                                 $line .= $_;
110                         }
111                 }
112
113                 if ($line =~ /^#/ && $line !~ /^#\s*include\s+/o) {
114                         $line = '';
115                         next;
116                 }
117                 if ($line =~ /\\$/o) {
118                         chomp $line;
119                         $line =~ s/^\s*(.*)\s*\\$/$1/o;
120                         next;
121                 }
122                 push @done, $line;
123                 $line = '';
124         }
125         return @done;
126 }
127
128
129 =head2 $thing->encrypt(@stuff)
130
131 Returns a one way hash (MD5) of the values appended together.
132
133 =cut
134
135 sub encrypt {
136         my $self = shift;
137         return md5_hex(join('',@_));
138 }
139
140 =head2 $utils_obj->es_time('field') OR noo_es_time($timestamp)
141
142 Returns the epoch-second style timestamp for the value stored in
143 $utils_obj->{field}.  Returns B<0> for an empty or invalid date stamp, and
144 assumes a PostgreSQL style datestamp to be supplied.
145
146 =cut
147
148 sub es_time {
149         my $self = shift;
150         my $part = shift;
151         my $es_part = $part.'_ES';
152         return $$self{$es_part} if (exists($$self{$es_part}) && defined($$self{$es_part}) && $$self{$es_part});
153         if (!$$self{$part} or $$self{$part} !~ /\d+/) {
154                 return 0;
155
156         }
157         my @tm = reverse($$self{$part} =~ /([\d\.]+)/og);
158         if ($tm[5] > 0) {
159                 $tm[5] -= 1;
160         }
161
162         return $$self{$es_part} = noo_es_time($$self{$part});
163 }
164
165 =head2 noo_es_time($timestamp) (non-OO es_time)
166
167 Returns the epoch-second style timestamp for the B<$timestamp> passed
168 in.  Returns B<0> for an empty or invalid date stamp, and
169 assumes a PostgreSQL style datestamp to be supplied.
170
171 =cut
172
173 sub noo_es_time {
174         my $timestamp = shift;
175
176         my @tm = reverse($timestamp =~ /([\d\.]+)/og);
177         if ($tm[5] > 0) {
178                 $tm[5] -= 1;
179         }
180         return timelocal(int($tm[1]), int($tm[2]), int($tm[3]), int($tm[4]) || 1, int($tm[5]), int($tm[6]) || 2002 );
181 }
182
183
184 =head2 $thing->interval_to_seconds('interval') OR interval_to_seconds('interval')
185
186 =head2 $thing->seconds_to_interval($seconds) OR seconds_to_interval($seconds)
187
188 Returns the number of seconds for any interval passed, or the interval for the seconds.
189 This is the generic version of B<interval> listed below.
190
191 The interval must match the regex I</\s*\+?\s*(\d+)\s*(\w{1})\w*\s*/g>, for example
192 B<2 weeks, 3 d and 1hour + 17 Months> or
193 B<1 year, 5 Months, 2 weeks, 3 days and 1 hour of seconds> meaning 46148400 seconds.
194
195         my $expire_time = time() + $thing->interval_to_seconds('17h 9m');
196
197 The time size indicator may be one of
198
199 =over 2
200
201 =item s[econd[s]]
202
203 for seconds
204
205 =item m[inute[s]]
206
207 for minutes
208
209 =item h[our[s]]
210
211 for hours
212
213 =item d[ay[s]]
214
215 for days
216
217 =item w[eek[s]]
218
219 for weeks
220
221 =item M[onth[s]]
222
223 for months (really (365 * 1d)/12 ... that may get smarter, though)
224
225 =item y[ear[s]]
226
227 for years (this is 365 * 1d)
228
229 =back
230
231 =cut
232 sub interval_to_seconds {
233         my $self = shift;
234         my $interval = shift || $self;
235
236         $interval =~ s/and/,/g;
237         $interval =~ s/,/ /g;
238
239         my $amount = 0;
240         while ($interval =~ /\s*\+?\s*(\d+)\s*(\w{1})\w*\s*/g) {
241                 $amount += $1 if ($2 eq 's');
242                 $amount += 60 * $1 if ($2 eq 'm');
243                 $amount += 60 * 60 * $1 if ($2 eq 'h');
244                 $amount += 60 * 60 * 24 * $1 if ($2 eq 'd');
245                 $amount += 60 * 60 * 24 * 7 * $1 if ($2 eq 'w');
246                 $amount += ((60 * 60 * 24 * 365)/12) * $1 if ($2 eq 'M');
247                 $amount += 60 * 60 * 24 * 365 * $1 if ($2 eq 'y');
248         }
249         return $amount;
250 }
251
252 sub seconds_to_interval {
253         my $self = shift;
254         my $interval = shift || $self;
255
256         my $limit = shift || 's';
257         $limit =~ s/^(.)/$1/o;
258
259         my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s,$string);
260         my ($year, $month, $week, $day, $hour, $minute, $second) =
261                 ('year','Month','week','day', 'hour', 'minute', 'second');
262
263         if ($y = int($interval / (60 * 60 * 24 * 365))) {
264                 $string = "$y $year". ($y > 1 ? 's' : '');
265                 $ym = $interval % (60 * 60 * 24 * 365);
266         } else {
267                 $ym = $interval;
268         }
269         return $string if ($limit eq 'y');
270
271         if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
272                 $string .= ($string ? ', ':'')."$M $month". ($M > 1 ? 's' : '');
273                 $Mm = $ym % ((60 * 60 * 24 * 365)/12);
274         } else {
275                 $Mm = $ym;
276         }
277         return $string if ($limit eq 'M');
278
279         if ($w = int($Mm / 604800)) {
280                 $string .= ($string ? ', ':'')."$w $week". ($w > 1 ? 's' : '');
281                 $wm = $Mm % 604800;
282         } else {
283                 $wm = $Mm;
284         }
285         return $string if ($limit eq 'w');
286
287         if ($d = int($wm / 86400)) {
288                 $string .= ($string ? ', ':'')."$d $day". ($d > 1 ? 's' : '');
289                 $dm = $wm % 86400;
290         } else {
291                 $dm = $wm;
292         }
293         return $string if ($limit eq 'd');
294
295         if ($h = int($dm / 3600)) {
296                 $string .= ($string ? ', ' : '')."$h $hour". ($h > 1 ? 's' : '');
297                 $hm = $dm % 3600;
298         } else {
299                 $hm = $dm;
300         }
301         return $string if ($limit eq 'h');
302
303         if ($m = int($hm / 60)) {
304                 $string .= ($string ? ', ':'')."$m $minute". ($m > 1 ? 's' : '');
305                 $mm = $hm % 60;
306         } else {
307                 $mm = $hm;
308         }
309         return $string if ($limit eq 'm');
310
311         if ($s = int($mm)) {
312                 $string .= ($string ? ', ':'')."$s $second". ($s > 1 ? 's' : '');
313         } else {
314                 $string = "Brand New!!!" unless ($string);
315         }
316         return $string;
317 }
318
319 sub full {
320         my $self = shift;
321         $$self{empty} = 0;
322 }
323
324 =head2 $utils_obj->set_psname('string') OR set_psname('string')
325
326 Sets the name of this process in a B<ps> listing to B<string>.
327
328
329 =cut
330
331 sub set_psname {
332         my $self = shift;
333         my $PS_NAME = shift || $self;
334         $0 = $PS_NAME if ($PS_NAME);
335 }
336
337 sub clense_ISO8601 {
338         my $self = shift;
339         my $date = shift || $self;
340         if ($date =~ /(\d{4})-?(\d{2})-?(\d{2}).?(\d{2}):(\d{2}):(\d{2})\.?\d*((?:-|\+)\d{2,4})?$/) {
341                 my $z = $7 || '-00';
342                 $date = "$1-$2-$3T$4:$5:$6$z";
343         }
344         return $date;
345 }
346
347 =head2 $utils_obj->daemonize('ps_name') OR daemonize('ps_name')
348
349 Turns the current process into a daemon.  B<ps_name> is optional, and is used
350 as the argument to I<< set_psname() >> if passed.
351
352
353 =cut
354
355 sub daemonize {
356         my $self = shift;
357         my $PS_NAME = shift || $self;
358         my $pid;
359         if ($pid = safe_fork($self)) {
360                 exit 0;
361         } elsif (defined($pid)) {
362                 set_psname($PS_NAME);
363                 chdir '/';
364                 setsid;
365                 return $$;
366         }
367 }
368
369 =head2 $utils_obj->safe_fork('ps_name') OR safe_fork('ps_name');
370
371 Forks the current process in a retry loop.  B<ps_name> is optional, and is used
372 as the argument to I<< set_psname() >> if passed.
373
374
375 =cut
376
377 sub safe_fork {
378         my $self = shift;
379         my $pid;
380
381 FORK:
382         {
383                 if (defined($pid = fork())) {
384                         srand(time ^ ($$ + ($$ << 15))) unless ($pid);
385                         return $pid;
386                 } elsif ($! == EAGAIN) {
387                         $self->error("Can't fork()!  $!, taking 5 and trying again.") if (ref $self);
388                         sleep 5;
389                         redo FORK;
390                 } else {
391                         $self->error("Can't fork()! $!") if ($! && ref($self));
392                         exit $!;
393                 }
394         }
395 }
396
397 #------------------------------------------------------------------------------------------------------------------------------------
398
399
400 1;