home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / CPAN / Debug.pm next >
Encoding:
Perl POD Document  |  2009-06-26  |  2.0 KB  |  80 lines
  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
  80.