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 = $ARCHITECTURE 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 local $SIG{CHLD} = 'DEFAULT';
242 return ($status, @output);
245 sub GetChildren (;$) {
250 =head2 GetChildren ($pid)
252 Returns an array of children pids for the passed in $pid.
254 NOTE: This assumes that the utility pstree exists and is in the callers PATH.
258 =for html <blockquote>
264 $pid to return the subtree of (Default: pid of init)
268 =for html </blockquote>
272 =for html <blockquote>
276 =item Array of children pids
280 =for html </blockquote>
288 my @output = `pstree -ap $pid`;
290 return @children if $? == 0;
295 # Skip the pstree process and the parent process - we want only
297 next if /pstree/ or /\($pid\)/;
307 sub GetPassword (;$) {
312 =head2 GetPassword (;$prompt)
314 Prompt for a password
318 =for html <blockquote>
324 Prompt string to use (Default: "Password:")
328 =for html </blockquote>
332 =for html <blockquote>
340 =for html </blockquote>
344 $prompt ||= 'Password';
352 $SIG{INT} = \&_restoreTerm;
359 while (not defined ($key = ReadKey -1)) { }
361 if ($key =~ /(\r|\n)/) {
368 if ($key eq chr(127)) {
369 unless ($password eq '') {
381 ReadMode 'restore'; # Reset tty mode before exiting.
383 $SIG{INT} = 'DEFAULT';
389 my ($item, @array) = @_;
393 =head2 InArray ($item, @array)
395 Find an item in an array.
399 =for html <blockquote>
413 =for html </blockquote>
417 =for html <blockquote>
421 =item $TRUE if found - $FALSE otherwise
425 =for html </blockquote>
430 return $TRUE if $item eq $_;
442 Return an array of the 1, 5, and 15 minute load averages.
446 =for html <blockquote>
454 =for html </blockquote>
458 =for html <blockquote>
462 =item An array of the 1, 5, and 15 minute load averages in a list context.
463 In a scalar context just the 1 minute load average.
467 =for html </blockquote>
471 # TODO: Make it work on Windows...
472 return if $^O =~ /win/i;
474 open my $loadAvg, '<', '/proc/loadavg'
475 or croak "Unable to open /proc/loadavg\n";
477 my $load = <$loadAvg>;
481 my @loadAvgs = split /\s/, $load;
486 return $loadAvgs[0]; # This is the 1 minute average
492 sub StartPipe ($;$) {
493 my ($to, $existingPipe) = @_;
497 =head2 StartPipe ($to, $existingPipe)
503 =for html <blockquote>
509 String representing the other end of the pipe
513 Already existing pipe handle (from a previous call to StartPipe)
517 =for html </blockquote>
521 =for html <blockquote>
525 =item A $pipe to used for PipeOutput
529 =for html </blockquote>
536 open $existingPipe, '|-', $to
537 or error "Unable to open pipe - $!", 1;
539 return $existingPipe;
541 open $pipe, '|-', $to
542 or error "Unable to open pipe - $!", 1;
548 sub PipeOutputArray ($@) {
549 my ($to, @output) = @_;
553 =head2 PipeOutputArray ($to, @ouput)
559 =for html <blockquote>
565 String representing the other end of the pipe to pipe @output to
573 =for html </blockquote>
577 =for html <blockquote>
585 =for html </blockquote>
589 open my $pipe, '|', $to
590 or error "Unable to open pipe - $!", 1;
601 sub PipeOutput ($;$) {
602 my ($line, $topipe) = @_;
606 =head2 PipeOutput ($line, $topipe)
608 Pipes a single line to $topipe
612 =for html <blockquote>
618 Line to output to $topipe.
622 A pipe returned by StartPipe (or our $pipe) to which the $line is piped.
626 =for html </blockquote>
630 =for html <blockquote>
638 =for html </blockquote>
644 chomp $line; chop $line if $line =~ /\r$/;
646 print $pipe "$line\n";
652 my ($pipeToStop) = @_;
656 =head2 StopPipe ($pipe)
662 =for html <blockquote>
672 =for html </blockquote>
676 =for html <blockquote>
684 =for html </blockquote>
688 $pipeToStop ||= $pipe;
690 close $pipeToStop if $pipeToStop;
700 =head2 PageOutput (@ouput)
702 Pages output to the screen
706 =for html <blockquote>
716 =for html </blockquote>
720 =for html <blockquote>
728 =for html </blockquote>
733 PipeOutputArray $ENV{PAGER}, @output;
742 sub RedirectOutput ($$@) {
743 my ($to, $mode, @output) = @_;
747 =head2 RedirectOutput ($to, @ouput)
749 Pages output to the screen
753 =for html <blockquote>
759 Where to send the output
767 =for html </blockquote>
771 =for html <blockquote>
779 =for html </blockquote>
783 croak 'Mode must be > or >>'
784 unless ($mode eq '>' or $mode eq '>>');
786 open my $out, $mode, $to
787 or croak "Unable to open $to for writing - $!";
802 =head2 ReadFile ($filename)
804 How many times have you coded a Perl subroutine, or just staight inline Perl to
805 open a file, read all the lines into an array and close the file. This routine
806 does that very thing along with the associated and proper checking of open
807 failure and even trims the lines in the output array of trailing newlines? This
808 routine returns an array of the lines in the filename passed in.
812 =for html <blockquote>
822 =for html </blockquote>
826 =for html <blockquote>
830 =item Array of lines in the file
834 =for html </blockquote>
838 open my $file, '<', $filename
839 or error "Unable to open $filename ($!)", 1;
847 or error "Unable to close $filename ($!)", 1;
854 push @cleansed_lines, $_ if !/^#/; # Discard comment lines
857 return @cleansed_lines;
866 my ($total, $log) = @_;
870 =head2 Stats ($total, $log)
872 Reports runtime stats
876 =for html <blockquote>
882 Reference to a hash of total counters. The keys of the hash will be the labels
883 and the values of the hash will be the counters.
887 Logger object to log stats to (if specified). Note: if the Logger object has
888 errors or warnings then they will be automatically included in the output.
892 =for html </blockquote>
896 =for html <blockquote>
904 =for html </blockquote>
908 my $msg = "$FindBin::Script Run Statistics:";
910 if ($log and ref $log eq 'Logger') {
911 $total->{errors} = $log->{errors};
912 $total->{warnings} = $log->{warnings};
916 # Display statistics (if any)
923 foreach (sort keys %$total) {
924 $msg = $total->{$_} . "\t $_";
927 $log->msg ($total->{$_} . "\t $_");
944 Reports usage using perldoc
948 =for html <blockquote>
954 Message to output before doing perldoc
958 =for html </blockquote>
962 =for html <blockquote>
966 =item Does not return
970 =for html </blockquote>
988 =head1 CONFIGURATION AND ENVIRONMENT
996 L<File::Spec|File::Spec>
1002 =head2 ClearSCM Perl Modules
1004 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
1006 =for html <p><a href="/php/scm_man.php?file=lib/Logger.pm">Logger</a></p>
1008 =for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSDep</a></p>
1010 =head1 INCOMPATABILITIES
1014 =head1 BUGS AND LIMITATIONS
1016 There are no known bugs in this module.
1018 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
1020 =head1 LICENSE AND COPYRIGHT
1022 This Perl Module is freely available; you can redistribute it and/or modify it
1023 under the terms of the GNU General Public License as published by the Free
1024 Software Foundation; either version 2 of the License, or (at your option) any
1027 This Perl Module is distributed in the hope that it will be useful, but WITHOUT
1028 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
1029 FOR A PARTICULAR PURPOSE. See the GNU General Public License
1030 (L<http://www.gnu.org/copyleft/gpl.html>) for more details.
1032 You should have received a copy of the GNU General Public License along with
1033 this Perl Module; if not, write to the Free Software Foundation, Inc., 59
1034 Temple Place - Suite 330, Boston, MA 02111-1307, USA. reserved.