lib/CXGN/Debug.pm

   1 =head1 NAME
   2
   3 CXGN::Debug - a utility class for handling debug messages
   4
   5 =head1 DESCRIPTION
   6
   7 Use CXGN::Debug for inserting debugging messages in your code. Example:
   8
   9   use CXGN::Debug;
  10
  11   #normal usage
  12   my $d = CXGN::Debug->new();
  13   $d->d("blablalba");
  14
  15
  16   # use for only a portion of your code
  17   $d->set_debug( 1 );
  18   # do something
  19   $d->set_debug( 0 );
  20
  21 The debug messages are printed to STDERR in a terminal context, and to
  22 the Apache error log in a mod_perl context.
  23
  24 For CXGN objects, you could inherit from CXGN::Debug.  Be sure to call
  25 __PACKAGE__->SUPER::new() in any constructors that you write, though.
  26
  27 =head1 SWITCHING OFF AND ON
  28
  29 When a Debug object is created, it sets itself to be either on or off
  30 (that is, printing or non-printing) based on:
  31
  32      the debug => option to its constructor, if passed
  33   or if that is not passed, the CXGN_DEBUG environment variable
  34   or if that is not present, the 'debug' setting in the (merged) vhost conf
  35   or if that is not present, off.
  36
  37 =head1 AUTHORS
  38
  39 Lukas Mueller and Robert Buels
  40
  41 =cut
  42
  43 package CXGN::Debug;
  44 use strict;
  45 use CXGN::Config;
  46
  47 =head2 new()
  48
  49  Usage:        $d = CXGN::Debug->new();
  50  Desc:         the constructor
  51  Args:         a hash with parameters, currently:
  52                 debug
  53                calling CXGN::Debug->new( debug=>1) will
  54                override the global configuration file
  55  Side Effects:
  56  Example:
  57
  58 =cut
  59
  60 sub new {
  61     my $class = shift;
  62     my %opts = @_;
  63     my $self = bless {}, $class;
  64
  65     my $conf_debug = CXGN::Config->load->{debug};
  66
  67     my $initial_debug_setting =
  68               defined $opts{debug}     ? $opts{debug}
  69             : defined $ENV{CXGN_DEBUG} ? $ENV{CXGN_DEBUG}
  70             : defined $conf_debug      ? $conf_debug
  71             :                            0;
  72
  73     $self->set_debug( $initial_debug_setting );
  74
  75     return $self;
  76 }
  77
  78 =head2 accessors get_debug(), set_debug()
  79
  80  Usage:        $d->set_debug(1);
  81  Desc:         accessors for the debug property.
  82                a true value turns debugging on, i.e., debug
  83                messages will be printed to either STDERR or
  84                the Apache error log (if running in mod_perl).
  85  Property:
  86  Side Effects:
  87  Example:
  88
  89 =cut
  90
  91 sub get_debug {
  92   my $self = shift;
  93   return $self->{debug};
  94 }
  95
  96 sub set_debug {
  97   my $self = shift;
  98   $self->{debug} = shift;
  99 }
 100
 101 =head2 debug()  or  d()
 102
 103  Usage:  $d->d("The value of foo is $foo\n");
 104  Desc:   A debug message. Note that you have to provide the
 105          newline.
 106  Ret:    nothing meaningful
 107  Args:   message to print
 108  Side Effects: prints message to STDERR.  if running under
 109                mod_perl, uses log()->debug() method to print
 110                the message to the log
 111  Example:
 112      $d->d('well here we are');
 113
 114 =cut
 115
 116 sub debug {
 117
 118     my $self = shift;
 119     my $message = shift;
 120
 121     if ($self->get_debug()) {
 122
 123         $message .= "\n" unless $message =~ /\n$/;
 124         warn "$message";
 125
 126         if ($ENV{MOD_PERL}) {
 127             require Apache2::RequestUtil
 128                 or die "must have Apache2::RequestUtil installed to use CXGN::Debug under mod_perl";
 129             my $r= Apache2::Request->new();
 130             $r->log()->debug($message);
 131         }
 132
 133     }
 134 }
 135
 136 sub d {
 137     my $self = shift;
 138     $self->debug(@_);
 139 }
 140
 141
 142 ###
 143 1;#do not remove
 144 ###
 145