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 tree_filter)],
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;
85 my @things = $filter->($tree);
86 for my $v ( @{$tree->$field} ){
87 push @things, $filter->($v);
88 push @things, tree_filter($v, $field, $filter);
93 #sub standalone_ipc_cache {
95 # my $class = ref($self) || $self;
96 # my $uniquifier = shift || return undef;
97 # my $expires = shift || 3600;
99 # return new Cache::FileCache ( { namespace => $class.'::'.$uniquifier, default_expires_in => $expires } );
104 my $message = shift || $self;
106 open SM, '|/usr/sbin/sendmail -U -t' or return 0;
108 close SM or return 0;
112 sub __strip_comments {
114 my $config_file = shift;
116 while (<$config_file>) {
117 s/^\s*(.*)\s*$/$1/o if (lc($$self{keep_space}) ne 'true');
120 # keep new lines if keep_space is true
121 if ($line =~ /^$/o && (lc($$self{keep_space}) ne 'true')) {
125 if (/^([^<]+)\s*<<\s*(\w+)\s*$/o) {
128 while (<$config_file>) {
130 last if (/^$breaker/);
135 if ($line =~ /^#/ && $line !~ /^#\s*include\s+/o) {
139 if ($line =~ /\\$/o) {
141 $line =~ s/^\s*(.*)\s*\\$/$1/o;
151 =head2 $thing->encrypt(@stuff)
153 Returns a one way hash (MD5) of the values appended together.
159 return md5_hex(join('',@_));
162 =head2 $utils_obj->es_time('field') OR noo_es_time($timestamp)
164 Returns the epoch-second style timestamp for the value stored in
165 $utils_obj->{field}. Returns B<0> for an empty or invalid date stamp, and
166 assumes a PostgreSQL style datestamp to be supplied.
173 my $es_part = $part.'_ES';
174 return $$self{$es_part} if (exists($$self{$es_part}) && defined($$self{$es_part}) && $$self{$es_part});
175 if (!$$self{$part} or $$self{$part} !~ /\d+/) {
179 my @tm = reverse($$self{$part} =~ /([\d\.]+)/og);
184 return $$self{$es_part} = noo_es_time($$self{$part});
187 =head2 noo_es_time($timestamp) (non-OO es_time)
189 Returns the epoch-second style timestamp for the B<$timestamp> passed
190 in. Returns B<0> for an empty or invalid date stamp, and
191 assumes a PostgreSQL style datestamp to be supplied.
196 my $timestamp = shift;
198 my @tm = reverse($timestamp =~ /([\d\.]+)/og);
202 return timelocal(int($tm[1]), int($tm[2]), int($tm[3]), int($tm[4]) || 1, int($tm[5]), int($tm[6]) || 2002 );
206 =head2 $thing->interval_to_seconds('interval') OR interval_to_seconds('interval')
208 =head2 $thing->seconds_to_interval($seconds) OR seconds_to_interval($seconds)
210 Returns the number of seconds for any interval passed, or the interval for the seconds.
211 This is the generic version of B<interval> listed below.
213 The interval must match the regex I</\s*\+?\s*(\d+)\s*(\w{1})\w*\s*/g>, for example
214 B<2 weeks, 3 d and 1hour + 17 Months> or
215 B<1 year, 5 Months, 2 weeks, 3 days and 1 hour of seconds> meaning 46148400 seconds.
217 my $expire_time = time() + $thing->interval_to_seconds('17h 9m');
219 The time size indicator may be one of
245 for months (really (365 * 1d)/12 ... that may get smarter, though)
249 for years (this is 365 * 1d)
254 sub interval_to_seconds {
256 my $interval = shift || $self;
258 $interval =~ s/and/,/g;
259 $interval =~ s/,/ /g;
262 while ($interval =~ /\s*\+?\s*(\d+)\s*(\w+)\s*/g) {
263 my ($count, $type) = ($1, $2);
264 $amount += $count if ($type eq '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 ($2 =~ /^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);
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 =head2 $utils_obj->daemonize('ps_name') OR daemonize('ps_name')
413 Turns the current process into a daemon. B<ps_name> is optional, and is used
414 as the argument to I<< set_psname() >> if passed.
421 my $PS_NAME = shift || $self;
423 if ($pid = safe_fork($self)) {
425 } elsif (defined($pid)) {
426 set_psname($PS_NAME);
433 =head2 $utils_obj->safe_fork('ps_name') OR safe_fork('ps_name');
435 Forks the current process in a retry loop. B<ps_name> is optional, and is used
436 as the argument to I<< set_psname() >> if passed.
447 if (defined($pid = fork())) {
448 srand(time ^ ($$ + ($$ << 15))) unless ($pid);
450 } elsif ($! == EAGAIN) {
451 $self->error("Can't fork()! $!, taking 5 and trying again.") if (ref $self);
455 $self->error("Can't fork()! $!") if ($! && ref($self));
461 #------------------------------------------------------------------------------------------------------------------------------------