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);
90 # In case the user hits Ctrl-C
91 print "\nControl-C\n";
98 sub EnterDaemonMode (;$$$) {
99 my ($logfile, $errorlog, $pidfile) = @_;
103 =head2 EnterDaemonMode ($logfile, $errorlog)
105 There is a right way to enter "daemon mode" and this routine is for that. If you
106 call EnterDaemonMode your process will be disassociated from the terminal and
107 enter into a background mode just like a good daemon.
111 =for html <blockquote>
117 File name of where to redirect STDOUT for the daemon (Default: $NULL)
121 File name of where to redirect STDERR for the daemon (Default: $NULL)
125 =for html </blockquote>
129 =for html <blockquote>
137 =for html </blockquote>
146 # Redirect STDIN to $NULL
147 open STDIN, '<', $NULL
148 or error "Can't read $NULL ($!)", 1;
150 # Redirect STDOUT to logfile
151 open STDOUT, '>>', $logfile
152 or error "Can't write to $logfile ($!)", 1;
154 # Redirect STDERR to errorlog
155 open STDERR, '>>', $errorlog
156 or error "Can't write to $errorlog ($!)", 1;
158 # Change the current directory to /
159 my $ROOT = $ARCH eq "windows" ? "C:\\" : "/";
161 or error "Can't chdir to $ROOT ($!), 1";
166 # Now fork the daemon
167 defined (my $pid = fork)
168 or error "Can't create daemon ($!)", 1;
170 # Now the parent exits
173 # Write pidfile if specified
175 $pidfile = File::Spec->rel2abs ($pidfile);
177 open $file, '>', $pidfile
178 or warning "Unable to open pidfile $pidfile for writing - $!";
185 # Set process to be session leader
187 or error "Can't start a new session ($!)", 1;
197 =head2 Execute ($command)
199 We all execute OS commands and then have to deal with the output and return
200 codes and the like. How about an easy Execute subroutine. It takes one
201 parameter, the command to execute, executes it and returns two parameters, the
202 output in a nice chomped array and the status.
206 =for html <blockquote>
216 =for html </blockquote>
220 =for html <blockquote>
224 =item A status scalar and an array of lines output from the command (if any).
226 Note, no redirection of STDERR is included. If you want STDERR included in
227 STDOUT then do so in the $command passed in.
231 =for html </blockquote>
235 # Save $SIG{CHLD} so we can set it to 'DEFAULT' and then restore it later.
236 # Helps when you are doing process handling.
237 my $sigchld = $SIG{CHLD};
239 local $SIG{CHLD} = 'DEFAULT';
244 local $SIG{CHLD} = $sigchld;
248 return ($status, @output);
251 sub GetChildren (;$) {
256 =head2 GetChildren ($pid)
258 Returns an array of children pids for the passed in $pid.
260 NOTE: This assumes that the utility pstree exists and is in the callers PATH.
264 =for html <blockquote>
270 $pid to return the subtree of (Default: pid of init)
274 =for html </blockquote>
278 =for html <blockquote>
282 =item Array of children pids
286 =for html </blockquote>
294 my @output = `pstree -ap $pid`;
296 return @children if $? == 0;
301 # Skip the pstree process and the parent process - we want only
303 next if /pstree/ or /\($pid\)/;
313 sub GetPassword (;$) {
318 =head2 GetPassword (;$prompt)
320 Prompt for a password
324 =for html <blockquote>
330 Prompt string to use (Default: "Password:")
334 =for html </blockquote>
338 =for html <blockquote>
346 =for html </blockquote>
351 $prompt ||= 'Password';
359 $SIG{INT} = \&_restoreTerm;
366 while (not defined ($key = ReadKey -1)) { }
368 if ($key =~ /(\r|\n)/) {
379 ReadMode 'restore'; # Reset tty mode before exiting.
381 $SIG{INT} = 'DEFAULT';
387 my ($item, @array) = @_;
391 =head2 InArray ($item, @array)
393 Find an item in an array.
397 =for html <blockquote>
411 =for html </blockquote>
415 =for html <blockquote>
419 =item $TRUE if found - $FALSE otherwise
423 =for html </blockquote>
428 return $TRUE if $item eq $_;
440 Return an array of the 1, 5, and 15 minute load averages.
444 =for html <blockquote>
452 =for html </blockquote>
456 =for html <blockquote>
460 =item An array of the 1, 5, and 15 minute load averages in a list context.
461 In a scalar context just the 1 minute load average.
465 =for html </blockquote>
469 # TODO: Make it work on Windows...
470 return if $^O =~ /win/i;
472 open my $loadAvg, '/proc/loadavg'
473 or croak "Unable to open /proc/loadavg\n";
475 my $load = <$loadAvg>;
479 my @loadAvgs = split /\s/, $load;
484 return $loadAvgs[0]; # This is the 1 minute average
490 sub StartPipe ($;$) {
491 my ($to, $existingPipe) = @_;
495 =head2 StartPipe ($to, $existingPipe)
501 =for html <blockquote>
507 String representing the other end of the pipe
511 Already existing pipe handle (from a previous call to StartPipe)
515 =for html </blockquote>
519 =for html <blockquote>
523 =item A $pipe to used for PipeOutput
527 =for html </blockquote>
534 open $existingPipe, '|-', $to
535 or error "Unable to open pipe - $!", 1;
537 return $existingPipe;
539 open $pipe, '|-', $to
540 or error "Unable to open pipe - $!", 1;
546 sub PipeOutputArray ($@) {
547 my ($to, @output) = @_;
551 =head2 PipeOutputArray ($to, @ouput)
557 =for html <blockquote>
563 String representing the other end of the pipe to pipe @output to
571 =for html </blockquote>
575 =for html <blockquote>
583 =for html </blockquote>
587 open my $pipe, '|', $to
588 or error "Unable to open pipe - $!", 1;
599 sub PipeOutput ($;$) {
600 my ($line, $topipe) = @_;
604 =head2 PipeOutput ($line, $topipe)
606 Pipes a single line to $topipe
610 =for html <blockquote>
616 Line to output to $topipe.
620 A pipe returned by StartPipe (or our $pipe) to which the $line is piped.
624 =for html </blockquote>
628 =for html <blockquote>
636 =for html </blockquote>
642 chomp $line; chop $line if $line =~ /\r$/;
644 print $pipe "$line\n";
650 my ($pipeToStop) = @_;
654 =head2 StopPipe ($pipe)
660 =for html <blockquote>
670 =for html </blockquote>
674 =for html <blockquote>
682 =for html </blockquote>
686 $pipeToStop ||= $pipe;
688 close $pipeToStop if $pipeToStop;
698 =head2 PageOutput (@ouput)
700 Pages output to the screen
704 =for html <blockquote>
714 =for html </blockquote>
718 =for html <blockquote>
726 =for html </blockquote>
731 PipeOutputArray $ENV{PAGER}, @output;
740 sub RedirectOutput ($$@) {
741 my ($to, $mode, @output) = @_;
745 =head2 RedirectOutput ($to, @ouput)
747 Pages output to the screen
751 =for html <blockquote>
757 Where to send the output
765 =for html </blockquote>
769 =for html <blockquote>
777 =for html </blockquote>
781 croak 'Mode must be > or >>'
782 unless ($mode eq '>' or $mode eq '>>');
784 open my $out, $mode, $to
785 or croak "Unable to open $to for writing - $!";
800 =head2 ReadFile ($filename)
802 How many times have you coded a Perl subroutine, or just staight inline Perl to
803 open a file, read all the lines into an array and close the file. This routine
804 does that very thing along with the associated and proper checking of open
805 failure and even trims the lines in the output array of trailing newlines? This
806 routine returns an array of the lines in the filename passed in.
810 =for html <blockquote>
820 =for html </blockquote>
824 =for html <blockquote>
828 =item Array of lines in the file
832 =for html </blockquote>
836 open my $file, '<', $filename
837 or error "Unable to open $filename ($!)", 1;
845 or error "Unable to close $filename ($!)", 1;
852 push @cleansed_lines, $_ if !/^#/; # Discard comment lines
855 return @cleansed_lines;
864 my ($total, $log) = @_;
868 =head2 Stats ($total, $log)
870 Reports runtime stats
874 =for html <blockquote>
880 Reference to a hash of total counters. The keys of the hash will be the labels
881 and the values of the hash will be the counters.
885 Logger object to log stats to (if specified). Note: if the Logger object has
886 errors or warnings then they will be automatically included in the output.
890 =for html </blockquote>
894 =for html <blockquote>
902 =for html </blockquote>
906 my $msg = "$FindBin::Script Run Statistics:";
908 if ($log and ref $log eq 'Logger') {
909 $total->{errors} = $log->{errors};
910 $total->{warnings} = $log->{warnings};
914 # Display statistics (if any)
921 foreach (sort keys %$total) {
922 $msg = $total->{$_} . "\t $_";
925 $log->msg ($total->{$_} . "\t $_");
942 Reports usage using perldoc
946 =for html <blockquote>
952 Message to output before doing perldoc
956 =for html </blockquote>
960 =for html <blockquote>
964 =item Does not return
968 =for html </blockquote>
986 =head1 CONFIGURATION AND ENVIRONMENT
994 L<File::Spec|File::Spec>
1000 =head2 ClearSCM Perl Modules
1002 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
1004 =for html <p><a href="/php/scm_man.php?file=lib/Logger.pm">Logger</a></p>
1006 =for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSDep</a></p>
1008 =head1 INCOMPATABILITIES
1012 =head1 BUGS AND LIMITATIONS
1014 There are no known bugs in this module.
1016 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
1018 =head1 LICENSE AND COPYRIGHT
1020 This Perl Module is freely available; you can redistribute it and/or modify it
1021 under the terms of the GNU General Public License as published by the Free
1022 Software Foundation; either version 2 of the License, or (at your option) any
1025 This Perl Module is distributed in the hope that it will be useful, but WITHOUT
1026 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
1027 FOR A PARTICULAR PURPOSE. See the GNU General Public License
1028 (L<http://www.gnu.org/copyleft/gpl.html>) for more details.
1030 You should have received a copy of the GNU General Public License along with
1031 this Perl Module; if not, write to the Free Software Foundation, Inc., 59
1032 Temple Place - Suite 330, Boston, MA 02111-1307, USA. reserved.