1 package OpenSRF::Utils;
7 use Digest::MD5 qw(md5 md5_hex md5_base64);
10 use DateTime::Format::ISO8601;
11 use DateTime::TimeZone;
19 This is a container package for methods that are useful to derived modules.
20 It has no constructor, and is generally not useful by itself... but this
21 is where most of the generic methods live.
29 use vars qw/@ISA $AUTOLOAD %EXPORT_TAGS @EXPORT_OK @EXPORT/;
30 push @ISA, 'Exporter';
33 common => [qw(interval_to_seconds seconds_to_interval sendmail tree_filter)],
34 daemon => [qw(safe_fork set_psname daemonize)],
35 datetime => [qw(clense_ISO8601 cleanse_ISO8601 gmtime_ISO8601 interval_to_seconds seconds_to_interval)],
37 Exporter::export_ok_tags('common','daemon','datetime'); # add aa, cc and dd to @EXPORT_OK
39 our $date_parser = DateTime::Format::ISO8601->new;
48 my $type = ref($self) or return undef;
51 $name =~ s/.*://; # strip fully-qualified portion
54 return $self->{$name} = shift;
56 return $self->{$name};
62 my $class = ref($self) || $self;
64 unless ($class->can($part)) {
65 *{$class.'::'.$part} =
70 $$self{$part} = $new_val;
82 my @things = $filter->($tree);
83 for my $v ( @{$tree->$field} ){
84 push @things, $filter->($v);
85 push @things, tree_filter($v, $field, $filter);
90 #sub standalone_ipc_cache {
92 # my $class = ref($self) || $self;
93 # my $uniquifier = shift || return undef;
94 # my $expires = shift || 3600;
96 # return new Cache::FileCache ( { namespace => $class.'::'.$uniquifier, default_expires_in => $expires } );
101 my $message = shift || $self;
103 open SM, '|/usr/sbin/sendmail -U -t' or return 0;
105 close SM or return 0;
109 sub __strip_comments {
111 my $config_file = shift;
113 while (<$config_file>) {
114 s/^\s*(.*)\s*$/$1/o if (lc($$self{keep_space}) ne 'true');
117 # keep new lines if keep_space is true
118 if ($line =~ /^$/o && (lc($$self{keep_space}) ne 'true')) {
122 if (/^([^<]+)\s*<<\s*(\w+)\s*$/o) {
125 while (<$config_file>) {
127 last if (/^$breaker/);
132 if ($line =~ /^#/ && $line !~ /^#\s*include\s+/o) {
136 if ($line =~ /\\$/o) {
138 $line =~ s/^\s*(.*)\s*\\$/$1/o;
148 =head2 $thing->encrypt(@stuff)
150 Returns a one way hash (MD5) of the values appended together.
156 return md5_hex(join('',@_));
159 =head2 $utils_obj->es_time('field') OR noo_es_time($timestamp)
161 Returns the epoch-second style timestamp for the value stored in
162 $utils_obj->{field}. Returns B<0> for an empty or invalid date stamp, and
163 assumes a PostgreSQL style datestamp to be supplied.
170 my $es_part = $part.'_ES';
171 return $$self{$es_part} if (exists($$self{$es_part}) && defined($$self{$es_part}) && $$self{$es_part});
172 if (!$$self{$part} or $$self{$part} !~ /\d+/) {
176 my @tm = reverse($$self{$part} =~ /([\d\.]+)/og);
181 return $$self{$es_part} = noo_es_time($$self{$part});
184 =head2 noo_es_time($timestamp) (non-OO es_time)
186 Returns the epoch-second style timestamp for the B<$timestamp> passed
187 in. Returns B<0> for an empty or invalid date stamp, and
188 assumes a PostgreSQL style datestamp to be supplied.
193 my $timestamp = shift;
195 my @tm = reverse($timestamp =~ /([\d\.]+)/og);
199 return timelocal(int($tm[1]), int($tm[2]), int($tm[3]), int($tm[4]) || 1, int($tm[5]), int($tm[6]) || 2002 );
203 =head2 $thing->interval_to_seconds('interval') OR interval_to_seconds('interval')
205 =head2 $thing->seconds_to_interval($seconds) OR seconds_to_interval($seconds)
207 Returns the number of seconds for any interval passed, or the interval for the seconds.
208 This is the generic version of B<interval> listed below.
210 The interval must match the regex I</\s*\+?\s*(\d+)\s*(\w{1})\w*\s*/g>, for example
211 B<2 weeks, 3 d and 1hour + 17 Months> or
212 B<1 year, 5 Months, 2 weeks, 3 days and 1 hour of seconds> meaning 46148400 seconds.
214 my $expire_time = time() + $thing->interval_to_seconds('17h 9m');
216 The time size indicator may be one of
242 for months (really (365 * 1d)/12 ... that may get smarter, though)
246 for years (this is 365 * 1d)
251 sub interval_to_seconds {
253 my $interval = shift || $self;
255 $interval =~ s/(\d{2}):(\d{2}):(\d{2})/ $1 h $2 min $3 s /go;
257 $interval =~ s/and/,/g;
258 $interval =~ s/,/ /g;
261 while ($interval =~ /\s*([\+-]?)\s*(\d+)\s*(\w+)\s*/g) {
262 my ($sign, $count, $type) = ($1, $2, $3);
263 $count = "$sign$count" if ($sign);
264 $amount += $count if ($type =~ /^s/);
265 $amount += 60 * $count if ($type =~ /^m(?!o)/oi);
266 $amount += 60 * 60 * $count if ($type =~ /^h/);
267 $amount += 60 * 60 * 24 * $count if ($type =~ /^d/oi);
268 $amount += 60 * 60 * 24 * 7 * $count if ($type =~ /^w/oi);
269 $amount += ((60 * 60 * 24 * 365)/12) * $count if ($type =~ /^mo/io);
270 $amount += 60 * 60 * 24 * 365 * $count if ($type =~ /^y/oi);
275 sub seconds_to_interval {
277 my $interval = shift || $self;
279 my $limit = shift || 's';
280 $limit =~ s/^(.)/$1/o;
282 my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s,$string);
283 my ($year, $month, $week, $day, $hour, $minute, $second) =
284 ('year','Month','week','day', 'hour', 'minute', 'second');
286 if ($y = int($interval / (60 * 60 * 24 * 365))) {
287 $string = "$y $year". ($y > 1 ? 's' : '');
288 $ym = $interval % (60 * 60 * 24 * 365);
292 return $string if ($limit eq 'y');
294 if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
295 $string .= ($string ? ', ':'')."$M $month". ($M > 1 ? 's' : '');
296 $Mm = $ym % ((60 * 60 * 24 * 365)/12);
300 return $string if ($limit eq 'M');
302 if ($w = int($Mm / 604800)) {
303 $string .= ($string ? ', ':'')."$w $week". ($w > 1 ? 's' : '');
308 return $string if ($limit eq 'w');
310 if ($d = int($wm / 86400)) {
311 $string .= ($string ? ', ':'')."$d $day". ($d > 1 ? 's' : '');
316 return $string if ($limit eq 'd');
318 if ($h = int($dm / 3600)) {
319 $string .= ($string ? ', ' : '')."$h $hour". ($h > 1 ? 's' : '');
324 return $string if ($limit eq 'h');
326 if ($m = int($hm / 60)) {
327 $string .= ($string ? ', ':'')."$m $minute". ($m > 1 ? 's' : '');
332 return $string if ($limit eq 'm');
335 $string .= ($string ? ', ':'')."$s $second". ($s > 1 ? 's' : '');
337 $string = "0s" unless ($string);
347 =head2 $utils_obj->set_psname('string') OR set_psname('string')
349 Sets the name of this process in a B<ps> listing to B<string>.
356 my $PS_NAME = shift || $self;
357 $0 = $PS_NAME if ($PS_NAME);
364 my $y = $date[5] + 1900;
365 my $M = $date[4] + 1;
371 return sprintf('%d-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d+00:00', $y, $M, $d, $h, $m, $s);
374 sub cleanse_ISO8601 {
376 my $date = shift || $self;
377 if ($date =~ /^\s*(\d{4})-?(\d{2})-?(\d{2})/o) {
378 my $new_date = "$1-$2-$3";
380 if ($date =~/(\d{2}):(\d{2}):(\d{2})/o) {
381 $new_date .= "T$1:$2:$3";
384 if ($date =~ /([-+]{1})([0-9]{1,2})(?::?([0-9]{1,2}))*\s*$/o) {
385 $z = sprintf('%s%0.2d%0.2d',$1,$2,$3)
387 $z = DateTime::TimeZone::offset_as_string(
389 ->new( name => 'local' )
390 ->offset_for_datetime(
391 $date_parser->parse_datetime($new_date)
396 if (length($z) > 3 && index($z, ':') == -1) {
397 substr($z,3,0) = ':';
398 substr($z,6,0) = ':' if (length($z) > 6);
403 $new_date .= "T00:00:00";
411 sub clense_ISO8601 { return cleanse_ISO8601(@_); }
413 =head2 $utils_obj->daemonize('ps_name') OR daemonize('ps_name')
415 Turns the current process into a daemon. B<ps_name> is optional, and is used
416 as the argument to I<< set_psname() >> if passed.
423 my $PS_NAME = shift || $self;
425 if ($pid = safe_fork($self)) {
427 } elsif (defined($pid)) {
428 set_psname($PS_NAME);
435 =head2 $utils_obj->safe_fork('ps_name') OR safe_fork('ps_name');
437 Forks the current process in a retry loop. B<ps_name> is optional, and is used
438 as the argument to I<< set_psname() >> if passed.
449 if (defined($pid = fork())) {
450 srand(time ^ ($$ + ($$ << 15))) unless ($pid);
452 } elsif ($! == EAGAIN) {
453 $self->error("Can't fork()! $!, taking 5 and trying again.") if (ref $self);
457 $self->error("Can't fork()! $!") if ($! && ref($self));
463 #------------------------------------------------------------------------------------------------------------------------------------