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;