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/(\d{2}):(\d{2}):(\d{2})/ $1 h $2 min $3 s /go;
260 $interval =~ s/and/,/g;
261 $interval =~ s/,/ /g;
264 while ($interval =~ /\s*([\+-]?)\s*(\d+)\s*(\w+)\s*/g) {
265 my ($sign, $count, $type) = ($1, $2, $3);
266 $count = "$sign$count" if ($sign);
267 $amount += $count if ($type eq 's');
268 $amount += 60 * $count if ($type =~ /^m(?!o)/oi);
269 $amount += 60 * 60 * $count if ($type =~ /^h/);
270 $amount += 60 * 60 * 24 * $count if ($type =~ /^d/oi);
271 $amount += 60 * 60 * 24 * 7 * $count if ($2 =~ /^w/oi);
272 $amount += ((60 * 60 * 24 * 365)/12) * $count if ($type =~ /^mo/io);
273 $amount += 60 * 60 * 24 * 365 * $count if ($type =~ /^y/oi);
278 sub seconds_to_interval {
280 my $interval = shift || $self;
282 my $limit = shift || 's';
283 $limit =~ s/^(.)/$1/o;
285 my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s,$string);
286 my ($year, $month, $week, $day, $hour, $minute, $second) =
287 ('year','Month','week','day', 'hour', 'minute', 'second');
289 if ($y = int($interval / (60 * 60 * 24 * 365))) {
290 $string = "$y $year". ($y > 1 ? 's' : '');
291 $ym = $interval % (60 * 60 * 24 * 365);
295 return $string if ($limit eq 'y');
297 if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
298 $string .= ($string ? ', ':'')."$M $month". ($M > 1 ? 's' : '');
299 $Mm = $ym % ((60 * 60 * 24 * 365)/12);
303 return $string if ($limit eq 'M');
305 if ($w = int($Mm / 604800)) {
306 $string .= ($string ? ', ':'')."$w $week". ($w > 1 ? 's' : '');
311 return $string if ($limit eq 'w');
313 if ($d = int($wm / 86400)) {
314 $string .= ($string ? ', ':'')."$d $day". ($d > 1 ? 's' : '');
319 return $string if ($limit eq 'd');
321 if ($h = int($dm / 3600)) {
322 $string .= ($string ? ', ' : '')."$h $hour". ($h > 1 ? 's' : '');
327 return $string if ($limit eq 'h');
329 if ($m = int($hm / 60)) {
330 $string .= ($string ? ', ':'')."$m $minute". ($m > 1 ? 's' : '');
335 return $string if ($limit eq 'm');
338 $string .= ($string ? ', ':'')."$s $second". ($s > 1 ? 's' : '');
340 $string = "0s" unless ($string);
350 =head2 $utils_obj->set_psname('string') OR set_psname('string')
352 Sets the name of this process in a B<ps> listing to B<string>.
359 my $PS_NAME = shift || $self;
360 $0 = $PS_NAME if ($PS_NAME);
367 my $y = $date[5] + 1900;
368 my $M = $date[4] + 1;
374 return sprintf('%d-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d+00:00', $y, $M, $d, $h, $m, $s);
379 my $date = shift || $self;
380 if ($date =~ /^\s*(\d{4})-?(\d{2})-?(\d{2})/o) {
381 my $new_date = "$1-$2-$3";
383 if ($date =~/(\d{2}):(\d{2}):(\d{2})/o) {
384 $new_date .= "T$1:$2:$3";
387 if ($date =~ /([-+]{1})([0-9]{1,2})(?::?([0-9]{1,2}))*\s*$/o) {
388 $z = sprintf('%s%0.2d%0.2d',$1,$2,$3)
390 $z = DateTime::TimeZone::offset_as_string(
392 ->new( name => 'local' )
393 ->offset_for_datetime(
394 $date_parser->parse_datetime($new_date)
399 if (length($z) > 3 && index($z, ':') == -1) {
400 substr($z,3,0) = ':';
401 substr($z,6,0) = ':' if (length($z) > 6);
406 $new_date .= "T00:00:00";
414 =head2 $utils_obj->daemonize('ps_name') OR daemonize('ps_name')
416 Turns the current process into a daemon. B<ps_name> is optional, and is used
417 as the argument to I<< set_psname() >> if passed.
424 my $PS_NAME = shift || $self;
426 if ($pid = safe_fork($self)) {
428 } elsif (defined($pid)) {
429 set_psname($PS_NAME);
436 =head2 $utils_obj->safe_fork('ps_name') OR safe_fork('ps_name');
438 Forks the current process in a retry loop. B<ps_name> is optional, and is used
439 as the argument to I<< set_psname() >> if passed.
450 if (defined($pid = fork())) {
451 srand(time ^ ($$ + ($$ << 15))) unless ($pid);
453 } elsif ($! == EAGAIN) {
454 $self->error("Can't fork()! $!, taking 5 and trying again.") if (ref $self);
458 $self->error("Can't fork()! $!") if ($! && ref($self));
464 #------------------------------------------------------------------------------------------------------------------------------------