lib/Utils.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: Utils.pm,v $
   4
   5 Utils - Simple and often used utilities
   6
   7 =head1 VERSION
   8
   9 =over
  10
  11 =item Author
  12
  13 Andrew DeFaria <Andrew@ClearSCM.com>
  14
  15 =item Revision
  16
  17 $Revision: 1.26 $
  18
  19 =item Created
  20
  21 Thu Jan  5 15:15:29 PST 2006
  22
  23 =item Modified
  24
  25 $Date: 2013/03/28 21:18:55 $
  26
  27 =back
  28
  29 =head1 SYNOPSIS
  30
  31 This module seeks to encapsulate useful utilities, things that are often done
  32 over and over again but who's classification is miscellaneous.
  33
  34   EnterDaemonMode
  35
  36   my @children = GetChildren ($pid);
  37
  38   my @lines = ReadFile ("/tmp/file");
  39
  40   print "Found foo!\n" if InArray ("foo", @bar);
  41
  42   my ($status, @output) = Execute ("ps -ef");
  43
  44 =head1 DESCRIPTION
  45
  46 A collection of utility type subroutines.
  47
  48 =head1 ROUTINES
  49
  50 The following routines are exported:
  51
  52 =cut
  53
  54 package Utils;
  55
  56 use strict;
  57 use warnings;
  58
  59 use FindBin;
  60
  61 use base 'Exporter';
  62
  63 use POSIX qw (setsid);
  64 use File::Spec;
  65 use Carp;
  66
  67 use OSDep;
  68 use Display;
  69
  70 our @EXPORT = qw (
  71   EnterDaemonMode
  72   Execute
  73   GetChildren
  74   InArray
  75   PageOutput
  76   PipeOutput
  77   PipeOutputArray
  78   ReadFile
  79   RedirectOutput
  80   StartPipe
  81   Stats
  82   StopPipe
  83   Usage
  84 );
  85
  86 sub EnterDaemonMode (;$$$) {
  87   my ($logfile, $errorlog, $pidfile) = @_;
  88
  89 =pod
  90
  91 =head2 EnterDaemonMode ($logfile, $errorlog)
  92
  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.
  96
  97 Parameters:
  98
  99 =for html <blockquote>
 100
 101 =over
 102
 103 =item $logfile
 104
 105 File name of where to redirect STDOUT for the daemon (Default: $NULL)
 106
 107 =item $errorlog
 108
 109 File name of where to redirect STDERR for the daemon (Default: $NULL)
 110
 111 =back
 112
 113 =for html </blockquote>
 114
 115 Returns:
 116
 117 =for html <blockquote>
 118
 119 =over
 120
 121 =item Doesn't return
 122
 123 =back
 124
 125 =for html </blockquote>
 126
 127 =cut
 128
 129   $logfile  ||= $NULL;
 130   $errorlog ||= $NULL;
 131
 132   my $file;
 133
 134   if ($pidfile) {
 135     $pidfile =  File::Spec->rel2abs ($pidfile);
 136
 137     open $file, '>', $pidfile
 138       or warning "Unable to open pidfile $pidfile for writing - $!";
 139   } # if
 140
 141   # Redirect STDIN to $NULL
 142   open STDIN, '<', $NULL
 143     or error "Can't read $NULL ($!)", 1;
 144
 145   # Redirect STDOUT to logfile
 146   open STDOUT, '>>', $logfile
 147     or error "Can't write to $logfile ($!)", 1;
 148
 149   # Redirect STDERR to errorlog
 150   open STDERR, '>>', $errorlog
 151     or error "Can't write to $errorlog ($!)", 1;
 152
 153   # Change the current directory to /
 154   my $ROOT = $ARCH eq "windows" ? "C:\\" : "/";
 155   chdir $ROOT
 156     or error "Can't chdir to $ROOT ($!), 1";
 157
 158   # Turn off umask
 159   umask 0;
 160
 161   # Now fork the daemon
 162   defined (my $pid = fork)
 163     or error "Can't create daemon ($!)", 1;
 164
 165   # Now the parent exits
 166   exit if $pid;
 167
 168   # Write pidfile if specified
 169   if ($pidfile) {
 170     print $file "$$\n";
 171
 172     close $file;
 173   } # if
 174
 175   # Set process to be session leader
 176   setsid ()
 177     or error "Can't start a new session ($!)", 1;
 178
 179   return;
 180 } # EnterDaemonMode
 181
 182 sub Execute ($) {
 183   my ($cmd) = @_;
 184
 185 =pod
 186
 187 =head2 Execute ($command)
 188
 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.
 193
 194 Parameters:
 195
 196 =for html <blockquote>
 197
 198 =over
 199
 200 =item $command
 201
 202 Command to execute
 203
 204 =back
 205
 206 =for html </blockquote>
 207
 208 Returns:
 209
 210 =for html <blockquote>
 211
 212 =over
 213
 214 =item A status scalar and an array of lines output from the command (if any).
 215
 216 Note, no redirection of STDERR is included. If you want STDERR included in
 217 STDOUT then do so in the $command passed in.
 218
 219 =back
 220
 221 =for html </blockquote>
 222
 223 =cut
 224
 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};
 228
 229   local $SIG{CHLD} = 'DEFAULT';
 230
 231   my @output = `$cmd`;
 232   my $status = $?;
 233
 234   local $SIG{CHLD} = $sigchld;
 235
 236   chomp @output;
 237
 238   return ($status, @output);
 239 } # Execute
 240
 241 sub GetChildren (;$) {
 242   my ($pid) = @_;
 243
 244 =pod
 245
 246 =head2 GetChildren ($pid)
 247
 248 Returns an array of children pids for the passed in $pid.
 249
 250 NOTE: This assumes that the utility pstree exists and is in the callers PATH.
 251
 252 Parameters:
 253
 254 =for html <blockquote>
 255
 256 =over
 257
 258 =item $pid
 259
 260 $pid to return the subtree of (Default: pid of init)
 261
 262 =back
 263
 264 =for html </blockquote>
 265
 266 Returns:
 267
 268 =for html <blockquote>
 269
 270 =over
 271
 272 =item Array of children pids
 273
 274 =back
 275
 276 =for html </blockquote>
 277
 278 =cut
 279
 280   my @children = ();
 281
 282   $pid = 1 if !$pid;
 283
 284   my @output = `pstree -ap $pid`;
 285
 286   return @children if $? == 0;
 287
 288   chomp @output;
 289
 290   foreach (@output) {
 291     # Skip the pstree process and the parent process - we want only
 292     # our children.
 293     next if /pstree/ or /\($pid\)/;
 294
 295     if (/\((\d+)\)/) {
 296       push @children, $1;
 297     } # if
 298   } # foreach
 299
 300   return @children;
 301 } # GetChildren
 302
 303 sub InArray ($@) {
 304   my ($item, @array) = @_;
 305
 306 =pod
 307
 308 =head2 InArray ($item, @array)
 309
 310 Find an item in an array.
 311
 312 Parameters:
 313
 314 =for html <blockquote>
 315
 316 =over
 317
 318 =item $item
 319
 320 Item to search for
 321
 322 =item @array
 323
 324 Array to search
 325
 326 =back
 327
 328 =for html </blockquote>
 329
 330 Returns:
 331
 332 =for html <blockquote>
 333
 334 =over
 335
 336 =item $TRUE if found - $FALSE otherwise
 337
 338 =back
 339
 340 =for html </blockquote>
 341
 342 =cut
 343
 344   foreach (@array) {
 345     return $TRUE if $item eq $_;
 346   } # foreach
 347
 348   return $FALSE;
 349 } # InArray
 350
 351 our $pipe;
 352
 353 sub StartPipe ($;$) {
 354   my ($to, $existingPipe) = @_;
 355
 356 =pod
 357
 358 =head2 StartPipe ($to, $existingPipe)
 359
 360 Starts a pipeline
 361
 362 Parameters:
 363
 364 =for html <blockquote>
 365
 366 =over
 367
 368 =item $to
 369
 370 String representing the other end of the pipe
 371
 372 =item $existingPipe
 373
 374 Already existing pipe handle (from a previous call to StartPipe)
 375
 376 =back
 377
 378 =for html </blockquote>
 379
 380 Returns:
 381
 382 =for html <blockquote>
 383
 384 =over
 385
 386 =item A $pipe to used for PipeOutput
 387
 388 =back
 389
 390 =for html </blockquote>
 391
 392 =cut
 393
 394   if ($existingPipe) {
 395     close $existingPipe;
 396
 397     open $existingPipe, '|-', $to
 398       or error "Unable to open pipe - $!", 1;
 399
 400     return $existingPipe;
 401   } else {
 402     open $pipe, '|-', $to
 403       or error "Unable to open pipe - $!", 1;
 404
 405     return $pipe;
 406   } # if
 407 } # StartPipe
 408
 409 sub PipeOutputArray ($@) {
 410   my ($to, @output) = @_;
 411
 412 =pod
 413
 414 =head2 PipeOutputArray ($to, @ouput)
 415
 416 Pipes output to $to
 417
 418 Parameters:
 419
 420 =for html <blockquote>
 421
 422 =over
 423
 424 =item $to
 425
 426 String representing the other end of the pipe to pipe @output to
 427
 428 =item @output
 429
 430 Output to pipe
 431
 432 =back
 433
 434 =for html </blockquote>
 435
 436 Returns:
 437
 438 =for html <blockquote>
 439
 440 =over
 441
 442 =item Nothing
 443
 444 =back
 445
 446 =for html </blockquote>
 447
 448 =cut
 449
 450   open my $pipe, "|$to"
 451     or error "Unable to open pipe - $!", 1;
 452
 453   foreach (@output) {
 454     chomp;
 455
 456     print $pipe "$_\n";
 457   } # foreach
 458
 459   return close $pipe;
 460 } # PipeOutputArray
 461
 462 sub PipeOutput ($;$) {
 463   my ($line, $topipe) = @_;
 464
 465 =pod
 466
 467 =head2 PipeOutput ($line, $topipe)
 468
 469 Pipes a single line to $topipe
 470
 471 Parameters:
 472
 473 =for html <blockquote>
 474
 475 =over
 476
 477 =item $line
 478
 479 Line to output to $topipe.
 480
 481 =item $topipe
 482
 483 A pipe returned by StartPipe (or our $pipe) to which the $line is piped.
 484
 485 =back
 486
 487 =for html </blockquote>
 488
 489 Returns:
 490
 491 =for html <blockquote>
 492
 493 =over
 494
 495 =item Nothing
 496
 497 =back
 498
 499 =for html </blockquote>
 500
 501 =cut
 502
 503   $topipe ||= $pipe;
 504
 505   chomp $line; chop $line if $line =~ /\r$/;
 506
 507   print $pipe "$line\n";
 508
 509   return;
 510 } # PipeOutput
 511
 512 sub StopPipe (;$) {
 513   my ($pipeToStop) = @_;
 514
 515 =pod
 516
 517 =head2 StopPipe ($pipe)
 518
 519 Stops a $pipe.
 520
 521 Parameters:
 522
 523 =for html <blockquote>
 524
 525 =over
 526
 527 =item $pipe
 528
 529 Pipe to stop
 530
 531 =back
 532
 533 =for html </blockquote>
 534
 535 Returns:
 536
 537 =for html <blockquote>
 538
 539 =over
 540
 541 =item Nothing
 542
 543 =back
 544
 545 =for html </blockquote>
 546
 547 =cut
 548
 549   $pipeToStop ||= $pipe;
 550
 551   close $pipeToStop if $pipeToStop;
 552 } # StopPipe
 553
 554 sub PageOutput (@) {
 555   my (@output) = @_;
 556
 557 =pod
 558
 559 =head2 PageOutput (@ouput)
 560
 561 Pages output to the screen
 562
 563 Parameters:
 564
 565 =for html <blockquote>
 566
 567 =over
 568
 569 =item @output
 570
 571 Output to page
 572
 573 =back
 574
 575 =for html </blockquote>
 576
 577 Returns:
 578
 579 =for html <blockquote>
 580
 581 =over
 582
 583 =item Nothing
 584
 585 =back
 586
 587 =for html </blockquote>
 588
 589 =cut
 590
 591   if ($ENV{PAGER}) {
 592     PipeOutputArray $ENV{PAGER}, @output;
 593   } else {
 594     print "$_\n"
 595       foreach (@output);
 596   } # if
 597
 598   return;
 599 } # PageOutput
 600
 601 sub RedirectOutput ($$@) {
 602   my ($to, $mode, @output) = @_;
 603
 604 =pod
 605
 606 =head2 RedirectOutput ($to, @ouput)
 607
 608 Pages output to the screen
 609
 610 Parameters:
 611
 612 =for html <blockquote>
 613
 614 =over
 615
 616 =item $to
 617
 618 Where to send the output
 619
 620 =item @output
 621
 622 Output to redirect
 623
 624 =back
 625
 626 =for html </blockquote>
 627
 628 Returns:
 629
 630 =for html <blockquote>
 631
 632 =over
 633
 634 =item Nothing
 635
 636 =back
 637
 638 =for html </blockquote>
 639
 640 =cut
 641
 642   croak 'Mode must be > or >>'
 643     unless ($mode eq '>' or $mode eq '>>');
 644
 645   open my $out, $mode, $to
 646     or croak "Unable to open $to for writing - $!";
 647
 648   foreach (@output) {
 649     chomp;
 650     print $out "$_\n";
 651   } # foreach
 652
 653   return;
 654 } # RedirectOutput
 655
 656 sub ReadFile ($) {
 657   my ($filename) = @_;
 658
 659 =pod
 660
 661 =head2 ReadFile ($filename)
 662
 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.
 668
 669 Parameters:
 670
 671 =for html <blockquote>
 672
 673 =over
 674
 675 =item $filename
 676
 677 Filename to read
 678
 679 =back
 680
 681 =for html </blockquote>
 682
 683 Returns:
 684
 685 =for html <blockquote>
 686
 687 =over
 688
 689 =item Array of lines in the file
 690
 691 =back
 692
 693 =for html </blockquote>
 694
 695 =cut
 696
 697   open my $file, '<', $filename
 698     or error "Unable to open $filename ($!)", 1;
 699
 700   if (wantarray) {
 701     local $/ = "\n";
 702
 703     my @lines = <$file>;
 704
 705     close $file
 706       or error "Unable to close $filename ($!)", 1;
 707
 708     my @cleansed_lines;
 709
 710     foreach (@lines) {
 711       chomp;
 712       chop if /\r/;
 713       push @cleansed_lines, $_ if !/^#/; # Discard comment lines
 714     } # foreach
 715
 716     return @cleansed_lines;
 717   } else {
 718     local $/;
 719
 720     return <$file>;
 721   } # if
 722 } # ReadFile
 723
 724 sub Stats ($;$) {
 725   my ($total, $log) = @_;
 726
 727 =pod
 728
 729 =head2 Stats ($total, $log)
 730
 731 Reports runtime stats
 732
 733 Parameters:
 734
 735 =for html <blockquote>
 736
 737 =over
 738
 739 =item $total
 740
 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.
 743
 744 =item $log
 745
 746 Logger object to log stats to (if specified)
 747
 748 =back
 749
 750 =for html </blockquote>
 751
 752 Returns:
 753
 754 =for html <blockquote>
 755
 756 =over
 757
 758 =item Nothing
 759
 760 =back
 761
 762 =for html </blockquote>
 763
 764 =cut
 765
 766   my $msg = "$FindBin::Script Run Statistics:";
 767
 768   if (scalar keys %$total) {
 769     # Display statistics (if any)
 770     if ($log) {
 771       $log->msg ($msg);
 772     } else {
 773       display $msg;
 774     } # if
 775
 776     foreach (sort keys %$total) {
 777       $msg = $$total{$_} . "\t $_";
 778
 779       if ($log) {
 780         $log->msg ($$total{$_} . "\t $_");
 781       } else {
 782         display $msg;
 783       } # if
 784     } # foreach
 785   } # if
 786
 787   return;
 788 } # Stats
 789
 790 sub Usage (;$) {
 791   my ($msg) = @_;
 792
 793 =pod
 794
 795 =head2 Usage ($msg)
 796
 797 Reports usage using perldoc
 798
 799 Parameters:
 800
 801 =for html <blockquote>
 802
 803 =over
 804
 805 =item $msg
 806
 807 Message to output before doing perldoc
 808
 809 =back
 810
 811 =for html </blockquote>
 812
 813 Returns:
 814
 815 =for html <blockquote>
 816
 817 =over
 818
 819 =item Does not return
 820
 821 =back
 822
 823 =for html </blockquote>
 824
 825 =cut
 826
 827   display $msg
 828     if $msg;
 829
 830   system "perldoc $0";
 831
 832   exit 1;
 833 } # Usage
 834
 835 END {
 836   StopPipe;
 837 } # END
 838
 839 1;
 840
 841 =head1 CONFIGURATION AND ENVIRONMENT
 842
 843 None
 844
 845 =head1 DEPENDENCIES
 846
 847 =head2 Perl Modules
 848
 849 L<File::Spec|File::Spec>
 850
 851 L<FindBin>
 852
 853 L<POSIX>
 854
 855 =head2 ClearSCM Perl Modules
 856
 857 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
 858
 859 =for html <p><a href="/php/scm_man.php?file=lib/Logger.pm">Logger</a></p>
 860
 861 =for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSDep</a></p>
 862
 863 =head1 INCOMPATABILITIES
 864
 865 None yet...
 866
 867 =head1 BUGS AND LIMITATIONS
 868
 869 There are no known bugs in this module.
 870
 871 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
 872
 873 =head1 LICENSE AND COPYRIGHT
 874
 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
 878 later version.
 879
 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.
 884
 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.
 888
 889 =cut