Verbose.pm

   1 package Verbose;
   2 use strict;
   3 use warnings;
   4
   5 our $AUTOLOAD;
   6 our $level = 0;
   7
   8 sub import {
   9         my $self = shift;
  10         my $minlevel = 0;
  11         foreach (@_) {
  12                 if (m/^:(\d+)$/) {
  13                         $minlevel = $1;
  14                 } else {
  15                         &make_verbose($minlevel, $_, (caller)[0]);
  16                 }
  17         }
  18 }
  19
  20 sub AUTOLOAD {
  21         &make_verbose($AUTOLOAD, (caller)[0]);
  22         goto &$AUTOLOAD;
  23 }
  24
  25 sub debugcall {
  26         my ($minlevel, $name, @args) = @_;
  27         local $" = ', ';
  28         print "+ $name(@args)\n" if ($level >= $minlevel);
  29 }
  30
  31 sub make_verbose {
  32         no strict 'refs';
  33         no warnings qw(redefine prototype);
  34         my ($minlevel, $sym, $pkg) = @_;
  35         $sym = "${pkg}::$sym" unless $sym =~ /::/;
  36         my $name = $sym;
  37         $name =~ s/.*::// or $name =~ s/^&//;
  38         my ($sref, $call, $proto);
  39         if (defined(&$sym)) {
  40                 $sref = \&$sym;
  41                 $call = '&$sref';
  42                 $proto = prototype $sref;
  43         } else {
  44                 $call = "CORE::$name";
  45                 $proto = prototype $call;
  46         }
  47         $proto = '@' unless defined($proto);
  48         my $code = "package $pkg; sub ($proto) { Verbose::debugcall($minlevel, \"$name\", \@_); $call(\@_); }";
  49         *{$sym} = eval($code);
  50 }
  51
  52 1;