1 package OpenSRF::Utils;
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.
19 use vars qw/@ISA $AUTOLOAD %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION/;
20 push @ISA, 'Exporter';
22 $VERSION = do { my @r=(q$Revision$=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
28 #use Cache::FileCache;
29 #use Storable qw(dclone);
30 use Digest::MD5 qw(md5 md5_hex md5_base64);
33 use DateTime::Format::ISO8601;
34 use DateTime::TimeZone;
36 our $date_parser = DateTime::Format::ISO8601->new;
38 # This turns errors into warnings, so daemons don't die.
39 #$Storable::forgive_me = 1;
42 common => [qw(interval_to_seconds seconds_to_interval sendmail)],
43 daemon => [qw(safe_fork set_psname daemonize)],
44 datetime => [qw(clense_ISO8601 gmtime_ISO8601 interval_to_seconds seconds_to_interval)],
47 Exporter::export_ok_tags('common','daemon','datetime'); # add aa, cc and dd to @EXPORT_OK
51 my $type = ref($self) or return undef;
54 $name =~ s/.*://; # strip fully-qualified portion
57 return $self->{$name} = shift;
59 return $self->{$name};
65 my $class = ref($self) || $self;
67 unless ($class->can($part)) {
68 *{$class.'::'.$part} =
73 $$self{$part} = $new_val;
80 #sub standalone_ipc_cache {
82 # my $class = ref($self) || $self;
83 # my $uniquifier = shift || return undef;
84 # my $expires = shift || 3600;
86 # return new Cache::FileCache ( { namespace => $class.'::'.$uniquifier, default_expires_in => $expires } );
91 my $message = shift || $self;
93 open SM, '|/usr/sbin/sendmail -U -t' or return 0;
99 sub __strip_comments {
101 my $config_file = shift;
103 while (<$config_file>) {
104 s/^\s*(.*)\s*$/$1/o if (lc($$self{keep_space}) ne 'true');
107 # keep new lines if keep_space is true
108 if ($line =~ /^$/o && (lc($$self{keep_space}) ne 'true')) {
112 if (/^([^<]+)\s*<<\s*(\w+)\s*$/o) {
115 while (<$config_file>) {
117 last if (/^$breaker/);
122 if ($line =~ /^#/ && $line !~ /^#\s*include\s+/o) {
126 if ($line =~ /\\$/o) {
128 $line =~ s/^\s*(.*)\s*\\$/$1/o;
138 =head2 $thing->encrypt(@stuff)
140 Returns a one way hash (MD5) of the values appended together.
146 return md5_hex(join('',@_));
149 =head2 $utils_obj->es_time('field') OR noo_es_time($timestamp)
151 Returns the epoch-second style timestamp for the value stored in
152 $utils_obj->{field}. Returns B<0> for an empty or invalid date stamp, and
153 assumes a PostgreSQL style datestamp to be supplied.
160 my $es_part = $part.'_ES';
161 return $$self{$es_part} if (exists($$self{$es_part}) && defined($$self{$es_part}) && $$self{$es_part});
162 if (!$$self{$part} or $$self{$part} !~ /\d+/) {
166 my @tm = reverse($$self{$part} =~ /([\d\.]+)/og);
171 return $$self{$es_part} = noo_es_time($$self{$part});
174 =head2 noo_es_time($timestamp) (non-OO es_time)
176 Returns the epoch-second style timestamp for the B<$timestamp> passed
177 in. Returns B<0> for an empty or invalid date stamp, and
178 assumes a PostgreSQL style datestamp to be supplied.
183 my $timestamp = shift;
185 my @tm = reverse($timestamp =~ /([\d\.]+)/og);
189 return timelocal(int($tm[1]), int($tm[2]), int($tm[3]), int($tm[4]) || 1, int($tm[5]), int($tm[6]) || 2002 );
193 =head2 $thing->interval_to_seconds('interval') OR interval_to_seconds('interval')
195 =head2 $thing->seconds_to_interval($seconds) OR seconds_to_interval($seconds)
197 Returns the number of seconds for any interval passed, or the interval for the seconds.
198 This is the generic version of B<interval> listed below.
200 The interval must match the regex I</\s*\+?\s*(\d+)\s*(\w{1})\w*\s*/g>, for example
201 B<2 weeks, 3 d and 1hour + 17 Months> or
202 B<1 year, 5 Months, 2 weeks, 3 days and 1 hour of seconds> meaning 46148400 seconds.
204 my $expire_time = time() + $thing->interval_to_seconds('17h 9m');
206 The time size indicator may be one of
232 for months (really (365 * 1d)/12 ... that may get smarter, though)
236 for years (this is 365 * 1d)
241 sub interval_to_seconds {
243 my $interval = shift || $self;
245 $interval =~ s/and/,/g;
246 $interval =~ s/,/ /g;
249 while ($interval =~ /\s*\+?\s*(\d+)\s*((\w{1})\w*)\s*/g) {
250 $amount += $1 if ($3 eq 's');
251 $amount += 60 * $1 if ($3 eq 'm' || $2 =~ /^mi/io);
252 $amount += 60 * 60 * $1 if ($3 eq 'h');
253 $amount += 60 * 60 * 24 * $1 if ($3 eq 'd');
254 $amount += 60 * 60 * 24 * 7 * $1 if ($3 eq 'w');
255 $amount += ((60 * 60 * 24 * 365)/12) * $1 if ($3 eq 'M' || $2 =~ /^mo/io);
256 $amount += 60 * 60 * 24 * 365 * $1 if ($2 eq 'y');
261 sub seconds_to_interval {
263 my $interval = shift || $self;
265 my $limit = shift || 's';
266 $limit =~ s/^(.)/$1/o;
268 my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s,$string);
269 my ($year, $month, $week, $day, $hour, $minute, $second) =
270 ('year','Month','week','day', 'hour', 'minute', 'second');
272 if ($y = int($interval / (60 * 60 * 24 * 365))) {
273 $string = "$y $year". ($y > 1 ? 's' : '');
274 $ym = $interval % (60 * 60 * 24 * 365);
278 return $string if ($limit eq 'y');
280 if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
281 $string .= ($string ? ', ':'')."$M $month". ($M > 1 ? 's' : '');
282 $Mm = $ym % ((60 * 60 * 24 * 365)/12);
286 return $string if ($limit eq 'M');
288 if ($w = int($Mm / 604800)) {
289 $string .= ($string ? ', ':'')."$w $week". ($w > 1 ? 's' : '');
294 return $string if ($limit eq 'w');
296 if ($d = int($wm / 86400)) {
297 $string .= ($string ? ', ':'')."$d $day". ($d > 1 ? 's' : '');
302 return $string if ($limit eq 'd');
304 if ($h = int($dm / 3600)) {
305 $string .= ($string ? ', ' : '')."$h $hour". ($h > 1 ? 's' : '');
310 return $string if ($limit eq 'h');
312 if ($m = int($hm / 60)) {
313 $string .= ($string ? ', ':'')."$m $minute". ($m > 1 ? 's' : '');
318 return $string if ($limit eq 'm');
321 $string .= ($string ? ', ':'')."$s $second". ($s > 1 ? 's' : '');
323 $string = "0s" unless ($string);
333 =head2 $utils_obj->set_psname('string') OR set_psname('string')
335 Sets the name of this process in a B<ps> listing to B<string>.
342 my $PS_NAME = shift || $self;
343 $0 = $PS_NAME if ($PS_NAME);
350 my $y = $date[5] + 1900;
351 my $M = $date[4] + 1;
357 return sprintf('%d-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d+00:00', $y, $M, $d, $h, $m, $s);
362 my $date = shift || $self;
363 if ($date =~ /^\s*(\d{4})-?(\d{2})-?(\d{2})/o) {
364 my $new_date = "$1-$2-$3";
366 if ($date =~/(\d{2}):(\d{2}):(\d{2})/o) {
367 $new_date .= "T$1:$2:$3";
370 if ($date =~ /([-+]{1})([0-9]{1,2})(?::?([0-9]{1,2}))*\s*$/o) {
371 $z = sprintf('%s%0.2d%0.2d',$1,$2,$3)
373 $z = DateTime::TimeZone::offset_as_string(
375 ->new( name => 'local' )
376 ->offset_for_datetime(
377 $date_parser->parse_datetime($new_date)
382 if (length($z) > 3 && index($z, ':') == -1) {
383 substr($z,3,0) = ':';
384 substr($z,6,0) = ':' if (length($z) > 6);
389 $new_date .= "T00:00:00";
397 =head2 $utils_obj->daemonize('ps_name') OR daemonize('ps_name')
399 Turns the current process into a daemon. B<ps_name> is optional, and is used
400 as the argument to I<< set_psname() >> if passed.
407 my $PS_NAME = shift || $self;
409 if ($pid = safe_fork($self)) {
411 } elsif (defined($pid)) {
412 set_psname($PS_NAME);
419 =head2 $utils_obj->safe_fork('ps_name') OR safe_fork('ps_name');
421 Forks the current process in a retry loop. B<ps_name> is optional, and is used
422 as the argument to I<< set_psname() >> if passed.
433 if (defined($pid = fork())) {
434 srand(time ^ ($$ + ($$ << 15))) unless ($pid);
436 } elsif ($! == EAGAIN) {
437 $self->error("Can't fork()! $!, taking 5 and trying again.") if (ref $self);
441 $self->error("Can't fork()! $!") if ($! && ref($self));
447 #------------------------------------------------------------------------------------------------------------------------------------