1 package OpenSRF::Utils;
7 use Digest::MD5 qw(md5 md5_hex md5_base64);
10 use DateTime::Duration;
11 use DateTime::Format::ISO8601;
12 use DateTime::TimeZone;
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.
30 use vars qw/@ISA $AUTOLOAD %EXPORT_TAGS @EXPORT_OK @EXPORT/;
31 push @ISA, 'Exporter';
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)],
38 Exporter::export_ok_tags('common','daemon','datetime'); # add aa, cc and dd to @EXPORT_OK
40 our $date_parser = DateTime::Format::ISO8601->new;
49 my $type = ref($self) or return undef;
52 $name =~ s/.*://; # strip fully-qualified portion
55 return $self->{$name} = shift;
57 return $self->{$name};
63 my $class = ref($self) || $self;
65 unless ($class->can($part)) {
66 *{$class.'::'.$part} =
71 $$self{$part} = $new_val;
83 my @things = $filter->($tree);
84 for my $v ( @{$tree->$field} ){
85 push @things, $filter->($v);
86 push @things, tree_filter($v, $field, $filter);
91 #sub standalone_ipc_cache {
93 # my $class = ref($self) || $self;
94 # my $uniquifier = shift || return undef;
95 # my $expires = shift || 3600;
97 # return new Cache::FileCache ( { namespace => $class.'::'.$uniquifier, default_expires_in => $expires } );
102 my $message = shift || $self;
104 open SM, '|/usr/sbin/sendmail -U -t' or return 0;
106 close SM or return 0;
110 sub __strip_comments {
112 my $config_file = shift;
114 while (<$config_file>) {
115 s/^\s*(.*)\s*$/$1/o if (lc($$self{keep_space}) ne 'true');
118 # keep new lines if keep_space is true
119 if ($line =~ /^$/o && (lc($$self{keep_space}) ne 'true')) {
123 if (/^([^<]+)\s*<<\s*(\w+)\s*$/o) {
126 while (<$config_file>) {
128 last if (/^$breaker/);
133 if ($line =~ /^#/ && $line !~ /^#\s*include\s+/o) {
137 if ($line =~ /\\$/o) {
139 $line =~ s/^\s*(.*)\s*\\$/$1/o;
149 =head2 $thing->encrypt(@stuff)
151 Returns a one way hash (MD5) of the values appended together.
157 return md5_hex(join('',@_));
160 =head2 $utils_obj->es_time('field') OR noo_es_time($timestamp)
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.
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+/) {
177 my @tm = reverse($$self{$part} =~ /([\d\.]+)/og);
182 return $$self{$es_part} = noo_es_time($$self{$part});
185 =head2 noo_es_time($timestamp) (non-OO es_time)
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.
194 my $timestamp = shift;
196 my @tm = reverse($timestamp =~ /([\d\.]+)/og);
200 return timelocal(int($tm[1]), int($tm[2]), int($tm[3]), int($tm[4]) || 1, int($tm[5]), int($tm[6]) || 2002 );
204 =head2 $thing->interval_to_seconds('interval', ['context']) OR interval_to_seconds('interval', ['context'])
206 =head2 $thing->seconds_to_interval($seconds) OR seconds_to_interval($seconds)
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.
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.
215 my $expire_time = time() + $thing->interval_to_seconds('17h 9m');
217 The time size indicator may be one of
243 for months (really (365 * 1d)/12 ... that may get smarter, though)
247 for years (this is 365 * 1d)
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).
254 sub interval_to_seconds {
255 my $class = shift; # throwaway
256 my $interval = ($class eq __PACKAGE__) ? shift : $class;
259 $interval =~ s/(\d{2}):(\d{2}):(\d{2})/ $1 h $2 min $3 s /go;
261 $interval =~ s/and/,/g;
262 $interval =~ s/,/ /g;
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';
272 } elsif ($type =~ /^m(?!o)/oi) {
274 } elsif ($type =~ /^h/) {
276 } elsif ($type =~ /^d/oi) {
278 } elsif ($type =~ /^w/oi) {
280 } elsif ($type =~ /^mo/io) {
282 } elsif ($type =~ /^y/oi) {
285 $dur->$func($type => $count);
287 my $later = $context->clone->add_duration($dur);
288 $amount = $later->subtract_datetime_absolute($context)->in_units( 'seconds' );
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);
306 sub seconds_to_interval {
308 my $interval = shift || $self;
310 my $limit = shift || 's';
311 $limit =~ s/^(.)/$1/o;
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');
317 if ($y = int($interval / (60 * 60 * 24 * 365))) {
318 $string = "$y $year". ($y > 1 ? 's' : '');
319 $ym = $interval % (60 * 60 * 24 * 365);
323 return $string if ($limit eq 'y');
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);
331 return $string if ($limit eq 'M');
333 if ($w = int($Mm / 604800)) {
334 $string .= ($string ? ', ':'')."$w $week". ($w > 1 ? 's' : '');
339 return $string if ($limit eq 'w');
341 if ($d = int($wm / 86400)) {
342 $string .= ($string ? ', ':'')."$d $day". ($d > 1 ? 's' : '');
347 return $string if ($limit eq 'd');
349 if ($h = int($dm / 3600)) {
350 $string .= ($string ? ', ' : '')."$h $hour". ($h > 1 ? 's' : '');
355 return $string if ($limit eq 'h');
357 if ($m = int($hm / 60)) {
358 $string .= ($string ? ', ':'')."$m $minute". ($m > 1 ? 's' : '');
363 return $string if ($limit eq 'm');
366 $string .= ($string ? ', ':'')."$s $second". ($s > 1 ? 's' : '');
368 $string = "0s" unless ($string);
378 =head2 $utils_obj->set_psname('string') OR set_psname('string')
380 Sets the name of this process in a B<ps> listing to B<string>.
387 my $PS_NAME = shift || $self;
388 $0 = $PS_NAME if ($PS_NAME);
395 my $y = $date[5] + 1900;
396 my $M = $date[4] + 1;
402 return sprintf('%d-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d+00:00', $y, $M, $d, $h, $m, $s);
405 sub cleanse_ISO8601 {
407 my $date = shift || $self;
408 if ($date =~ /^\s*(\d{4})-?(\d{2})-?(\d{2})/o) {
409 my $new_date = "$1-$2-$3";
411 if ($date =~/(\d{2}):(\d{2}):(\d{2})/o) {
412 $new_date .= "T$1:$2:$3";
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)
418 $z = DateTime::TimeZone::offset_as_string(
420 ->new( name => 'local' )
421 ->offset_for_datetime(
422 $date_parser->parse_datetime($new_date)
427 if (length($z) > 3 && index($z, ':') == -1) {
428 substr($z,3,0) = ':';
429 substr($z,6,0) = ':' if (length($z) > 6);
434 $new_date .= "T00:00:00";
442 sub clense_ISO8601 { return cleanse_ISO8601(@_); }
444 =head2 $utils_obj->daemonize('ps_name') OR daemonize('ps_name')
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.
454 my $PS_NAME = shift || $self;
456 if ($pid = safe_fork($self)) {
458 } elsif (defined($pid)) {
459 set_psname($PS_NAME);
466 =head2 $utils_obj->safe_fork('ps_name') OR safe_fork('ps_name');
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.
480 if (defined($pid = fork())) {
481 srand(time ^ ($$ + ($$ << 15))) unless ($pid);
483 } elsif ($! == EAGAIN) {
484 $self->error("Can't fork()! $!, taking 5 and trying again.") if (ref $self);
488 $self->error("Can't fork()! $!") if ($! && ref($self));
494 #------------------------------------------------------------------------------------------------------------------------------------