lib/Logger.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: Logger.pm,v $
   4
   5 Object oriented interface to handling logfiles
   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.23 $
  18
  19 =item Created:
  20
  21 Fri Mar 12 10:17:44 PST 2004
  22
  23 =item Modified:
  24
  25 $Date: 2012/01/06 22:00:09 $
  26
  27 =back
  28
  29 =head1 SYNOPSIS
  30
  31 Perl module for consistent creation and writing to logfiles
  32
  33   $log = Logger->new (
  34     path        => "/tmp"
  35     timestamped => "yes",
  36     append      => "yes",
  37   );
  38
  39   $log->msg ("This message might appear on STDOUT");
  40   $log->log ("Stuff this message into the logfile");
  41
  42   if (!$log->logcmd ("ls /non-existant-dir")) {
  43     $log->err ("Unable to proceed", 1);
  44   } # if
  45
  46   $log->maillog (
  47     to          => "Andrew\@ClearSCM.com",
  48     subject     => "Logger test",
  49     heading     => "Results of Logging"
  50   );
  51
  52 =head1 DESCRIPTION
  53
  54 Logger creates a log object that provides easy methods to log messages, errors,
  55 commands, etc. to log files. Logfiles can be created as being transient in that
  56 they will automatically disappear (unless you call the err method). You can
  57 capture the output of commands into log files and even have them autoamatically
  58 timestamped. Finally you can have logfiles automatically mailed.
  59
  60 =head1 ROUTINES
  61
  62 The following routines are exported:
  63
  64 =cut
  65
  66 package Logger;
  67
  68 use strict;
  69 use warnings;
  70
  71 use base 'Exporter';
  72
  73 use FindBin;
  74 use File::Spec;
  75 use IO::Handle;
  76 use Cwd;
  77
  78 use Display;
  79 use OSDep;
  80 use DateUtils;
  81 use Mail;
  82 use Utils;
  83
  84 my ($error_color, $warning_color, $command_color, $highlight_color, $normal) = "";
  85
  86 my $me;
  87
  88 BEGIN {
  89   # Extract relative path and basename from script name.
  90   $me = $FindBin::Script;
  91
  92   # Remove .pl for Perl scripts that have that extension
  93   $me =~ s/\.pl$//;
  94 } # BEGIN
  95
  96 sub new (;%){
  97   my ($class, %parms) = @_;
  98
  99 =pod
 100
 101 =head2 new (<parms>)
 102
 103 Construct a new Logger object. The following OO style arguments are
 104 supported:
 105
 106 Parameters:
 107
 108 =for html <blockquote>
 109
 110 =over
 111
 112 =item name:
 113
 114 Name of the leaf portion of the log file. Default is the name of the
 115 script with ".log" appended to the logfile name. So if the calling
 116 script was called "getdb" the default log file would be called
 117 "getdb.log" (Default: Script name).
 118
 119 =item path:
 120
 121 Path to create the logfile in (Default: Current working directory)
 122
 123 =item disposition:
 124
 125 One of "temp" or "perm". Logfiles that are of disposition temp will be
 126 deleted when the process ends unless any calls have been made to the
 127 err method (Default: perm)
 128
 129 =item timestamped:
 130
 131 If set to 0 then no timestamps will be used. If set to 1 then all
 132 lines logged will be preceeded with a timestamp (Default: 0)
 133
 134 =item append:
 135
 136 If defined the logfile will be appended to (Default: Overwrite)
 137
 138 =item extension
 139
 140 If defined an alternate extension to use for the log file (e.g. log.html)
 141
 142 =back
 143
 144 =for html </blockquote>
 145
 146 Returns:
 147
 148 =for html <blockquote>
 149
 150 =over
 151
 152 =item Logger object
 153
 154 =back
 155
 156 =for html </blockquote>
 157
 158 =cut
 159
 160   my $cwd = cwd;
 161
 162   my $name        = $parms{name}        ? $parms{name}        : $me;
 163   my $path        = $parms{path}        ? $parms{path}        : $cwd;
 164   my $disposition = $parms{disposition} ? $parms{disposition} : 'perm';
 165   my $timestamped = $parms{timestamped} ? $parms{timestamped} : 'FALSE';
 166   my $append      = $parms{append}      ? '>>'                : '>';
 167   my $logfile;
 168
 169   if (defined $parms{extension}) {
 170     $name .= ".$parms{extension}" unless $parms{extension} eq '';
 171   } # if
 172
 173   open $logfile, $append, "$path/$name"
 174     or error "Unable to open logfile $path/$name - $!", 1;
 175
 176   # Set unbuffered output
 177   $logfile->autoflush ();
 178
 179   set_verbose if $ENV{VERBOSE};
 180   set_debug   if $ENV{DEBUG};
 181
 182   return bless {
 183     path        => $path,
 184     name        => $name,
 185     handle      => $logfile,
 186     timestamped => $parms {timestamped},
 187     disposition => $disposition,
 188     errors      => 0,
 189     warnings    => 0,
 190   }, $class; # bless
 191 } # new
 192
 193 sub append ($) {
 194   my ($self, $filename) = @_;
 195
 196 =pod
 197
 198 =head3 append ($filename)
 199
 200 Appends $filename to the end of the current logfile
 201
 202 Parameters:
 203
 204 =for html <blockquote>
 205
 206 =over
 207
 208 =item $filename
 209
 210 Filename to append to the logfile
 211
 212 =back
 213
 214 =for html </blockquote>
 215
 216 Returns:
 217
 218 =for html <blockquote>
 219
 220 =over
 221
 222 =item Nothing
 223
 224 =back
 225
 226 =for html </blockquote>
 227
 228 =cut
 229
 230   open my $file, '<', $filename
 231     or return 1;
 232
 233   while (<$file>) {
 234     $self->log ($_);
 235   } # while
 236
 237   close $file;
 238
 239   return;
 240 } # append
 241
 242 sub name () {
 243   my ($self) = @_;
 244
 245 =pod
 246
 247 =head3 name
 248
 249 Returns the leaf portion of logfile name.
 250
 251 Parameters:
 252
 253 =for html <blockquote>
 254
 255 =over
 256
 257 =item None
 258
 259 =back
 260
 261 =for html </blockquote>
 262
 263 Returns:
 264
 265 =for html <blockquote>
 266
 267 =over
 268
 269 =item Leaf node of log file name
 270
 271 =back
 272
 273 =for html </blockquote>
 274
 275 =cut
 276
 277   return $self->{name};
 278 } # name
 279
 280 sub fullname () {
 281   my ($self) = @_;
 282
 283 =pod
 284
 285 =head3 fullname
 286
 287 Returns the full pathname to the logfile
 288
 289 Parameters:
 290
 291 =for html <blockquote>
 292
 293 =over
 294
 295 =item None
 296
 297 =back
 298
 299 =for html </blockquote>
 300
 301 Returns:
 302
 303 =for html <blockquote>
 304
 305 =over
 306
 307 =item Full pathname to the logfile
 308
 309 =back
 310
 311 =for html </blockquote>
 312
 313 =cut
 314
 315   return "$self->{path}/$self->{name}";
 316 } # fullname
 317
 318 sub msg ($;$) {
 319   my ($self, $msg, $nolinefeed) = @_;
 320
 321 =pod
 322
 323 =head3 msg ($msg, $nolinefeed)
 324
 325 Similar to log except verbose (See Display.pm) is used to possibly
 326 additionally write the $msg to STDOUT.
 327
 328 Parameters:
 329
 330 =for html <blockquote>
 331
 332 =over
 333
 334 =item $msg:
 335
 336 Message to display
 337
 338 =item $nolinefeed:
 339
 340 If defined no linefeed is displayed at the end of the message.
 341
 342 =back
 343
 344 =for html </blockquote>
 345
 346 Returns:
 347
 348 =for html <blockquote>
 349
 350 =over
 351
 352 =item Nothing
 353
 354 =back
 355
 356 =for html </blockquote>
 357
 358 =cut
 359
 360   $self->log ($msg, $nolinefeed);
 361
 362   verbose $msg, undef, $nolinefeed;
 363
 364   return;
 365 } # msg
 366
 367 sub disp ($;$) {
 368   my ($self, $msg, $nolinefeed) = @_;
 369
 370 =pod
 371
 372 =head3 disp ($msg, $nolinefeed)
 373
 374 Similar to log except display (See Display.pm) is used to write the $msg to
 375 STDOUT and to the log file.
 376
 377 Parameters:
 378
 379 =for html <blockquote>
 380
 381 =over
 382
 383 =item $msg:
 384
 385 Message to display
 386
 387 =item $nolinefeed:
 388
 389 If defined no linefeed is displayed at the end of the message.
 390
 391 =back
 392
 393 =for html </blockquote>
 394
 395 Returns:
 396
 397 =for html <blockquote>
 398
 399 =over
 400
 401 =item Nothing
 402
 403 =back
 404
 405 =for html </blockquote>
 406
 407 =cut
 408
 409   $self->log ($msg, $nolinefeed);
 410
 411   display $msg, undef, $nolinefeed;
 412
 413   return;
 414 } # disp
 415
 416 sub incrementErr (;$) {
 417   my ($self, $increment) = @_;
 418
 419 =pod
 420
 421 =head3 incrementErr ($msg, $errno)
 422
 423 Increments the error count by $increment
 424
 425 Parameters:
 426
 427 =for html <blockquote>
 428
 429 =over
 430
 431 =item $increment
 432
 433 Amount to increment (Default: 1)
 434
 435 =back
 436
 437 =for html </blockquote>
 438
 439 Returns:
 440
 441 =for html <blockquote>
 442
 443 =over
 444
 445 =item Nothing
 446
 447 =back
 448
 449 =for html </blockquote>
 450
 451 =cut
 452
 453   $increment ||= 1;
 454
 455   $self->{errors} += $increment;
 456
 457   return;
 458 } # incrementErr
 459
 460 sub err ($;$) {
 461   my ($self, $msg, $errno) = @_;
 462
 463 =pod
 464
 465 =head3 err ($msg, $errno)
 466
 467 Writes an error message to the log file. Error messages are prepended
 468 with "ERROR" and optionally "#$errno" (if $errno is specified),
 469 followed by the message. If $errno was specified then the string " -
 470 terminating" is appended to the message. Otherwise the number of
 471 errors in the log are incremented and used to determine the logfile's
 472 disposition at close time.
 473
 474 Parameters:
 475
 476 =for html <blockquote>
 477
 478 =over
 479
 480 =item $msg:
 481
 482 Message to display
 483
 484 =item $errno:
 485
 486 Error number to display (also causes termination).
 487
 488 =back
 489
 490 =for html </blockquote>
 491
 492 Returns:
 493
 494 =for html <blockquote>
 495
 496 =over
 497
 498 =item Nothing
 499
 500 =back
 501
 502 =for html </blockquote>
 503
 504 =cut
 505
 506   display_error ($msg, $errno);
 507
 508   if ($errno) {
 509     $msg = "ERROR #$errno: $msg - terminating";
 510   } else {
 511     $msg = "ERROR: $msg";
 512   } # if
 513
 514   $self->log ($msg);
 515
 516   $self->incrementErr;
 517
 518   exit $errno if $errno;
 519
 520   return;
 521 } # err
 522
 523 sub maillog (%) {
 524   my ($self, %parms) = @_;
 525
 526 =pod
 527
 528 =head3 maillog (<parms>)
 529
 530 Mails the current logfile. "Parms" are the same as the parameters
 531 described for Mail.pm.
 532
 533 Parameters:
 534
 535 =for html <blockquote>
 536
 537 =over
 538
 539 =item <See Mail.pm>
 540
 541 Supports all parameters that Mail::mail supports.
 542
 543 =back
 544
 545 =for html </blockquote>
 546
 547 Returns:
 548
 549 =for html <blockquote>
 550
 551 =over
 552
 553 =item None
 554
 555 =back
 556
 557 =for html </blockquote>
 558
 559 =cut
 560
 561   my $from    = $parms{from};
 562   my $to      = $parms{to};
 563   my $cc      = $parms{cc};
 564   my $subject = $parms{subject};
 565   my $heading = $parms{heading};
 566   my $footing = $parms{footing};
 567   my $mode    = $parms{mode};
 568
 569   $mode = "plain"
 570     unless $mode;
 571
 572   my $log_filename = "$self->{path}/$self->{name}";
 573
 574   open my $logfile, '<', $log_filename
 575     or error "Unable to open logfile $log_filename", 1;
 576
 577   if ($mode eq 'html') {
 578     $heading .= '<b>Logfile:</b> '
 579               . "$self->{path}/$self->{name}"
 580               .'<hr><pre>';
 581     $footing  = '</pre><hr>'
 582               . $footing;
 583   } # if
 584
 585   mail (
 586     from    => $from,
 587     to      => $to,
 588     cc      => $cc,
 589     subject => $subject,
 590     mode    => $mode,
 591     heading => $heading,
 592     footing => $footing,
 593     data    => $logfile
 594   );
 595
 596   close $logfile
 597     or error "Unable to close logfile $log_filename", 1;
 598
 599   return;
 600 } # maillog
 601
 602 sub log {
 603   my ($self, $msg, $nolinefeed) = @_;
 604
 605 =pod
 606
 607 =head3 log ($msg, $nolinefeed)
 608
 609 Writes $msg to the log file. Note this is a "silent" log in that $msg
 610 is simply written to the logfile and not possibly also echoed to
 611 STDOUT (See the msg method).
 612
 613 Parameters:
 614
 615 =for html <blockquote>
 616
 617 =over
 618
 619 =item $msg:
 620
 621 Message to write to log file
 622
 623 =item $nolinefeed:
 624
 625 If defined no linefeed is displayed at the end of the message.
 626
 627 =back
 628
 629 =for html </blockquote>
 630
 631 Returns:
 632
 633 =for html <blockquote>
 634
 635 =over
 636
 637 =item Nothing
 638
 639 =back
 640
 641 =for html </blockquote>
 642
 643 =cut
 644
 645   $msg = "$me: " . YMDHM . ": $msg" if $self->{timestamped};
 646
 647   display $msg, $self->{handle}, $nolinefeed;
 648
 649   return;
 650 } # log
 651
 652 sub logcmd ($) {
 653   my ($self, $cmd) = @_;
 654
 655 =pod
 656
 657 =head3 logcmd ($cmd)
 658
 659 Execute the command in $cmd storing all output into the logfile
 660
 661 =for html <blockquote>
 662
 663 =over
 664
 665 =item $cmd:
 666
 667 The command $cmd is executed with the results logged to the logfile.
 668
 669 =back
 670
 671 =for html </blockquote>
 672
 673 Returns:
 674
 675 =for html <blockquote>
 676
 677 =over
 678
 679 =item Scalar representing the exit status of $cmd and an array of the commands output.
 680
 681 =back
 682
 683 =for html </blockquote>
 684
 685 =cut
 686
 687   display "\$ $cmd", $self->{handle} if get_debug;
 688
 689   my $status = open my $output, '-|', "$cmd 2>&1";
 690
 691   if (!$status) {
 692     $self->{error}++;
 693     return 1;
 694   } # if
 695
 696   my @output;
 697
 698   while (<$output>) {
 699     chomp;
 700     push @output, $_;
 701     display $_, $self->{handle};
 702     display $_ if get_debug;
 703   } # while
 704
 705   close $output
 706     or error "Unable to close output ($!)", 1;
 707
 708   return ($?, @output);
 709 } # logcmd
 710
 711 sub loglines () {
 712   my ($self) = @_;
 713
 714 =pod
 715
 716 =head3 loglines
 717
 718 Returns an array of lines from the current logfile.
 719
 720 Parameters:
 721
 722 =for html <blockquote>
 723
 724 =over
 725
 726 =item None
 727
 728 =back
 729
 730 =for html </blockquote>
 731
 732 Returns:
 733
 734 =for html <blockquote>
 735
 736 =over
 737
 738 =item Array of lines from the logfile
 739
 740 =back
 741
 742 =for html </blockquote>
 743
 744 =cut
 745
 746   return ReadFile "$self->{path}/$self->{name}";
 747 } # loglines
 748
 749 sub warn ($;$) {
 750   my ($self, $msg, $warnno) = @_;
 751
 752 =pod
 753
 754 =head3 warn ($msg, $warnno)
 755
 756 Similar to error but logs the message as a warning. Increments the
 757 warnings count in the object thus also affecting its disposition at
 758 close time. Does not terminate the process if $warnno is specified.
 759
 760 Parameters:
 761
 762 =for html <blockquote>
 763
 764 =over
 765
 766 =item $msg:
 767
 768 Message to write to the logfile
 769
 770 =item $warnno:
 771
 772 Warning number to put in the warn message (if specified)
 773
 774 =back
 775
 776 =for html </blockquote>
 777
 778 Returns:
 779
 780 =for html <blockquote>
 781
 782 =over
 783
 784 =item Nothing
 785
 786 =back
 787
 788 =for html </blockquote>
 789
 790 =cut
 791
 792   warning $msg, $warnno;
 793
 794   if ($warnno) {
 795     $msg = "WARNING #$warnno: $msg";
 796   } else {
 797     $msg = "WARNING: $msg";
 798   } # if
 799
 800   $self->log ($msg);
 801   $self->{warnings}++;
 802
 803   return;
 804 } # warn
 805
 806 sub errors () {
 807   my ($self) = @_;
 808
 809 =pod
 810
 811 =head3 errors ()
 812
 813 Returns the number of errors encountered
 814
 815 Parameters:
 816
 817 =for html <blockquote>
 818
 819 =over
 820
 821 =item None
 822
 823 =back
 824
 825 =for html </blockquote>
 826
 827 Returns:
 828
 829 =for html <blockquote>
 830
 831 =over
 832
 833 =item $errors
 834
 835 =back
 836
 837 =for html </blockquote>
 838
 839 =cut
 840
 841   return $self->{errors};
 842 } # errors
 843
 844 sub warnings () {
 845   my ($self) = @_;
 846
 847 =pod
 848
 849 =head3 warnings ()
 850
 851 Returns the number of warnings encountered
 852
 853 Parameters:
 854
 855 =for html <blockquote>
 856
 857 =over
 858
 859 =item None
 860
 861 =back
 862
 863 =for html </blockquote>
 864
 865 Returns:
 866
 867 =for html <blockquote>
 868
 869 =over
 870
 871 =item $warnings
 872
 873 =back
 874
 875 =for html </blockquote>
 876
 877 =cut
 878
 879   return $self->{warnings};
 880 } # warnings
 881
 882 sub DESTROY () {
 883   my ($self) = @_;
 884
 885   close ($self->{handle});
 886
 887   if ($self->{disposition} eq 'temp') {
 888     if ($self->{errors}   == 0 and
 889       $self->{warnings} == 0) {
 890       unlink $self->fullname;
 891     } # if
 892   } # if
 893
 894   return;
 895 } # destroy
 896
 897 1;
 898
 899 =pod
 900
 901 =head2 CONFIGURATION AND ENVIRONMENT
 902
 903 DEBUG: If set then $debug in this module is set.
 904
 905 VERBOSE: If set then $verbose in this module is set.
 906
 907 =head2 DEPENDENCIES
 908
 909 =head3 Perl Modules
 910
 911 L<File::Spec>
 912
 913 L<IO::Handle>
 914
 915 =head3 ClearSCM Perl Modules
 916
 917 =for html <p><a href="/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a></p>
 918
 919 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
 920
 921 =for html <p><a href="/php/scm_man.php?file=lib/Mail.pm">Mail</a></p>
 922
 923 =for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSDep</a></p>
 924
 925 =for html <p><a href="/php/scm_man.php?file=lib/Utils.pm">Utils</a></p>
 926
 927 =head2 INCOMPATABILITIES
 928
 929 None yet...
 930
 931 =head2 BUGS AND LIMITATIONS
 932
 933 There are no known bugs in this module.
 934
 935 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
 936
 937 =head2 LICENSE AND COPYRIGHT
 938
 939 This Perl Module is freely available; you can redistribute it and/or
 940 modify it under the terms of the GNU General Public License as
 941 published by the Free Software Foundation; either version 2 of the
 942 License, or (at your option) any later version.
 943
 944 This Perl Module is distributed in the hope that it will be useful,
 945 but WITHOUT ANY WARRANTY; without even the implied warranty of
 946 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 947 General Public License (L<http://www.gnu.org/copyleft/gpl.html>) for more
 948 details.
 949
 950 You should have received a copy of the GNU General Public License
 951 along with this Perl Module; if not, write to the Free Software Foundation,
 952 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 953 reserved.
 954
 955 =cut