"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/site/lib/LWP/Debug.pm" (7 Mar 2020, 2914 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 package LWP::Debug;    # legacy
    2 
    3 our $VERSION = '6.43';
    4 
    5 require Exporter;
    6 our @ISA       = qw(Exporter);
    7 our @EXPORT_OK = qw(level trace debug conns);
    8 
    9 use Carp ();
   10 
   11 my @levels = qw(trace debug conns);
   12 our %current_level = ();
   13 
   14 sub import {
   15     my $pack    = shift;
   16     my $callpkg = caller(0);
   17     my @symbols = ();
   18     my @levels  = ();
   19     for (@_) {
   20         if (/^[-+]/) {
   21             push(@levels, $_);
   22         }
   23         else {
   24             push(@symbols, $_);
   25         }
   26     }
   27     Exporter::export($pack, $callpkg, @symbols);
   28     level(@levels);
   29 }
   30 
   31 sub level {
   32     for (@_) {
   33         if ($_ eq '+') {    # all on
   34                             # switch on all levels
   35             %current_level = map { $_ => 1 } @levels;
   36         }
   37         elsif ($_ eq '-') {    # all off
   38             %current_level = ();
   39         }
   40         elsif (/^([-+])(\w+)$/) {
   41             $current_level{$2} = $1 eq '+';
   42         }
   43         else {
   44             Carp::croak("Illegal level format $_");
   45         }
   46     }
   47 }
   48 
   49 sub trace { _log(@_) if $current_level{'trace'}; }
   50 sub debug { _log(@_) if $current_level{'debug'}; }
   51 sub conns { _log(@_) if $current_level{'conns'}; }
   52 
   53 sub _log {
   54     my $msg = shift;
   55     $msg .= "\n" unless $msg =~ /\n$/;    # ensure trailing "\n"
   56 
   57     my ($package, $filename, $line, $sub) = caller(2);
   58     print STDERR "$sub: $msg";
   59 }
   60 
   61 1;
   62 
   63 __END__
   64 
   65 =pod
   66 
   67 =head1 NAME
   68 
   69 LWP::Debug - deprecated
   70 
   71 =head1 DESCRIPTION
   72 
   73 This module has been deprecated.  Please see L<LWP::ConsoleLogger> for your
   74 debugging needs.
   75 
   76 LWP::Debug is used to provide tracing facilities, but these are not used
   77 by LWP any more.  The code in this module is kept around
   78 (undocumented) so that 3rd party code that happens to use the old
   79 interfaces continue to run.
   80 
   81 One useful feature that LWP::Debug provided (in an imprecise and
   82 troublesome way) was network traffic monitoring.  The following
   83 section provides some hints about recommended replacements.
   84 
   85 =head2 Network traffic monitoring
   86 
   87 The best way to monitor the network traffic that LWP generates is to
   88 use an external TCP monitoring program.  The
   89 L<WireShark|http://www.wireshark.org/> program is highly recommended for this.
   90 
   91 Another approach it to use a debugging HTTP proxy server and make
   92 LWP direct all its traffic via this one.  Call C<< $ua->proxy >> to
   93 set it up and then just use LWP as before.
   94 
   95 For less precise monitoring needs just setting up a few simple
   96 handlers might do.  The following example sets up handlers to dump the
   97 request and response objects that pass through LWP:
   98 
   99   use LWP::UserAgent;
  100   $ua = LWP::UserAgent->new;
  101   $ua->default_header('Accept-Encoding' => scalar HTTP::Message::decodable());
  102 
  103   $ua->add_handler("request_send",  sub { shift->dump; return });
  104   $ua->add_handler("response_done", sub { shift->dump; return });
  105 
  106   $ua->get("http://www.example.com");
  107 
  108 =head1 SEE ALSO
  109 
  110 L<LWP::ConsoleLogger>, L<LWP::ConsoleLogger::Everywhere>, L<LWP::UserAgent>
  111 
  112 =cut