modules/OutputMessage.pm

   1 package OutputMessage;
   2
   3 # ************************************************************
   4 # Description   : Prints information, warnings and errors.
   5 # Author        : Chad Elliott
   6 # Create Date   : 2/02/2004
   7 # ************************************************************
   8
   9 # ************************************************************
  10 # Pragmas
  11 # ************************************************************
  12
  13 use strict;
  14
  15 # ************************************************************
  16 # Data Section
  17 # ************************************************************
  18
  19 my $debugtag = 'DEBUG: ';
  20 my $infotag  = 'INFORMATION: ';
  21 my $warntag  = 'WARNING: ';
  22 my $errortag = 'ERROR: ';
  23
  24 my $debug       = 0;
  25 my $information = 0;
  26 my $warnings    = 1;
  27 my $diagnostic  = 1;
  28 my $details     = 1;
  29
  30 # ************************************************************
  31 # Subroutine Section
  32 # ************************************************************
  33
  34 sub new {
  35   my $class = shift;
  36   return bless {}, $class;
  37 }
  38
  39
  40 sub set_levels {
  41   my $str = shift;
  42
  43   if (defined $str) {
  44     $debug       = ($str =~ /debug\s*=\s*(\d+)/i ? $1 : 0);
  45     $details     = ($str =~ /detail(s)?\s*=\s*(\d+)/i ? $2 : 0);
  46     $diagnostic  = ($str =~ /diag(nostic)?\s*=\s*(\d+)/i ? $2 : 0);
  47     $information = ($str =~ /info(rmation)?\s*=\s*(\d+)/i ? $2 : 0);
  48     $warnings    = ($str =~ /warn(ing)?\s*=\s*(\d+)/i ? $2 : 0);
  49   }
  50 }
  51
  52 sub split_message {
  53   my($self, $msg, $spc) = @_;
  54   $msg =~ s/\.\s+/.\n$spc/g;
  55   return $msg . "\n";
  56 }
  57
  58
  59 sub details {
  60   if ($details) {
  61     #my($self, $msg) = @_;
  62     print "$_[1]\n";
  63   }
  64 }
  65
  66
  67 sub diagnostic {
  68   if ($diagnostic) {
  69     #my($self, $msg) = @_;
  70     print "$_[1]\n";
  71   }
  72 }
  73
  74
  75 sub debug {
  76   if ($debug) {
  77     #my($self, $msg) = @_;
  78     print "$debugtag$_[1]\n";
  79   }
  80 }
  81
  82
  83 sub information {
  84   if ($information) {
  85     #my($self, $msg) = @_;
  86     print $infotag, $_[0]->split_message($_[1], ' ' x length($infotag));
  87   }
  88 }
  89
  90
  91 sub warning {
  92   if ($warnings) {
  93     #my($self, $msg) = @_;
  94     print $warntag, $_[0]->split_message($_[1], ' ' x length($warntag));
  95   }
  96 }
  97
  98
  99 sub error {
 100   my($self, $msg, $pre) = @_;
 101   print STDERR '', (defined $pre ? "$pre\n" : ''), $errortag,
 102                $self->split_message($msg, ' ' x length($errortag));
 103 }
 104
 105
 106 1;