3 =head1 NAME $RCSfile: Utils.pm,v $
5 Utils - Simple and often used utilities
13 Andrew DeFaria <Andrew@ClearSCM.com>
21 Thu Jan 5 15:15:29 PST 2006
25 $Date: 2013/03/28 21:18:55 $
31 This module seeks to encapsulate useful utilities, things that are often done
32 over and over again but who's classification is miscellaneous.
36 my @children = GetChildren ($pid);
38 my @lines = ReadFile ("/tmp/file");
40 print "Found foo!\n" if InArray ("foo", @bar);
42 my ($status, @output) = Execute ("ps -ef");
46 A collection of utility type subroutines.
50 The following routines are exported:
63 use POSIX qw (setsid);
86 sub EnterDaemonMode (;$$$) {
87 my ($logfile, $errorlog, $pidfile) = @_;
91 =head2 EnterDaemonMode ($logfile, $errorlog)
93 There is a right way to enter "daemon mode" and this routine is for that. If you
94 call EnterDaemonMode your process will be disassociated from the terminal and
95 enter into a background mode just like a good daemon.
99 =for html <blockquote>
105 File name of where to redirect STDOUT for the daemon (Default: $NULL)
109 File name of where to redirect STDERR for the daemon (Default: $NULL)
113 =for html </blockquote>
117 =for html <blockquote>
125 =for html </blockquote>
135 $pidfile = File::Spec->rel2abs ($pidfile);
137 open $file, '>', $pidfile
138 or warning "Unable to open pidfile $pidfile for writing - $!";
141 # Redirect STDIN to $NULL
142 open STDIN, '<', $NULL
143 or error "Can't read $NULL ($!)", 1;
145 # Redirect STDOUT to logfile
146 open STDOUT, '>>', $logfile
147 or error "Can't write to $logfile ($!)", 1;
149 # Redirect STDERR to errorlog
150 open STDERR, '>>', $errorlog
151 or error "Can't write to $errorlog ($!)", 1;
153 # Change the current directory to /
154 my $ROOT = $ARCH eq "windows" ? "C:\\" : "/";
156 or error "Can't chdir to $ROOT ($!), 1";
161 # Now fork the daemon
162 defined (my $pid = fork)
163 or error "Can't create daemon ($!)", 1;
165 # Now the parent exits
168 # Write pidfile if specified
175 # Set process to be session leader
177 or error "Can't start a new session ($!)", 1;
187 =head2 Execute ($command)
189 We all execute OS commands and then have to deal with the output and return
190 codes and the like. How about an easy Execute subroutine. It takes one
191 parameter, the command to execute, executes it and returns two parameters, the
192 output in a nice chomped array and the status.
196 =for html <blockquote>
206 =for html </blockquote>
210 =for html <blockquote>
214 =item A status scalar and an array of lines output from the command (if any).
216 Note, no redirection of STDERR is included. If you want STDERR included in
217 STDOUT then do so in the $command passed in.
221 =for html </blockquote>
225 # Save $SIG{CHLD} so we can set it to 'DEFAULT' and then restore it later.
226 # Helps when you are doing process handling.
227 my $sigchld = $SIG{CHLD};
229 local $SIG{CHLD} = 'DEFAULT';
234 local $SIG{CHLD} = $sigchld;
238 return ($status, @output);
241 sub GetChildren (;$) {
246 =head2 GetChildren ($pid)
248 Returns an array of children pids for the passed in $pid.
250 NOTE: This assumes that the utility pstree exists and is in the callers PATH.
254 =for html <blockquote>
260 $pid to return the subtree of (Default: pid of init)
264 =for html </blockquote>
268 =for html <blockquote>
272 =item Array of children pids
276 =for html </blockquote>
284 my @output = `pstree -ap $pid`;
286 return @children if $? == 0;
291 # Skip the pstree process and the parent process - we want only
293 next if /pstree/ or /\($pid\)/;
304 my ($item, @array) = @_;
308 =head2 InArray ($item, @array)
310 Find an item in an array.
314 =for html <blockquote>
328 =for html </blockquote>
332 =for html <blockquote>
336 =item $TRUE if found - $FALSE otherwise
340 =for html </blockquote>
345 return $TRUE if $item eq $_;
353 sub StartPipe ($;$) {
354 my ($to, $existingPipe) = @_;
358 =head2 StartPipe ($to, $existingPipe)
364 =for html <blockquote>
370 String representing the other end of the pipe
374 Already existing pipe handle (from a previous call to StartPipe)
378 =for html </blockquote>
382 =for html <blockquote>
386 =item A $pipe to used for PipeOutput
390 =for html </blockquote>
397 open $existingPipe, '|-', $to
398 or error "Unable to open pipe - $!", 1;
400 return $existingPipe;
402 open $pipe, '|-', $to
403 or error "Unable to open pipe - $!", 1;
409 sub PipeOutputArray ($@) {
410 my ($to, @output) = @_;
414 =head2 PipeOutputArray ($to, @ouput)
420 =for html <blockquote>
426 String representing the other end of the pipe to pipe @output to
434 =for html </blockquote>
438 =for html <blockquote>
446 =for html </blockquote>
450 open my $pipe, "|$to"
451 or error "Unable to open pipe - $!", 1;
462 sub PipeOutput ($;$) {
463 my ($line, $topipe) = @_;
467 =head2 PipeOutput ($line, $topipe)
469 Pipes a single line to $topipe
473 =for html <blockquote>
479 Line to output to $topipe.
483 A pipe returned by StartPipe (or our $pipe) to which the $line is piped.
487 =for html </blockquote>
491 =for html <blockquote>
499 =for html </blockquote>
505 chomp $line; chop $line if $line =~ /\r$/;
507 print $pipe "$line\n";
513 my ($pipeToStop) = @_;
517 =head2 StopPipe ($pipe)
523 =for html <blockquote>
533 =for html </blockquote>
537 =for html <blockquote>
545 =for html </blockquote>
549 $pipeToStop ||= $pipe;
551 close $pipeToStop if $pipeToStop;
559 =head2 PageOutput (@ouput)
561 Pages output to the screen
565 =for html <blockquote>
575 =for html </blockquote>
579 =for html <blockquote>
587 =for html </blockquote>
592 PipeOutputArray $ENV{PAGER}, @output;
601 sub RedirectOutput ($$@) {
602 my ($to, $mode, @output) = @_;
606 =head2 RedirectOutput ($to, @ouput)
608 Pages output to the screen
612 =for html <blockquote>
618 Where to send the output
626 =for html </blockquote>
630 =for html <blockquote>
638 =for html </blockquote>
642 croak 'Mode must be > or >>'
643 unless ($mode eq '>' or $mode eq '>>');
645 open my $out, $mode, $to
646 or croak "Unable to open $to for writing - $!";
661 =head2 ReadFile ($filename)
663 How many times have you coded a Perl subroutine, or just staight inline Perl to
664 open a file, read all the lines into an array and close the file. This routine
665 does that very thing along with the associated and proper checking of open
666 failure and even trims the lines in the output array of trailing newlines? This
667 routine returns an array of the lines in the filename passed in.
671 =for html <blockquote>
681 =for html </blockquote>
685 =for html <blockquote>
689 =item Array of lines in the file
693 =for html </blockquote>
697 open my $file, '<', $filename
698 or error "Unable to open $filename ($!)", 1;
706 or error "Unable to close $filename ($!)", 1;
713 push @cleansed_lines, $_ if !/^#/; # Discard comment lines
716 return @cleansed_lines;
725 my ($total, $log) = @_;
729 =head2 Stats ($total, $log)
731 Reports runtime stats
735 =for html <blockquote>
741 Reference to a hash of total counters. The keys of the hash will be the labels
742 and the values of the hash will be the counters.
746 Logger object to log stats to (if specified)
750 =for html </blockquote>
754 =for html <blockquote>
762 =for html </blockquote>
766 my $msg = "$FindBin::Script Run Statistics:";
768 if (scalar keys %$total) {
769 # Display statistics (if any)
776 foreach (sort keys %$total) {
777 $msg = $$total{$_} . "\t $_";
780 $log->msg ($$total{$_} . "\t $_");
797 Reports usage using perldoc
801 =for html <blockquote>
807 Message to output before doing perldoc
811 =for html </blockquote>
815 =for html <blockquote>
819 =item Does not return
823 =for html </blockquote>
841 =head1 CONFIGURATION AND ENVIRONMENT
849 L<File::Spec|File::Spec>
855 =head2 ClearSCM Perl Modules
857 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
859 =for html <p><a href="/php/scm_man.php?file=lib/Logger.pm">Logger</a></p>
861 =for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSDep</a></p>
863 =head1 INCOMPATABILITIES
867 =head1 BUGS AND LIMITATIONS
869 There are no known bugs in this module.
871 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
873 =head1 LICENSE AND COPYRIGHT
875 This Perl Module is freely available; you can redistribute it and/or modify it
876 under the terms of the GNU General Public License as published by the Free
877 Software Foundation; either version 2 of the License, or (at your option) any
880 This Perl Module is distributed in the hope that it will be useful, but WITHOUT
881 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
882 FOR A PARTICULAR PURPOSE. See the GNU General Public License
883 (L<http://www.gnu.org/copyleft/gpl.html>) for more details.
885 You should have received a copy of the GNU General Public License along with
886 this Perl Module; if not, write to the Free Software Foundation, Inc., 59
887 Temple Place - Suite 330, Boston, MA 02111-1307, USA. reserved.