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   } 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->log ($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"
 572     unless $mode;
 573
 574   my $log_filename = "$self->{path}/$self->{name}";
 575
 576   open my $logfile, '<', $log_filename
 577     or error "Unable to open logfile $log_filename", 1;
 578
 579   if ($mode eq 'html') {
 580     $heading .= '<b>Logfile:</b> '
 581               . "$self->{path}/$self->{name}"
 582               .'<hr><pre>';
 583     $footing  = '</pre><hr>'
 584               . $footing;
 585   } # if
 586
 587   mail (
 588     from    => $from,
 589     to      => $to,
 590     cc      => $cc,
 591     subject => $subject,
 592     mode    => $mode,
 593     heading => $heading,
 594     footing => $footing,
 595     data    => $logfile
 596   );
 597
 598   close $logfile
 599     or error "Unable to close logfile $log_filename", 1;
 600
 601   return;
 602 } # maillog
 603
 604 sub log {
 605   my ($self, $msg, $nolinefeed) = @_;
 606
 607 =pod
 608
 609 =head3 log ($msg, $nolinefeed)
 610
 611 Writes $msg to the log file. Note this is a "silent" log in that $msg
 612 is simply written to the logfile and not possibly also echoed to
 613 STDOUT (See the msg method).
 614
 615 Parameters:
 616
 617 =for html <blockquote>
 618
 619 =over
 620
 621 =item $msg:
 622
 623 Message to write to log file
 624
 625 =item $nolinefeed:
 626
 627 If defined no linefeed is displayed at the end of the message.
 628
 629 =back
 630
 631 =for html </blockquote>
 632
 633 Returns:
 634
 635 =for html <blockquote>
 636
 637 =over
 638
 639 =item Nothing
 640
 641 =back
 642
 643 =for html </blockquote>
 644
 645 =cut
 646
 647   $msg = "$me: " . YMDHM . ": $msg" if $self->{timestamped};
 648
 649   display $msg, $self->{handle}, $nolinefeed;
 650
 651   return;
 652 } # log
 653
 654 sub logcmd ($) {
 655   my ($self, $cmd) = @_;
 656
 657 =pod
 658
 659 =head3 logcmd ($cmd)
 660
 661 Execute the command in $cmd storing all output into the logfile
 662
 663 =for html <blockquote>
 664
 665 =over
 666
 667 =item $cmd:
 668
 669 The command $cmd is executed with the results logged to the logfile.
 670
 671 =back
 672
 673 =for html </blockquote>
 674
 675 Returns:
 676
 677 =for html <blockquote>
 678
 679 =over
 680
 681 =item Scalar representing the exit status of $cmd and an array of the commands output.
 682
 683 =back
 684
 685 =for html </blockquote>
 686
 687 =cut
 688
 689   display "\$ $cmd", $self->{handle} if get_debug;
 690
 691   my $status = open my $output, '-|', "$cmd 2>&1";
 692
 693   if (!$status) {
 694     $self->{error}++;
 695     return 1;
 696   } # if
 697
 698   my @output;
 699
 700   while (<$output>) {
 701     chomp;
 702     push @output, $_;
 703     display $_, $self->{handle};
 704     display $_ if get_debug;
 705   } # while
 706
 707   close $output
 708     or error "Unable to close output ($!)", 1;
 709
 710   return ($?, @output);
 711 } # logcmd
 712
 713 sub loglines () {
 714   my ($self) = @_;
 715
 716 =pod
 717
 718 =head3 loglines
 719
 720 Returns an array of lines from the current logfile.
 721
 722 Parameters:
 723
 724 =for html <blockquote>
 725
 726 =over
 727
 728 =item None
 729
 730 =back
 731
 732 =for html </blockquote>
 733
 734 Returns:
 735
 736 =for html <blockquote>
 737
 738 =over
 739
 740 =item Array of lines from the logfile
 741
 742 =back
 743
 744 =for html </blockquote>
 745
 746 =cut
 747
 748   return ReadFile "$self->{path}/$self->{name}";
 749 } # loglines
 750
 751 sub warn ($;$) {
 752   my ($self, $msg, $warnno) = @_;
 753
 754 =pod
 755
 756 =head3 warn ($msg, $warnno)
 757
 758 Similar to error but logs the message as a warning. Increments the
 759 warnings count in the object thus also affecting its disposition at
 760 close time. Does not terminate the process if $warnno is specified.
 761
 762 Parameters:
 763
 764 =for html <blockquote>
 765
 766 =over
 767
 768 =item $msg:
 769
 770 Message to write to the logfile
 771
 772 =item $warnno:
 773
 774 Warning number to put in the warn message (if specified)
 775
 776 =back
 777
 778 =for html </blockquote>
 779
 780 Returns:
 781
 782 =for html <blockquote>
 783
 784 =over
 785
 786 =item Nothing
 787
 788 =back
 789
 790 =for html </blockquote>
 791
 792 =cut
 793
 794   warning $msg, $warnno;
 795
 796   if ($warnno) {
 797     $msg = "WARNING #$warnno: $msg";
 798   } else {
 799     $msg = "WARNING: $msg";
 800   } # if
 801
 802   $self->log ($msg);
 803   $self->{warnings}++;
 804
 805   return;
 806 } # warn
 807
 808 sub errors () {
 809   my ($self) = @_;
 810
 811 =pod
 812
 813 =head3 errors ()
 814
 815 Returns the number of errors encountered
 816
 817 Parameters:
 818
 819 =for html <blockquote>
 820
 821 =over
 822
 823 =item None
 824
 825 =back
 826
 827 =for html </blockquote>
 828
 829 Returns:
 830
 831 =for html <blockquote>
 832
 833 =over
 834
 835 =item $errors
 836
 837 =back
 838
 839 =for html </blockquote>
 840
 841 =cut
 842
 843   return $self->{errors};
 844 } # errors
 845
 846 sub warnings () {
 847   my ($self) = @_;
 848
 849 =pod
 850
 851 =head3 warnings ()
 852
 853 Returns the number of warnings encountered
 854
 855 Parameters:
 856
 857 =for html <blockquote>
 858
 859 =over
 860
 861 =item None
 862
 863 =back
 864
 865 =for html </blockquote>
 866
 867 Returns:
 868
 869 =for html <blockquote>
 870
 871 =over
 872
 873 =item $warnings
 874
 875 =back
 876
 877 =for html </blockquote>
 878
 879 =cut
 880
 881   return $self->{warnings};
 882 } # warnings
 883
 884 sub DESTROY () {
 885   my ($self) = @_;
 886
 887   close ($self->{handle});
 888
 889   if ($self->{disposition} eq 'temp') {
 890     if ($self->{errors}   == 0 and
 891       $self->{warnings} == 0) {
 892       unlink $self->fullname;
 893     } # if
 894   } # if
 895
 896   return;
 897 } # destroy
 898
 899 1;
 900
 901 =pod
 902
 903 =head2 CONFIGURATION AND ENVIRONMENT
 904
 905 DEBUG: If set then $debug in this module is set.
 906
 907 VERBOSE: If set then $verbose in this module is set.
 908
 909 =head2 DEPENDENCIES
 910
 911 =head3 Perl Modules
 912
 913 L<File::Spec>
 914
 915 L<IO::Handle>
 916
 917 =head3 ClearSCM Perl Modules
 918
 919 =for html <p><a href="/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a></p>
 920
 921 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
 922
 923 =for html <p><a href="/php/scm_man.php?file=lib/Mail.pm">Mail</a></p>
 924
 925 =for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSDep</a></p>
 926
 927 =for html <p><a href="/php/scm_man.php?file=lib/Utils.pm">Utils</a></p>
 928
 929 =head2 INCOMPATABILITIES
 930
 931 None yet...
 932
 933 =head2 BUGS AND LIMITATIONS
 934
 935 There are no known bugs in this module.
 936
 937 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
 938
 939 =head2 LICENSE AND COPYRIGHT
 940
 941 This Perl Module is freely available; you can redistribute it and/or
 942 modify it under the terms of the GNU General Public License as
 943 published by the Free Software Foundation; either version 2 of the
 944 License, or (at your option) any later version.
 945
 946 This Perl Module is distributed in the hope that it will be useful,
 947 but WITHOUT ANY WARRANTY; without even the implied warranty of
 948 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 949 General Public License (L<http://www.gnu.org/copyleft/gpl.html>) for more
 950 details.
 951
 952 You should have received a copy of the GNU General Public License
 953 along with this Perl Module; if not, write to the Free Software Foundation,
 954 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 955 reserved.
 956
 957 =cut