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