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);
89 # In case the user hits Ctrl-C
90 print "\nControl-C\n";
97 sub EnterDaemonMode (;$$$) {
98 my ($logfile, $errorlog, $pidfile) = @_;
102 =head2 EnterDaemonMode ($logfile, $errorlog)
104 There is a right way to enter "daemon mode" and this routine is for that. If you
105 call EnterDaemonMode your process will be disassociated from the terminal and
106 enter into a background mode just like a good daemon.
110 =for html <blockquote>
116 File name of where to redirect STDOUT for the daemon (Default: $NULL)
120 File name of where to redirect STDERR for the daemon (Default: $NULL)
124 =for html </blockquote>
128 =for html <blockquote>
136 =for html </blockquote>
145 # Redirect STDIN to $NULL
146 open STDIN, '<', $NULL
147 or error "Can't read $NULL ($!)", 1;
149 # Redirect STDOUT to logfile
150 open STDOUT, '>>', $logfile
151 or error "Can't write to $logfile ($!)", 1;
153 # Redirect STDERR to errorlog
154 open STDERR, '>>', $errorlog
155 or error "Can't write to $errorlog ($!)", 1;
157 # Change the current directory to /
158 my $ROOT = $ARCH eq "windows" ? "C:\\" : "/";
160 or error "Can't chdir to $ROOT ($!), 1";
165 # Now fork the daemon
166 defined (my $pid = fork)
167 or error "Can't create daemon ($!)", 1;
169 # Now the parent exits
172 # Write pidfile if specified
174 $pidfile = File::Spec->rel2abs ($pidfile);
176 open $file, '>', $pidfile
177 or warning "Unable to open pidfile $pidfile for writing - $!";
184 # Set process to be session leader
186 or error "Can't start a new session ($!)", 1;
196 =head2 Execute ($command)
198 We all execute OS commands and then have to deal with the output and return
199 codes and the like. How about an easy Execute subroutine. It takes one
200 parameter, the command to execute, executes it and returns two parameters, the
201 output in a nice chomped array and the status.
205 =for html <blockquote>
215 =for html </blockquote>
219 =for html <blockquote>
223 =item A status scalar and an array of lines output from the command (if any).
225 Note, no redirection of STDERR is included. If you want STDERR included in
226 STDOUT then do so in the $command passed in.
230 =for html </blockquote>
234 # Save $SIG{CHLD} so we can set it to 'DEFAULT' and then restore it later.
235 # Helps when you are doing process handling.
236 my $sigchld = $SIG{CHLD};
238 local $SIG{CHLD} = 'DEFAULT';
243 local $SIG{CHLD} = $sigchld;
247 return ($status, @output);
250 sub GetChildren (;$) {
255 =head2 GetChildren ($pid)
257 Returns an array of children pids for the passed in $pid.
259 NOTE: This assumes that the utility pstree exists and is in the callers PATH.
263 =for html <blockquote>
269 $pid to return the subtree of (Default: pid of init)
273 =for html </blockquote>
277 =for html <blockquote>
281 =item Array of children pids
285 =for html </blockquote>
293 my @output = `pstree -ap $pid`;
295 return @children if $? == 0;
300 # Skip the pstree process and the parent process - we want only
302 next if /pstree/ or /\($pid\)/;
312 sub GetPassword (;$) {
317 =head2 GetPassword (;$prompt)
319 Prompt for a password
323 =for html <blockquote>
329 Prompt string to use (Default: "Password:")
333 =for html </blockquote>
337 =for html <blockquote>
345 =for html </blockquote>
350 $prompt ||= 'Password';
358 $SIG{INT} = \&_restoreTerm;
365 while (not defined ($key = ReadKey -1)) { }
367 if ($key =~ /(\r|\n)/) {
378 ReadMode 'restore'; # Reset tty mode before exiting.
380 $SIG{INT} = 'DEFAULT';
386 my ($item, @array) = @_;
390 =head2 InArray ($item, @array)
392 Find an item in an array.
396 =for html <blockquote>
410 =for html </blockquote>
414 =for html <blockquote>
418 =item $TRUE if found - $FALSE otherwise
422 =for html </blockquote>
427 return $TRUE if $item eq $_;
435 sub StartPipe ($;$) {
436 my ($to, $existingPipe) = @_;
440 =head2 StartPipe ($to, $existingPipe)
446 =for html <blockquote>
452 String representing the other end of the pipe
456 Already existing pipe handle (from a previous call to StartPipe)
460 =for html </blockquote>
464 =for html <blockquote>
468 =item A $pipe to used for PipeOutput
472 =for html </blockquote>
479 open $existingPipe, '|-', $to
480 or error "Unable to open pipe - $!", 1;
482 return $existingPipe;
484 open $pipe, '|-', $to
485 or error "Unable to open pipe - $!", 1;
491 sub PipeOutputArray ($@) {
492 my ($to, @output) = @_;
496 =head2 PipeOutputArray ($to, @ouput)
502 =for html <blockquote>
508 String representing the other end of the pipe to pipe @output to
516 =for html </blockquote>
520 =for html <blockquote>
528 =for html </blockquote>
532 open my $pipe, '|', $to
533 or error "Unable to open pipe - $!", 1;
544 sub PipeOutput ($;$) {
545 my ($line, $topipe) = @_;
549 =head2 PipeOutput ($line, $topipe)
551 Pipes a single line to $topipe
555 =for html <blockquote>
561 Line to output to $topipe.
565 A pipe returned by StartPipe (or our $pipe) to which the $line is piped.
569 =for html </blockquote>
573 =for html <blockquote>
581 =for html </blockquote>
587 chomp $line; chop $line if $line =~ /\r$/;
589 print $pipe "$line\n";
595 my ($pipeToStop) = @_;
599 =head2 StopPipe ($pipe)
605 =for html <blockquote>
615 =for html </blockquote>
619 =for html <blockquote>
627 =for html </blockquote>
631 $pipeToStop ||= $pipe;
633 close $pipeToStop if $pipeToStop;
643 =head2 PageOutput (@ouput)
645 Pages output to the screen
649 =for html <blockquote>
659 =for html </blockquote>
663 =for html <blockquote>
671 =for html </blockquote>
676 PipeOutputArray $ENV{PAGER}, @output;
685 sub RedirectOutput ($$@) {
686 my ($to, $mode, @output) = @_;
690 =head2 RedirectOutput ($to, @ouput)
692 Pages output to the screen
696 =for html <blockquote>
702 Where to send the output
710 =for html </blockquote>
714 =for html <blockquote>
722 =for html </blockquote>
726 croak 'Mode must be > or >>'
727 unless ($mode eq '>' or $mode eq '>>');
729 open my $out, $mode, $to
730 or croak "Unable to open $to for writing - $!";
745 =head2 ReadFile ($filename)
747 How many times have you coded a Perl subroutine, or just staight inline Perl to
748 open a file, read all the lines into an array and close the file. This routine
749 does that very thing along with the associated and proper checking of open
750 failure and even trims the lines in the output array of trailing newlines? This
751 routine returns an array of the lines in the filename passed in.
755 =for html <blockquote>
765 =for html </blockquote>
769 =for html <blockquote>
773 =item Array of lines in the file
777 =for html </blockquote>
781 open my $file, '<', $filename
782 or error "Unable to open $filename ($!)", 1;
790 or error "Unable to close $filename ($!)", 1;
797 push @cleansed_lines, $_ if !/^#/; # Discard comment lines
800 return @cleansed_lines;
809 my ($total, $log) = @_;
813 =head2 Stats ($total, $log)
815 Reports runtime stats
819 =for html <blockquote>
825 Reference to a hash of total counters. The keys of the hash will be the labels
826 and the values of the hash will be the counters.
830 Logger object to log stats to (if specified). Note: if the Logger object has
831 errors or warnings then they will be automatically included in the output.
835 =for html </blockquote>
839 =for html <blockquote>
847 =for html </blockquote>
851 my $msg = "$FindBin::Script Run Statistics:";
853 if ($log and ref $log eq 'Logger') {
854 $total->{errors} = $log->{errors};
855 $total->{warnings} = $log->{warnings};
859 # Display statistics (if any)
866 foreach (sort keys %$total) {
867 $msg = $total->{$_} . "\t $_";
870 $log->msg ($total->{$_} . "\t $_");
887 Reports usage using perldoc
891 =for html <blockquote>
897 Message to output before doing perldoc
901 =for html </blockquote>
905 =for html <blockquote>
909 =item Does not return
913 =for html </blockquote>
931 =head1 CONFIGURATION AND ENVIRONMENT
939 L<File::Spec|File::Spec>
945 =head2 ClearSCM Perl Modules
947 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
949 =for html <p><a href="/php/scm_man.php?file=lib/Logger.pm">Logger</a></p>
951 =for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSDep</a></p>
953 =head1 INCOMPATABILITIES
957 =head1 BUGS AND LIMITATIONS
959 There are no known bugs in this module.
961 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
963 =head1 LICENSE AND COPYRIGHT
965 This Perl Module is freely available; you can redistribute it and/or modify it
966 under the terms of the GNU General Public License as published by the Free
967 Software Foundation; either version 2 of the License, or (at your option) any
970 This Perl Module is distributed in the hope that it will be useful, but WITHOUT
971 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
972 FOR A PARTICULAR PURPOSE. See the GNU General Public License
973 (L<http://www.gnu.org/copyleft/gpl.html>) for more details.
975 You should have received a copy of the GNU General Public License along with
976 this Perl Module; if not, write to the Free Software Foundation, Inc., 59
977 Temple Place - Suite 330, Boston, MA 02111-1307, USA. reserved.