Do you have debug statements sprinkled around several modules? Getting bored tweaking the reporting level in several different files by hand? To lazy (in the bad way) to go and learn or write a logging module? Here's a quick hack that may be useful.

Instead of doing:

package Foo;

use constant DEBUG => 2;

warn "something happened" if DEBUG;

warn "something interesting happened" if DEBUG > 1;

[download]

in each module, do: 

package Foo;
use constant DEBUG => do {my $p=__PACKAGE__; ",$ENV{DEBUG}," =~ m/,($p
+|all)(=(.*?))?,/s && ($2 ? $3 : 1) };

warn "something happened" if DEBUG;

warn "something interesting happened" if DEBUG > 1;

[download]

To enable logging for a particular module set the environment variable DEBUG before you run your script.

# set DEBUG to 1 in package main
% setenv DEBUG main
% perl foo.pl

# set DEBUG to 5 in package main
% setenv DEBUG main=5
% perl foo.pl

# set DEBUG to 2 in package main and 3 in package Foo
% setenv DEBUG Foo=3,main=2
% perl foo.pl

# set DEBUG to 99 in all packages
% setenv DEBUG all=99
% perl foo.pl

[download]

Hopefully you get the idea.

If you actually find this useful you're probably ready for a proper logging module :-) I've found Log::Log4Perl quite nice.

Replies are listed 'Best First'.
Re: Poor man's logging
by TStanley (Canon) on Dec 11, 2002 at 05:53 UTC
    On November 20, I uploaded Logger::Simple to CPAN. This module is an implementation of the Simran::Log::Log and Simran::Error::Error modules.

    TStanley
    --------
    It is God's job to forgive Osama Bin Laden. It is our job to arrange the meeting -- General Norman Schwartzkopf
[reply]
Re: Poor man's logging
by Aristotle (Chancellor) on Dec 11, 2002 at 14:44 UTC 
    use constant DEBUG => do {
    my %dlv = map /^(.*)=(\d+)$/, split /,/, $ENV{DEBUG};
    $dlv{__PACKAGE__} || $dlv{all} || 1;
};

    [download]

    Makeshifts last the longest.

[reply]
[d/l]

      More readable, but doesn't work (or works differently :-)

      • If the package name or 'all' is not in the environment variable, it returns 1 not the empty string!
      • $dlv{__PACKAGE__} is the same as $dlv{"__PACKAGE__"} so it never checks %dlv for the package name
      • /^(.*)=(\d+)$/ doesn't allow package names sans the "=" as the original did (the value should default to 1).
      • If warnings are on and $ENV{DEBUG} is not define you get an undefined warning. My version does this too!

      Have a test suite :-)

      #! /usr/bin/perl 

use strict;
use warnings;
use Symbol qw(delete_package);
use Test::More;

my %variants = (

  adrianh_original => q{
    use constant DEBUG => do {
      my $p=__PACKAGE__; 
      ",$ENV{DEBUG}," =~ m/,($p|all)(=(.*?))?,/s && ($2 ? $3 : 1) 
    };
  },

  adrianh_no_warnings => q{
    use constant DEBUG => do {
      my ($package, $debug) = (__PACKAGE__, $ENV{DEBUG} || ''); 
      ",$debug," =~ m/,($package|all)(=(.*?))?,/s && ($2 ? $3 : 1)
    };
  },

  aristotle => q{
    use constant DEBUG => do {
      my %dlv = map /^(.*)=(\d+)$/, split /,/, $ENV{DEBUG};
      $dlv{__PACKAGE__} || $dlv{all} || 1;
    };
  },
);

my %test_values = (
  'Foo::Bar'         =>  1,
  'all'              =>  1,
  ''                 =>  '',
  'bar'              =>  '',
  undef              =>  '',
  'Foo::Bar=99,bar'  => 99,
  'bar,Foo::Bar=99', => 99,
  'all=99,bar'       => 99,
  'bar,all=99',      => 99,
);

plan tests => scalar(keys(%test_values)) * scalar(keys(%variants));

while (my ($variant, $test_constant) = each %variants) {
  while (my ($debug, $expected) = each %test_values ) {
    delete_package('Foo::Bar');
    if ($debug eq 'undef') {
      delete $ENV{'DEBUG'};
    } else {
      $ENV{'DEBUG'} = $debug;
    };
    eval qq{
      package Foo::Bar;
      use strict;
      use warnings;
      $test_constant;
      main::is(DEBUG, \$expected, "\$variant: \$debug");
    }; fail($@) if $@;
  };
};

      [download]

      Which produces

      1..27
ok 1 - adrianh_original: 
ok 2 - adrianh_original: bar
ok 3 - adrianh_original: Foo::Bar=99,bar
Use of uninitialized value in concatenation (.) or string at (eval 7) 
+line 6.
ok 4 - adrianh_original: undef
ok 5 - adrianh_original: all=99,bar
ok 6 - adrianh_original: bar,Foo::Bar=99
ok 7 - adrianh_original: bar,all=99
ok 8 - adrianh_original: all
ok 9 - adrianh_original: Foo::Bar
not ok 10 - aristotle: 
#     Failed test ((eval 19) at line 11)
#          got: '1'
#     expected: ''
not ok 11 - aristotle: bar
#     Failed test ((eval 21) at line 11)
#          got: '1'
#     expected: ''
not ok 12 - aristotle: Foo::Bar=99,bar
#     Failed test ((eval 23) at line 11)
#          got: '1'
#     expected: '99'
Use of uninitialized value in split at (eval 25) line 7.
not ok 13 - aristotle: undef
#     Failed test ((eval 25) at line 11)
#          got: '1'
#     expected: ''
ok 14 - aristotle: all=99,bar
not ok 15 - aristotle: bar,Foo::Bar=99
#     Failed test ((eval 29) at line 11)
#          got: '1'
#     expected: '99'
ok 16 - aristotle: bar,all=99
ok 17 - aristotle: all
ok 18 - aristotle: Foo::Bar
ok 19 - adrianh_no_warnings: 
ok 20 - adrianh_no_warnings: bar
ok 21 - adrianh_no_warnings: Foo::Bar=99,bar
ok 22 - adrianh_no_warnings: undef
ok 23 - adrianh_no_warnings: all=99,bar
ok 24 - adrianh_no_warnings: bar,Foo::Bar=99
ok 25 - adrianh_no_warnings: bar,all=99
ok 26 - adrianh_no_warnings: all
ok 27 - adrianh_no_warnings: Foo::Bar
# Looks like you failed 5 tests of 27.

      [download]
[reply]
[d/l]
[select]
        Didn't read close enough I guess - but the necessary changes are trivial. 
        use constant DEBUG => do {
    my %dlv = map /^(.+?)(?:=(\d+))?$/, split /,/, $ENV{DEBUG} || '';
    $dlv{(__PACKAGE__)} || exists $dlv{(__PACKAGE__)}
    || $dlv{all} || exists $dlv{all};
};

        [download]

        Makeshifts last the longest.

[reply]
[d/l]

Back to Cool Uses for Perl