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;
36 %EXPORT_TAGS = (common => [qw(interval_to_seconds seconds_to_interval sendmail)], daemon => [qw(safe_fork set_psname daemonize)]);
38 Exporter::export_ok_tags('common','daemon'); # add aa, cc and dd to @EXPORT_OK
42 my $type = ref($self) or return undef;
45 $name =~ s/.*://; # strip fully-qualified portion
48 return $self->{$name} = shift;
50 return $self->{$name};
56 my $class = ref($self) || $self;
58 unless ($class->can($part)) {
59 *{$class.'::'.$part} =
64 $$self{$part} = $new_val;
71 #sub standalone_ipc_cache {
73 # my $class = ref($self) || $self;
74 # my $uniquifier = shift || return undef;
75 # my $expires = shift || 3600;
77 # return new Cache::FileCache ( { namespace => $class.'::'.$uniquifier, default_expires_in => $expires } );
82 my $message = shift || $self;
84 open SM, '|/usr/sbin/sendmail -U -t' or return 0;
90 sub __strip_comments {
92 my $config_file = shift;
94 while (<$config_file>) {
95 s/^\s*(.*)\s*$/$1/o if (lc($$self{keep_space}) ne 'true');
98 # keep new lines if keep_space is true
99 if ($line =~ /^$/o && (lc($$self{keep_space}) ne 'true')) {
103 if (/^([^<]+)\s*<<\s*(\w+)\s*$/o) {
106 while (<$config_file>) {
108 last if (/^$breaker/);
113 if ($line =~ /^#/ && $line !~ /^#\s*include\s+/o) {
117 if ($line =~ /\\$/o) {
119 $line =~ s/^\s*(.*)\s*\\$/$1/o;
129 =head2 $thing->encrypt(@stuff)
131 Returns a one way hash (MD5) of the values appended together.
137 return md5_hex(join('',@_));
140 =head2 $utils_obj->es_time('field') OR noo_es_time($timestamp)
142 Returns the epoch-second style timestamp for the value stored in
143 $utils_obj->{field}. Returns B<0> for an empty or invalid date stamp, and
144 assumes a PostgreSQL style datestamp to be supplied.
151 my $es_part = $part.'_ES';
152 return $$self{$es_part} if (exists($$self{$es_part}) && defined($$self{$es_part}) && $$self{$es_part});
153 if (!$$self{$part} or $$self{$part} !~ /\d+/) {
157 my @tm = reverse($$self{$part} =~ /([\d\.]+)/og);
162 return $$self{$es_part} = noo_es_time($$self{$part});
165 =head2 noo_es_time($timestamp) (non-OO es_time)
167 Returns the epoch-second style timestamp for the B<$timestamp> passed
168 in. Returns B<0> for an empty or invalid date stamp, and
169 assumes a PostgreSQL style datestamp to be supplied.
174 my $timestamp = shift;
176 my @tm = reverse($timestamp =~ /([\d\.]+)/og);
180 return timelocal(int($tm[1]), int($tm[2]), int($tm[3]), int($tm[4]) || 1, int($tm[5]), int($tm[6]) || 2002 );
184 =head2 $thing->interval_to_seconds('interval') OR interval_to_seconds('interval')
186 =head2 $thing->seconds_to_interval($seconds) OR seconds_to_interval($seconds)
188 Returns the number of seconds for any interval passed, or the interval for the seconds.
189 This is the generic version of B<interval> listed below.
191 The interval must match the regex I</\s*\+?\s*(\d+)\s*(\w{1})\w*\s*/g>, for example
192 B<2 weeks, 3 d and 1hour + 17 Months> or
193 B<1 year, 5 Months, 2 weeks, 3 days and 1 hour of seconds> meaning 46148400 seconds.
195 my $expire_time = time() + $thing->interval_to_seconds('17h 9m');
197 The time size indicator may be one of
223 for months (really (365 * 1d)/12 ... that may get smarter, though)
227 for years (this is 365 * 1d)
232 sub interval_to_seconds {
234 my $interval = shift || $self;
236 $interval =~ s/and/,/g;
240 while ($interval =~ /\s*\+?\s*(\d+)\s*(\w{1})\w*\s*/g) {
241 $amount += $1 if ($2 eq 's');
242 $amount += 60 * $1 if ($2 eq 'm');
243 $amount += 60 * 60 * $1 if ($2 eq 'h');
244 $amount += 60 * 60 * 24 * $1 if ($2 eq 'd');
245 $amount += 60 * 60 * 24 * 7 * $1 if ($2 eq 'w');
246 $amount += ((60 * 60 * 24 * 365)/12) * $1 if ($2 eq 'M');
247 $amount += 60 * 60 * 24 * 365 * $1 if ($2 eq 'y');
252 sub seconds_to_interval {
254 my $interval = shift || $self;
256 my $limit = shift || 's';
257 $limit =~ s/^(.)/$1/o;
259 my ($y,$ym,$M,$Mm,$w,$wm,$d,$dm,$h,$hm,$m,$mm,$s,$string);
260 my ($year, $month, $week, $day, $hour, $minute, $second) =
261 ('year','Month','week','day', 'hour', 'minute', 'second');
263 if ($y = int($interval / (60 * 60 * 24 * 365))) {
264 $string = "$y $year". ($y > 1 ? 's' : '');
265 $ym = $interval % (60 * 60 * 24 * 365);
269 return $string if ($limit eq 'y');
271 if ($M = int($ym / ((60 * 60 * 24 * 365)/12))) {
272 $string .= ($string ? ', ':'')."$M $month". ($M > 1 ? 's' : '');
273 $Mm = $ym % ((60 * 60 * 24 * 365)/12);
277 return $string if ($limit eq 'M');
279 if ($w = int($Mm / 604800)) {
280 $string .= ($string ? ', ':'')."$w $week". ($w > 1 ? 's' : '');
285 return $string if ($limit eq 'w');
287 if ($d = int($wm / 86400)) {
288 $string .= ($string ? ', ':'')."$d $day". ($d > 1 ? 's' : '');
293 return $string if ($limit eq 'd');
295 if ($h = int($dm / 3600)) {
296 $string .= ($string ? ', ' : '')."$h $hour". ($h > 1 ? 's' : '');
301 return $string if ($limit eq 'h');
303 if ($m = int($hm / 60)) {
304 $string .= ($string ? ', ':'')."$m $minute". ($m > 1 ? 's' : '');
309 return $string if ($limit eq 'm');
312 $string .= ($string ? ', ':'')."$s $second". ($s > 1 ? 's' : '');
314 $string = "Brand New!!!" unless ($string);
324 =head2 $utils_obj->set_psname('string') OR set_psname('string')
326 Sets the name of this process in a B<ps> listing to B<string>.
333 my $PS_NAME = shift || $self;
334 $0 = $PS_NAME if ($PS_NAME);
337 =head2 $utils_obj->daemonize('ps_name') OR daemonize('ps_name')
339 Turns the current process into a daemon. B<ps_name> is optional, and is used
340 as the argument to I<< set_psname() >> if passed.
347 my $PS_NAME = shift || $self;
349 if ($pid = safe_fork($self)) {
351 } elsif (defined($pid)) {
352 set_psname($PS_NAME);
359 =head2 $utils_obj->safe_fork('ps_name') OR safe_fork('ps_name');
361 Forks the current process in a retry loop. B<ps_name> is optional, and is used
362 as the argument to I<< set_psname() >> if passed.
373 if (defined($pid = fork())) {
374 srand(time ^ ($$ + ($$ << 15))) unless ($pid);
376 } elsif ($! == EAGAIN) {
377 $self->error("Can't fork()! $!, taking 5 and trying again.") if (ref $self);
381 $self->error("Can't fork()! $!") if ($! && ref($self));
387 #------------------------------------------------------------------------------------------------------------------------------------