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 ($sign, $count, $type) = ($1, $2, $3);
264 $count = "$sign$count" if ($sign);
265 $amount += $count if ($type eq 's');
266 $amount += 60 * $count if ($type =~ /^m(?!o)/oi);
267 $amount += 60 * 60 * $count if ($type =~ /^h/);
268 $amount += 60 * 60 * 24 * $count if ($type =~ /^d/oi);
269 $amount += 60 * 60 * 24 * 7 * $count if ($2 =~ /^w/oi);
270 $amount += ((60 * 60 * 24 * 365)/12) * $count if ($type =~ /^mo/io);
271 $amount += 60 * 60 * 24 * 365 * $count if ($type =~ /^y/oi);
276 sub seconds_to_interval {
278 my $interval = shift || $self;
280 my $limit = shift || 's';
281 $limit =~ s/^(.)/$1/o;
283 my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s,$string);
284 my ($year, $month, $week, $day, $hour, $minute, $second) =
285 ('year','Month','week','day', 'hour', 'minute', 'second');
287 if ($y = int($interval / (60 * 60 * 24 * 365))) {
288 $string = "$y $year". ($y > 1 ? 's' : '');
289 $ym = $interval % (60 * 60 * 24 * 365);
293 return $string if ($limit eq 'y');
295 if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
296 $string .= ($string ? ', ':'')."$M $month". ($M > 1 ? 's' : '');
297 $Mm = $ym % ((60 * 60 * 24 * 365)/12);
301 return $string if ($limit eq 'M');
303 if ($w = int($Mm / 604800)) {
304 $string .= ($string ? ', ':'')."$w $week". ($w > 1 ? 's' : '');
309 return $string if ($limit eq 'w');
311 if ($d = int($wm / 86400)) {
312 $string .= ($string ? ', ':'')."$d $day". ($d > 1 ? 's' : '');
317 return $string if ($limit eq 'd');
319 if ($h = int($dm / 3600)) {
320 $string .= ($string ? ', ' : '')."$h $hour". ($h > 1 ? 's' : '');
325 return $string if ($limit eq 'h');
327 if ($m = int($hm / 60)) {
328 $string .= ($string ? ', ':'')."$m $minute". ($m > 1 ? 's' : '');
333 return $string if ($limit eq 'm');
336 $string .= ($string ? ', ':'')."$s $second". ($s > 1 ? 's' : '');
338 $string = "0s" unless ($string);
348 =head2 $utils_obj->set_psname('string') OR set_psname('string')
350 Sets the name of this process in a B<ps> listing to B<string>.
357 my $PS_NAME = shift || $self;
358 $0 = $PS_NAME if ($PS_NAME);
365 my $y = $date[5] + 1900;
366 my $M = $date[4] + 1;
372 return sprintf('%d-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d+00:00', $y, $M, $d, $h, $m, $s);
377 my $date = shift || $self;
378 if ($date =~ /^\s*(\d{4})-?(\d{2})-?(\d{2})/o) {
379 my $new_date = "$1-$2-$3";
381 if ($date =~/(\d{2}):(\d{2}):(\d{2})/o) {
382 $new_date .= "T$1:$2:$3";
385 if ($date =~ /([-+]{1})([0-9]{1,2})(?::?([0-9]{1,2}))*\s*$/o) {
386 $z = sprintf('%s%0.2d%0.2d',$1,$2,$3)
388 $z = DateTime::TimeZone::offset_as_string(
390 ->new( name => 'local' )
391 ->offset_for_datetime(
392 $date_parser->parse_datetime($new_date)
397 if (length($z) > 3 && index($z, ':') == -1) {
398 substr($z,3,0) = ':';
399 substr($z,6,0) = ':' if (length($z) > 6);
404 $new_date .= "T00:00:00";
412 =head2 $utils_obj->daemonize('ps_name') OR daemonize('ps_name')
414 Turns the current process into a daemon. B<ps_name> is optional, and is used
415 as the argument to I<< set_psname() >> if passed.
422 my $PS_NAME = shift || $self;
424 if ($pid = safe_fork($self)) {
426 } elsif (defined($pid)) {
427 set_psname($PS_NAME);
434 =head2 $utils_obj->safe_fork('ps_name') OR safe_fork('ps_name');
436 Forks the current process in a retry loop. B<ps_name> is optional, and is used
437 as the argument to I<< set_psname() >> if passed.
448 if (defined($pid = fork())) {
449 srand(time ^ ($$ + ($$ << 15))) unless ($pid);
451 } elsif ($! == EAGAIN) {
452 $self->error("Can't fork()! $!, taking 5 and trying again.") if (ref $self);
456 $self->error("Can't fork()! $!") if ($! && ref($self));
462 #------------------------------------------------------------------------------------------------------------------------------------