lib/debug_subs.pm

   1 # The Debug class is a little bit special in that it should never be
   2 # instanciated. An instance is kept globaly which can be accessed by
   3 # the members of the debug class if they are called staticaly. Calling
   4 # a member staticaly means that you adress them using the perl module
   5 # name, for example:
   6 #
   7 # debug -> level( );
   8 #
   9 # Notice that there is no $ in front of 'debug'. Here level is called
  10 # "staticaly". In other words, it means "call a member without an
  11 # instance".
  12 #
  13 # The reason for this is that debug keeps a "level" variable globaly,
  14 # which indicates how verbose PsN should be, the higher the level, the
  15 # more messages you will see.. The level variable is numerical, but
  16 # each level has a name in order to make its use a bit more
  17 # intuitive. The levels are, starting with the lowest:
  18 #
  19 # "fatal" - only when an error so grave that PsN has to exit, a fatal
  20 #           message may be printed. This is the least amount of messages
  21 #           you can see.
  22 #
  23 #
  24 # "warning" - When something critical happens, somethings that
  25 #             probably should be examined closer, though not
  26 #             serious enough to exit PsN a warning message may be
  27 #             printed.
  28 #
  29 # "information" - When something out of the ordinary happens and
  30 #                 we think the user should be informed, an
  31 #                 informational message may be printed.
  32 #
  33 # "call_trace" - This level is mostly used by developers when
  34 #                debugging PsN. If this level is set a message
  35 #                will be printed for each method which is called
  36 #                inside PsN. Needless to say, this will print a
  37 #                lot of text. The only time a user should turn this
  38 #                is when filing a bug report, and only then if a
  39 #                developer thinks it is necessary.
  40 #
  41 # Setting a higher level than "fatal" also means that message of all
  42 # lower levels will be printed.
  43 #
  44 # No PsN class may change the level.
  45
  46 # {{{ include
  47 start include statements
  48 use Carp;
  49 use Carp qw(cluck);
  50 use Text::Wrap;
  51
  52 # These variables are used for mapping level names to numbers.
  53
  54 my $fatal = 0;
  55 my $warning = 1;
  56 my $information = 2;
  57 my $call_trace = 3;
  58
  59 my $the_instance = debug::new();
  60
  61 end include statements
  62 # }}}
  63
  64 # {{{ new
  65 start new
  66 end new
  67 # }}}
  68
  69 # {{{ level
  70
  71 start level
  72     {
  73       # Usage:
  74       #
  75       # debug -> level( debug::warning )
  76       #
  77       # If you give a value to level as a single argument, you will
  78       # set the global level of debug messages.
  79       #
  80       # my $current_level = debug -> level
  81       #
  82       # If you don't give any argument the current level is returned.
  83
  84       if( defined($parm) ){
  85         $the_instance -> {'level'} = $parm;
  86       } else {
  87         return $the_instance -> {'level'};
  88       }
  89       return;
  90     }
  91 end level
  92
  93 # }}}
  94
  95 # {{{ package
  96
  97 start package
  98     {
  99       # Usage:
 100       #
 101       # debug -> package( 'output' )
 102       #
 103       # If you give a value to package as a single argument, you will
 104       # set the global package of debug messages.
 105       #
 106       # my $current_package = debug -> package
 107       #
 108       # If you don't give any argument the current package is returned.
 109
 110       if( defined($parm) ){
 111         $the_instance -> {'package'} = $parm;
 112       } else {
 113         return $the_instance -> {'package'};
 114       }
 115       return;
 116     }
 117 end package
 118
 119 # }}}
 120
 121 # {{{ subroutine
 122
 123 start subroutine
 124     {
 125       # Usage:
 126       #
 127       # debug -> subroutine( 'output' )
 128       #
 129       # If you give a value to subroutine as a single argument, you will
 130       # set the global subroutine of debug messages.
 131       #
 132       # my $current_subroutine = debug -> subroutine
 133       #
 134       # If you don't give any argument the current subroutine is returned.
 135
 136       if( defined($parm) ){
 137         $the_instance -> {'subroutine'} = $parm;
 138       } else {
 139         return $the_instance -> {'subroutine'};
 140       }
 141       return;
 142     }
 143 end subroutine
 144
 145 # }}}
 146
 147 # {{{ level_name
 148 start level_name
 149     {
 150       # Usage:
 151       #
 152       # my $level_name = debug -> level_name( level => 1 )
 153
 154       # level_name will map an integer in the interval 0 to 3 to a
 155       # string. The string is the name of the level with that number
 156       # in the order of levels. ( "fatal" is lowest and "call_trace"
 157       # highest ).
 158
 159       # By default it returns the name of the current set level.
 160
 161       # my $current_level_name = debug -> level_name;
 162
 163       $return_val = $the_instance -> {'level_names'} -> [$level];
 164     }
 165 end level_name
 166 # }}}
 167
 168 # {{{ warn_with_trace
 169 start warn_with_trace
 170     {
 171       # Usage:
 172       #
 173       # debug -> warn_with_trace( debug::warning )
 174       #
 175       # By default, a trace of function calls is printed when PsN
 176       # dies. If you like you can set a level for which you like
 177       # traces to be printed. Notice that all lower level messages
 178       # will also have a trace printed after them.
 179
 180       if( defined($parm) ){
 181         $the_instance -> {'warn_with_trace'} = $parm;
 182       } else {
 183         return $the_instance -> {'warn_with_trace'};
 184       }
 185       return;
 186     }
 187 end warn_with_trace
 188 # }}}
 189
 190 # {{{ warn
 191 start warn
 192     {
 193
 194       # Usage:
 195       #
 196       # debug -> warn( level => debug::warning, message => "This is a warning" );
 197       #
 198       # debug::warn will print out warning, informational or
 199       # call_trace messages corresponding to the level specified as
 200       # argument. debug::warn will look at the level given and the
 201       # global level to see whether anything should be printed.
 202       #
 203       #
 204       # NOTICE the lack of "\n" at the end of the message, debug::warn
 205       # will append one "\n". In case there ever is a GUI for PsN
 206       # debug::warn could be used to create a message in the GUI. And
 207       # in that case, an extra "\n" might be annoying.
 208
 209       if( $the_instance -> {'level'} >= $level ){
 210
 211         my ( $package_junk, $filename, $line, $subroutine, $junk ) = caller(1);
 212         my @names = split('::', $subroutine );
 213         $subroutine = $names[$#names];
 214         my $package = join( '::', @names[0..$#names-1] );
 215
 216         if ( ( not defined $the_instance -> {'package'} or
 217                $the_instance -> {'package'} eq $package ) and
 218              ( not defined $the_instance -> {'subroutine'} or
 219                $the_instance -> {'subroutine'} eq $subroutine ) ) {
 220
 221           my $level_name = $self -> level_name(level => $level);
 222           my $prefix;
 223           my $text;
 224
 225           if( $the_instance -> {'level'} >= 3 ){
 226             my @longmess = split( /\n/, Carp::longmess );
 227             my $arr = scalar(@longmess);
 228             $prefix = '  ' x ($arr-2);
 229           }
 230
 231           if( $level >= 3 ){
 232             $text = $prefix . $level_name . ': ' . $package . '->' .
 233               $subroutine. " : " . $message . "\n";
 234           } else {
 235             my $level_name_length = length( $level_name );
 236             my $indent = ' ' x ($level_name_length + 4);
 237             $text = wrap($prefix, $prefix . $indent, $level_name . ': ' . $package . '->' .
 238                          $subroutine. " : " . $message . "\n" );
 239           }
 240
 241           if( $the_instance -> {'warn_with_trace'} >= $level ){
 242             cluck( $text );
 243           } else {
 244             print STDERR ( $text );
 245           }
 246         }
 247       }
 248     }
 249 end warn
 250 # }}}
 251
 252 # {{{ die
 253 start die
 254     {
 255       # Usage
 256       #
 257       # debug -> die( message => "This message will print, and then PsN will die" );
 258       #
 259       #
 260       # debug::die is what PsN calls instead of "die" in order to get
 261       # a call trace. The given message is allways printed.
 262       #
 263       # NOTICE the lack of "\n" at the end of the message, debug::warn
 264       # will append one "\n". In case there ever is a GUI for PsN
 265       # debug::doe could be used to create a message in the GUI. And
 266       # in that case, an extra "\n" might be annoying.
 267
 268       if( $the_instance -> {'level'} >= 0 ){
 269         my $prefix;
 270         if( $the_instance -> {'level'} >= 3 ){
 271           my @longmess = split( /\n/, Carp::longmess );
 272           my $arr = scalar(@longmess);
 273           $prefix = '  ' x ($arr-2);
 274         }
 275         if( $the_instance -> {'level'} > 0 ){
 276           $! = 1;
 277           confess( $prefix . $message );
 278         } else {
 279           $! = 1;
 280           croak(  $prefix . $self -> level_name(level => 0) . ': ' . $message . "\n" );
 281         }
 282       }
 283     }
 284 end die
 285 # }}}