lib/CPAN/Debug.pm

   1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
   2 package CPAN::Debug;
   3 use strict;
   4 use vars qw($VERSION);
   5
   6 $VERSION = "5.5";
   7 # module is internal to CPAN.pm
   8
   9 %CPAN::DEBUG = qw[
  10                   CPAN              1
  11                   Index             2
  12                   InfoObj           4
  13                   Author            8
  14                   Distribution     16
  15                   Bundle           32
  16                   Module           64
  17                   CacheMgr        128
  18                   Complete        256
  19                   FTP             512
  20                   Shell          1024
  21                   Eval           2048
  22                   HandleConfig   4096
  23                   Tarzip         8192
  24                   Version       16384
  25                   Queue         32768
  26                   FirstTime     65536
  27 ];
  28
  29 $CPAN::DEBUG ||= 0;
  30
  31 #-> sub CPAN::Debug::debug ;
  32 sub debug {
  33     my($self,$arg) = @_;
  34
  35     my @caller;
  36     my $i = 0;
  37     while () {
  38         my(@c) = (caller($i))[0 .. ($i ? 3 : 2)];
  39         last unless defined $c[0];
  40         push @caller, \@c;
  41         for (0,3) {
  42             last if $_ > $#c;
  43             $c[$_] =~ s/.*:://;
  44         }
  45         for (1) {
  46             $c[$_] =~ s|.*/||;
  47         }
  48         last if ++$i>=3;
  49     }
  50     pop @caller;
  51     if ($CPAN::DEBUG{$caller[0][0]} & $CPAN::DEBUG) {
  52         if ($arg and ref $arg) {
  53             eval { require Data::Dumper };
  54             if ($@) {
  55                 $CPAN::Frontend->myprint($arg->as_string);
  56             } else {
  57                 $CPAN::Frontend->myprint(Data::Dumper::Dumper($arg));
  58             }
  59         } else {
  60             my $outer = "";
  61             local $" = ",";
  62             if (@caller>1) {
  63                 $outer = ",[@{$caller[1]}]";
  64             }
  65             $CPAN::Frontend->myprint("Debug(@{$caller[0]}$outer): $arg\n");
  66         }
  67     }
  68 }
  69
  70 1;
  71
  72 __END__
  73
  74 =head1 LICENSE
  75
  76 This program is free software; you can redistribute it and/or
  77 modify it under the same terms as Perl itself.
  78
  79 =cut