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{1})\w*)\s*/g) {
263 $amount += $1 if ($3 eq 's');
264 $amount += 60 * $1 if ($3 eq 'm' || $2 =~ /^mi/io);
265 $amount += 60 * 60 * $1 if ($3 eq 'h');
266 $amount += 60 * 60 * 24 * $1 if ($3 eq 'd');
267 $amount += 60 * 60 * 24 * 7 * $1 if ($3 eq 'w');
268 $amount += ((60 * 60 * 24 * 365)/12) * $1 if ($3 eq 'M' || $2 =~ /^mo/io);
269 $amount += 60 * 60 * 24 * 365 * $1 if ($2 eq 'y');
274 sub seconds_to_interval {
276 my $interval = shift || $self;
278 my $limit = shift || 's';
279 $limit =~ s/^(.)/$1/o;
281 my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s,$string);
282 my ($year, $month, $week, $day, $hour, $minute, $second) =
283 ('year','Month','week','day', 'hour', 'minute', 'second');
285 if ($y = int($interval / (60 * 60 * 24 * 365))) {
286 $string = "$y $year". ($y > 1 ? 's' : '');
287 $ym = $interval % (60 * 60 * 24 * 365);
291 return $string if ($limit eq 'y');
293 if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
294 $string .= ($string ? ', ':'')."$M $month". ($M > 1 ? 's' : '');
295 $Mm = $ym % ((60 * 60 * 24 * 365)/12);
299 return $string if ($limit eq 'M');
301 if ($w = int($Mm / 604800)) {
302 $string .= ($string ? ', ':'')."$w $week". ($w > 1 ? 's' : '');
307 return $string if ($limit eq 'w');
309 if ($d = int($wm / 86400)) {
310 $string .= ($string ? ', ':'')."$d $day". ($d > 1 ? 's' : '');
315 return $string if ($limit eq 'd');
317 if ($h = int($dm / 3600)) {
318 $string .= ($string ? ', ' : '')."$h $hour". ($h > 1 ? 's' : '');
323 return $string if ($limit eq 'h');
325 if ($m = int($hm / 60)) {
326 $string .= ($string ? ', ':'')."$m $minute". ($m > 1 ? 's' : '');
331 return $string if ($limit eq 'm');
334 $string .= ($string ? ', ':'')."$s $second". ($s > 1 ? 's' : '');
336 $string = "0s" unless ($string);
346 =head2 $utils_obj->set_psname('string') OR set_psname('string')
348 Sets the name of this process in a B<ps> listing to B<string>.
355 my $PS_NAME = shift || $self;
356 $0 = $PS_NAME if ($PS_NAME);
363 my $y = $date[5] + 1900;
364 my $M = $date[4] + 1;
370 return sprintf('%d-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d+00:00', $y, $M, $d, $h, $m, $s);
375 my $date = shift || $self;
376 if ($date =~ /^\s*(\d{4})-?(\d{2})-?(\d{2})/o) {
377 my $new_date = "$1-$2-$3";
379 if ($date =~/(\d{2}):(\d{2}):(\d{2})/o) {
380 $new_date .= "T$1:$2:$3";
383 if ($date =~ /([-+]{1})([0-9]{1,2})(?::?([0-9]{1,2}))*\s*$/o) {
384 $z = sprintf('%s%0.2d%0.2d',$1,$2,$3)
386 $z = DateTime::TimeZone::offset_as_string(
388 ->new( name => 'local' )
389 ->offset_for_datetime(
390 $date_parser->parse_datetime($new_date)
395 if (length($z) > 3 && index($z, ':') == -1) {
396 substr($z,3,0) = ':';
397 substr($z,6,0) = ':' if (length($z) > 6);
402 $new_date .= "T00:00:00";
410 =head2 $utils_obj->daemonize('ps_name') OR daemonize('ps_name')
412 Turns the current process into a daemon. B<ps_name> is optional, and is used
413 as the argument to I<< set_psname() >> if passed.
420 my $PS_NAME = shift || $self;
422 if ($pid = safe_fork($self)) {
424 } elsif (defined($pid)) {
425 set_psname($PS_NAME);
432 =head2 $utils_obj->safe_fork('ps_name') OR safe_fork('ps_name');
434 Forks the current process in a retry loop. B<ps_name> is optional, and is used
435 as the argument to I<< set_psname() >> if passed.
446 if (defined($pid = fork())) {
447 srand(time ^ ($$ + ($$ << 15))) unless ($pid);
449 } elsif ($! == EAGAIN) {
450 $self->error("Can't fork()! $!, taking 5 and trying again.") if (ref $self);
454 $self->error("Can't fork()! $!") if ($! && ref($self));
460 #------------------------------------------------------------------------------------------------------------------------------------