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