verbose.pm

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