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 # This turns errors into warnings, so daemons don't die.
34 #$Storable::forgive_me = 1;
37 common => [qw(interval_to_seconds seconds_to_interval sendmail)],
38 daemon => [qw(safe_fork set_psname daemonize)],
39 datetime => [qw(clense_ISO8601 gmtime_ISO8601 interval_to_seconds seconds_to_interval)],
42 Exporter::export_ok_tags('common','daemon','datetime'); # add aa, cc and dd to @EXPORT_OK
46 my $type = ref($self) or return undef;
49 $name =~ s/.*://; # strip fully-qualified portion
52 return $self->{$name} = shift;
54 return $self->{$name};
60 my $class = ref($self) || $self;
62 unless ($class->can($part)) {
63 *{$class.'::'.$part} =
68 $$self{$part} = $new_val;
75 #sub standalone_ipc_cache {
77 # my $class = ref($self) || $self;
78 # my $uniquifier = shift || return undef;
79 # my $expires = shift || 3600;
81 # return new Cache::FileCache ( { namespace => $class.'::'.$uniquifier, default_expires_in => $expires } );
86 my $message = shift || $self;
88 open SM, '|/usr/sbin/sendmail -U -t' or return 0;
94 sub __strip_comments {
96 my $config_file = shift;
98 while (<$config_file>) {
99 s/^\s*(.*)\s*$/$1/o if (lc($$self{keep_space}) ne 'true');
102 # keep new lines if keep_space is true
103 if ($line =~ /^$/o && (lc($$self{keep_space}) ne 'true')) {
107 if (/^([^<]+)\s*<<\s*(\w+)\s*$/o) {
110 while (<$config_file>) {
112 last if (/^$breaker/);
117 if ($line =~ /^#/ && $line !~ /^#\s*include\s+/o) {
121 if ($line =~ /\\$/o) {
123 $line =~ s/^\s*(.*)\s*\\$/$1/o;
133 =head2 $thing->encrypt(@stuff)
135 Returns a one way hash (MD5) of the values appended together.
141 return md5_hex(join('',@_));
144 =head2 $utils_obj->es_time('field') OR noo_es_time($timestamp)
146 Returns the epoch-second style timestamp for the value stored in
147 $utils_obj->{field}. Returns B<0> for an empty or invalid date stamp, and
148 assumes a PostgreSQL style datestamp to be supplied.
155 my $es_part = $part.'_ES';
156 return $$self{$es_part} if (exists($$self{$es_part}) && defined($$self{$es_part}) && $$self{$es_part});
157 if (!$$self{$part} or $$self{$part} !~ /\d+/) {
161 my @tm = reverse($$self{$part} =~ /([\d\.]+)/og);
166 return $$self{$es_part} = noo_es_time($$self{$part});
169 =head2 noo_es_time($timestamp) (non-OO es_time)
171 Returns the epoch-second style timestamp for the B<$timestamp> passed
172 in. Returns B<0> for an empty or invalid date stamp, and
173 assumes a PostgreSQL style datestamp to be supplied.
178 my $timestamp = shift;
180 my @tm = reverse($timestamp =~ /([\d\.]+)/og);
184 return timelocal(int($tm[1]), int($tm[2]), int($tm[3]), int($tm[4]) || 1, int($tm[5]), int($tm[6]) || 2002 );
188 =head2 $thing->interval_to_seconds('interval') OR interval_to_seconds('interval')
190 =head2 $thing->seconds_to_interval($seconds) OR seconds_to_interval($seconds)
192 Returns the number of seconds for any interval passed, or the interval for the seconds.
193 This is the generic version of B<interval> listed below.
195 The interval must match the regex I</\s*\+?\s*(\d+)\s*(\w{1})\w*\s*/g>, for example
196 B<2 weeks, 3 d and 1hour + 17 Months> or
197 B<1 year, 5 Months, 2 weeks, 3 days and 1 hour of seconds> meaning 46148400 seconds.
199 my $expire_time = time() + $thing->interval_to_seconds('17h 9m');
201 The time size indicator may be one of
227 for months (really (365 * 1d)/12 ... that may get smarter, though)
231 for years (this is 365 * 1d)
236 sub interval_to_seconds {
238 my $interval = shift || $self;
240 $interval =~ s/and/,/g;
241 $interval =~ s/,/ /g;
244 while ($interval =~ /\s*\+?\s*(\d+)\s*((\w{1})\w*)\s*/g) {
245 $amount += $1 if ($3 eq 's');
246 $amount += 60 * $1 if ($3 eq 'm' || $2 =~ /^mi/io);
247 $amount += 60 * 60 * $1 if ($3 eq 'h');
248 $amount += 60 * 60 * 24 * $1 if ($3 eq 'd');
249 $amount += 60 * 60 * 24 * 7 * $1 if ($3 eq 'w');
250 $amount += ((60 * 60 * 24 * 365)/12) * $1 if ($3 eq 'M' || $2 =~ /^mo/io);
251 $amount += 60 * 60 * 24 * 365 * $1 if ($2 eq 'y');
256 sub seconds_to_interval {
258 my $interval = shift || $self;
260 my $limit = shift || 's';
261 $limit =~ s/^(.)/$1/o;
263 my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s,$string);
264 my ($year, $month, $week, $day, $hour, $minute, $second) =
265 ('year','Month','week','day', 'hour', 'minute', 'second');
267 if ($y = int($interval / (60 * 60 * 24 * 365))) {
268 $string = "$y $year". ($y > 1 ? 's' : '');
269 $ym = $interval % (60 * 60 * 24 * 365);
273 return $string if ($limit eq 'y');
275 if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
276 $string .= ($string ? ', ':'')."$M $month". ($M > 1 ? 's' : '');
277 $Mm = $ym % ((60 * 60 * 24 * 365)/12);
281 return $string if ($limit eq 'M');
283 if ($w = int($Mm / 604800)) {
284 $string .= ($string ? ', ':'')."$w $week". ($w > 1 ? 's' : '');
289 return $string if ($limit eq 'w');
291 if ($d = int($wm / 86400)) {
292 $string .= ($string ? ', ':'')."$d $day". ($d > 1 ? 's' : '');
297 return $string if ($limit eq 'd');
299 if ($h = int($dm / 3600)) {
300 $string .= ($string ? ', ' : '')."$h $hour". ($h > 1 ? 's' : '');
305 return $string if ($limit eq 'h');
307 if ($m = int($hm / 60)) {
308 $string .= ($string ? ', ':'')."$m $minute". ($m > 1 ? 's' : '');
313 return $string if ($limit eq 'm');
316 $string .= ($string ? ', ':'')."$s $second". ($s > 1 ? 's' : '');
318 $string = "0s" unless ($string);
328 =head2 $utils_obj->set_psname('string') OR set_psname('string')
330 Sets the name of this process in a B<ps> listing to B<string>.
337 my $PS_NAME = shift || $self;
338 $0 = $PS_NAME if ($PS_NAME);
345 my $y = $date[5] + 1900;
346 my $M = $date[4] + 1;
352 return sprintf('%d-%0.2d-%0.2dT%0.2d:%0.2d:%0.2d+00:00', $y, $M, $d, $h, $m, $s);
357 my $date = shift || $self;
358 if ($date =~ /^\s*(\d{4})-?(\d{2})-?(\d{2}).?(\d{2}):(\d{2}):(\d{2})\.?\d*((?:-|\+)[0-9:]{2,5})?\s*$/o) {
359 my $z = $7 || '+00:00';
360 if (length($z) > 3 && $z !~ /:/o) {
363 $date = "$1-$2-$3T$4:$5:$6$z";
368 =head2 $utils_obj->daemonize('ps_name') OR daemonize('ps_name')
370 Turns the current process into a daemon. B<ps_name> is optional, and is used
371 as the argument to I<< set_psname() >> if passed.
378 my $PS_NAME = shift || $self;
380 if ($pid = safe_fork($self)) {
382 } elsif (defined($pid)) {
383 set_psname($PS_NAME);
390 =head2 $utils_obj->safe_fork('ps_name') OR safe_fork('ps_name');
392 Forks the current process in a retry loop. B<ps_name> is optional, and is used
393 as the argument to I<< set_psname() >> if passed.
404 if (defined($pid = fork())) {
405 srand(time ^ ($$ + ($$ << 15))) unless ($pid);
407 } elsif ($! == EAGAIN) {
408 $self->error("Can't fork()! $!, taking 5 and trying again.") if (ref $self);
412 $self->error("Can't fork()! $!") if ($! && ref($self));
418 #------------------------------------------------------------------------------------------------------------------------------------