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 ## Accessor for the debug setting.  No parameters are necessary.
  53 sub get_debug_level {
  54   return $debug;
  55 }
  56
  57 sub split_message {
  58   my($self, $msg, $spc) = @_;
  59   $msg =~ s/\n+/\n$spc/g;
  60   $msg =~ s/\.\s+/.\n$spc/g;
  61   return $msg . "\n";
  62 }
  63
  64
  65 sub details {
  66   if ($details) {
  67     #my($self, $msg) = @_;
  68     print "$_[1]\n";
  69   }
  70 }
  71
  72
  73 sub diagnostic {
  74   if ($diagnostic) {
  75     #my($self, $msg) = @_;
  76     print "$_[1]\n";
  77   }
  78 }
  79
  80
  81 sub debug {
  82   if ($debug) {
  83     #my($self, $msg) = @_;
  84     print "$debugtag$_[1]\n";
  85   }
  86 }
  87
  88
  89 sub information {
  90   if ($information) {
  91     #my($self, $msg) = @_;
  92     print $infotag, $_[0]->split_message($_[1], ' ' x length($infotag));
  93   }
  94 }
  95
  96
  97 sub warning {
  98   if ($warnings) {
  99     #my($self, $msg) = @_;
 100     print $warntag, $_[0]->split_message($_[1], ' ' x length($warntag));
 101   }
 102 }
 103
 104
 105 sub error {
 106   my($self, $msg, $pre) = @_;
 107   print STDERR '', (defined $pre ? "$pre\n" : ''), $errortag,
 108                $self->split_message($msg, ' ' x length($errortag));
 109 }
 110
 111
 112 1;