[Summary view] [Print] [Text view]

   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 = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
   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