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);
91 # In case the user hits Ctrl-C
92 print "\nControl-C\n";
99 sub EnterDaemonMode (;$$$) {
100 my ($logfile, $errorlog, $pidfile) = @_;
104 =head2 EnterDaemonMode ($logfile, $errorlog)
106 There is a right way to enter "daemon mode" and this routine is for that. If you
107 call EnterDaemonMode your process will be disassociated from the terminal and
108 enter into a background mode just like a good daemon.
112 =for html <blockquote>
118 File name of where to redirect STDOUT for the daemon (Default: $NULL)
122 File name of where to redirect STDERR for the daemon (Default: $NULL)
126 =for html </blockquote>
130 =for html <blockquote>
138 =for html </blockquote>
147 # Redirect STDIN to $NULL
148 open STDIN, '<', $NULL
149 or error "Can't read $NULL ($!)", 1;
151 # Redirect STDOUT to logfile
152 open STDOUT, '>>', $logfile
153 or error "Can't write to $logfile ($!)", 1;
155 # Redirect STDERR to errorlog
156 open STDERR, '>>', $errorlog
157 or error "Can't write to $errorlog ($!)", 1;
159 # Change the current directory to /
160 my $ROOT = $ARCHITECTURE eq "windows" ? "C:\\" : "/";
162 or error "Can't chdir to $ROOT ($!), 1";
167 # Now fork the daemon
168 defined (my $pid = fork)
169 or error "Can't create daemon ($!)", 1;
171 # Now the parent exits
174 # Write pidfile if specified
176 $pidfile = File::Spec->rel2abs ($pidfile);
178 open $file, '>', $pidfile
179 or warning "Unable to open pidfile $pidfile for writing - $!";
186 # Set process to be session leader
188 or error "Can't start a new session ($!)", 1;
198 =head2 Execute ($command)
200 We all execute OS commands and then have to deal with the output and return
201 codes and the like. How about an easy Execute subroutine. It takes one
202 parameter, the command to execute, executes it and returns two parameters, the
203 output in a nice chomped array and the status.
207 =for html <blockquote>
217 =for html </blockquote>
221 =for html <blockquote>
225 =item A status scalar and an array of lines output from the command (if any).
227 Note, no redirection of STDERR is included. If you want STDERR included in
228 STDOUT then do so in the $command passed in.
232 =for html </blockquote>
236 local $SIG{CHLD} = 'DEFAULT';
243 return ($status, @output);
246 sub GetChildren (;$) {
251 =head2 GetChildren ($pid)
253 Returns an array of children pids for the passed in $pid.
255 NOTE: This assumes that the utility pstree exists and is in the callers PATH.
259 =for html <blockquote>
265 $pid to return the subtree of (Default: pid of init)
269 =for html </blockquote>
273 =for html <blockquote>
277 =item Array of children pids
281 =for html </blockquote>
289 my @output = `pstree -ap $pid`;
291 return @children if $? == 0;
296 # Skip the pstree process and the parent process - we want only
298 next if /pstree/ or /\($pid\)/;
308 sub GetPassword (;$) {
313 =head2 GetPassword (;$prompt)
315 Prompt for a password
319 =for html <blockquote>
325 Prompt string to use (Default: "Password:")
329 =for html </blockquote>
333 =for html <blockquote>
341 =for html </blockquote>
345 $prompt ||= 'Password';
353 $SIG{INT} = \&_restoreTerm;
360 while (not defined ($key = ReadKey -1)) { }
362 if ($key =~ /(\r|\n)/) {
369 if ($key eq chr(127)) {
370 unless ($password eq '') {
382 ReadMode 'restore'; # Reset tty mode before exiting.
384 $SIG{INT} = 'DEFAULT';
390 my ($item, @array) = @_;
394 =head2 InArray ($item, @array)
396 Find an item in an array.
400 =for html <blockquote>
414 =for html </blockquote>
418 =for html <blockquote>
422 =item $TRUE if found - $FALSE otherwise
426 =for html </blockquote>
431 return $TRUE if $item eq $_;
443 Return an array of the 1, 5, and 15 minute load averages.
447 =for html <blockquote>
455 =for html </blockquote>
459 =for html <blockquote>
463 =item An array of the 1, 5, and 15 minute load averages in a list context.
464 In a scalar context just the 1 minute load average.
468 =for html </blockquote>
472 # TODO: Make it work on Windows...
473 return if $^O =~ /win/i;
475 open my $loadAvg, '<', '/proc/loadavg'
476 or croak "Unable to open /proc/loadavg\n";
478 my $load = <$loadAvg>;
482 my @loadAvgs = split /\s/, $load;
487 return $loadAvgs[0]; # This is the 1 minute average
493 sub StartPipe ($;$) {
494 my ($to, $existingPipe) = @_;
498 =head2 StartPipe ($to, $existingPipe)
504 =for html <blockquote>
510 String representing the other end of the pipe
514 Already existing pipe handle (from a previous call to StartPipe)
518 =for html </blockquote>
522 =for html <blockquote>
526 =item A $pipe to used for PipeOutput
530 =for html </blockquote>
537 open $existingPipe, '|-', $to
538 or error "Unable to open pipe - $!", 1;
540 return $existingPipe;
542 open $pipe, '|-', $to
543 or error "Unable to open pipe - $!", 1;
549 sub PipeOutputArray ($@) {
550 my ($to, @output) = @_;
554 =head2 PipeOutputArray ($to, @ouput)
560 =for html <blockquote>
566 String representing the other end of the pipe to pipe @output to
574 =for html </blockquote>
578 =for html <blockquote>
586 =for html </blockquote>
590 open my $pipe, '|', $to
591 or error "Unable to open pipe - $!", 1;
602 sub PipeOutput ($;$) {
603 my ($line, $topipe) = @_;
607 =head2 PipeOutput ($line, $topipe)
609 Pipes a single line to $topipe
613 =for html <blockquote>
619 Line to output to $topipe.
623 A pipe returned by StartPipe (or our $pipe) to which the $line is piped.
627 =for html </blockquote>
631 =for html <blockquote>
639 =for html </blockquote>
645 chomp $line; chop $line if $line =~ /\r$/;
647 print $pipe "$line\n";
653 my ($pipeToStop) = @_;
657 =head2 StopPipe ($pipe)
663 =for html <blockquote>
673 =for html </blockquote>
677 =for html <blockquote>
685 =for html </blockquote>
689 $pipeToStop ||= $pipe;
691 close $pipeToStop if $pipeToStop;
701 =head2 PageOutput (@ouput)
703 Pages output to the screen
707 =for html <blockquote>
717 =for html </blockquote>
721 =for html <blockquote>
729 =for html </blockquote>
734 PipeOutputArray $ENV{PAGER}, @output;
743 sub RedirectOutput ($$@) {
744 my ($to, $mode, @output) = @_;
748 =head2 RedirectOutput ($to, @ouput)
750 Pages output to the screen
754 =for html <blockquote>
760 Where to send the output
768 =for html </blockquote>
772 =for html <blockquote>
780 =for html </blockquote>
784 croak 'Mode must be > or >>'
785 unless ($mode eq '>' or $mode eq '>>');
787 open my $out, $mode, $to
788 or croak "Unable to open $to for writing - $!";
803 =head2 ReadFile ($filename)
805 How many times have you coded a Perl subroutine, or just staight inline Perl to
806 open a file, read all the lines into an array and close the file. This routine
807 does that very thing along with the associated and proper checking of open
808 failure and even trims the lines in the output array of trailing newlines? This
809 routine returns an array of the lines in the filename passed in.
813 =for html <blockquote>
823 =for html </blockquote>
827 =for html <blockquote>
831 =item Array of lines in the file
835 =for html </blockquote>
839 open my $file, '<', $filename
840 or error "Unable to open $filename ($!)", 1;
848 or error "Unable to close $filename ($!)", 1;
855 push @cleansed_lines, $_ if !/^#/; # Discard comment lines
858 return @cleansed_lines;
867 my ($total, $log) = @_;
871 =head2 Stats ($total, $log)
873 Reports runtime stats
877 =for html <blockquote>
883 Reference to a hash of total counters. The keys of the hash will be the labels
884 and the values of the hash will be the counters.
888 Logger object to log stats to (if specified). Note: if the Logger object has
889 errors or warnings then they will be automatically included in the output.
893 =for html </blockquote>
897 =for html <blockquote>
905 =for html </blockquote>
909 my $msg = "$FindBin::Script Run Statistics:";
911 if ($log and ref $log eq 'Logger') {
912 $total->{errors} = $log->{errors};
913 $total->{warnings} = $log->{warnings};
917 # Display statistics (if any)
924 foreach (sort keys %$total) {
925 $msg = $total->{$_} . "\t $_";
928 $log->msg ($total->{$_} . "\t $_");
945 Reports usage using perldoc
949 =for html <blockquote>
955 Message to output before doing perldoc
959 =for html </blockquote>
963 =for html <blockquote>
967 =item Does not return
971 =for html </blockquote>
983 sub RequiredFields($$) {
987 =head2 RequiredFields($total, $log)
989 Check if a list of fields are contained in a hash
993 =for html <blockquote>
999 Array reference to a list of field names that are required
1003 Hash reference whose key values we are checking
1007 =for html </blockquote>
1011 =for html <blockquote>
1017 Returns either an empty string or a string naming the first missing required
1022 =for html </blockquote>
1026 my ($fields, $rec) = @_;
1028 for my $fieldname (@$fields) {
1032 if ($fieldname eq $_) {
1038 return "$fieldname is required" unless $found;
1050 =head1 CONFIGURATION AND ENVIRONMENT
1058 L<File::Spec|File::Spec>
1064 =head2 ClearSCM Perl Modules
1066 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
1068 =for html <p><a href="/php/scm_man.php?file=lib/Logger.pm">Logger</a></p>
1070 =for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSDep</a></p>
1072 =head1 INCOMPATABILITIES
1076 =head1 BUGS AND LIMITATIONS
1078 There are no known bugs in this module.
1080 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
1082 =head1 LICENSE AND COPYRIGHT
1084 This Perl Module is freely available; you can redistribute it and/or modify it
1085 under the terms of the GNU General Public License as published by the Free
1086 Software Foundation; either version 2 of the License, or (at your option) any
1089 This Perl Module is distributed in the hope that it will be useful, but WITHOUT
1090 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
1091 FOR A PARTICULAR PURPOSE. See the GNU General Public License
1092 (L<http://www.gnu.org/copyleft/gpl.html>) for more details.
1094 You should have received a copy of the GNU General Public License along with
1095 this Perl Module; if not, write to the Free Software Foundation, Inc., 59
1096 Temple Place - Suite 330, Boston, MA 02111-1307, USA. reserved.