lib/CPAN/Debug.pm

   1 package CPAN::Debug;
   2 use strict;
   3 use vars qw($VERSION);
   4
   5 $VERSION = sprintf "%.6f", substr(q$Rev: 924 $,4)/1000000 + 5.4;
   6 # module is internal to CPAN.pm
   7
   8 %CPAN::DEBUG = qw[
   9                   CPAN              1
  10                   Index             2
  11                   InfoObj           4
  12                   Author            8
  13                   Distribution     16
  14                   Bundle           32
  15                   Module           64
  16                   CacheMgr        128
  17                   Complete        256
  18                   FTP             512
  19                   Shell          1024
  20                   Eval           2048
  21                   HandleConfig   4096
  22                   Tarzip         8192
  23                   Version       16384
  24                   Queue         32768
  25                   FirstTime     65536
  26 ];
  27
  28 $CPAN::DEBUG ||= 0;
  29
  30 #-> sub CPAN::Debug::debug ;
  31 sub debug {
  32     my($self,$arg) = @_;
  33     my($caller,$func,$line,@rest) = caller(1); # caller(0) eg
  34                                                # Complete, caller(1)
  35                                                # eg readline
  36     ($caller) = caller(0);
  37     $caller =~ s/.*:://;
  38     $arg = "" unless defined $arg;
  39     pop @rest while @rest > 5;
  40     my $rest = join ",", map { defined $_ ? $_ : "UNDEF" } @rest;
  41     if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
  42         if ($arg and ref $arg) {
  43             eval { require Data::Dumper };
  44             if ($@) {
  45                 $CPAN::Frontend->myprint($arg->as_string);
  46             } else {
  47                 $CPAN::Frontend->myprint(Data::Dumper::Dumper($arg));
  48             }
  49         } else {
  50             $CPAN::Frontend->myprint("Debug($caller:$func,$line,[$rest]): $arg\n");
  51         }
  52     }
  53 }
  54
  55 1;
  56
  57 __END__
  58
  59 =head1 LICENSE
  60
  61 This program is free software; you can redistribute it and/or
  62 modify it under the same terms as Perl itself.
  63
  64 =cut