Re: access to raw http request? (LWP::DebugFile)

[Sean M. Burke]

At 16:16 2002-04-08 -0700, Benjamin Franks wrote:
>[...]Is there a method for viewing the raw http request string?

I wrote this sort of modulation of LWP::Debug the other day, that you might want to 
give a try.  I dashed it off so I could look at exactly what was going over the 
socket(s).  If anyone finds it useful, let me know, and I'll document it or something, 
and submit it to Gisle for putting into LWP.
(I've even had fun doing "perl -MLWP::DebugFile -S lwp-get http://whatever";)


LWP/DebugFile:


# A module like LWP::Debug, except logs to a file instead of to STDERR,
#  and things sent to conns get prettied up for easier reading.

require 5;
package LWP::DebugFile;
use LWP::Debug ();
use strict;
use vars qw($outname $outpath @ISA $last_message_time);
@ISA = ('LWP::Debug');

_init() unless $^C or !caller;

sub _init {
  $outpath = $ENV{'LWPDEBUGPATH'} || ''
   unless defined $outpath;
  $outname = $ENV{'LWPDEBUGFILE'} || sprintf "%slwp_%x.%x.log", $outpath, $^T, $$
   unless defined $outname;

  open LWPERR, ">>$outname" or die "Can't write-open $outname: $!";
  # binmode(LWPERR);
  {
    no strict;
    my $x = select(LWPERR);
    ++$|;
    select($x);
  }

  $last_message_time = time();
  die "Can't print to LWPERR"
   unless print LWPERR "\n# ", __PACKAGE__, " logging to $outname\n";
   # check at least the first print, just for sanity's sake!

  print LWPERR "# Time now: \{$last_message_time\} = ",
          scalar(localtime($last_message_time)), "\n";

  LWP::Debug::level($ENV{'LWPDEBUGLEVEL'} || '+');
  return;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

BEGIN { # So we don't get redefinition warnings...
  undef &LWP::Debug::conns;
  undef &LWP::Debug::_log;
}

sub LWP::Debug::conns {
  if($LWP::Debug::current_level{'conns'}) {
    my $msg = $_[0];
    my $line;
    my $prefix = '0';
    while($msg =~ m/([^\n\r]*[\n\r]*)/g) {
      next unless length($line = $1);
      # Hex escape it:
      $line =~ s/([^\x20\x21\x23-\x7a\x7c\x7e])/
        (ord($1)<256) ? sprintf('\x%02X',ord($1))
         : sprintf('\x{%x}',ord($1))
      /eg;
      LWP::Debug::_log("S>$prefix \"$line\"");
      $prefix = '+';
    }
  }
}

sub LWP::Debug::_log
{
    my $msg = shift;
    $msg .= "\n" unless $msg =~ /\n$/;  # ensure trailing "\n"

    my($package,$filename,$line,$sub) = caller(2);
    unless((my $this_time = time()) == $last_message_time) {
      print LWPERR "# Time now: \{$this_time\} = ",
        scalar(localtime($this_time)), "\n";
      $last_message_time = $this_time;
    }
    print LWPERR "$sub: $msg";
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1;
__END__

TODO: document





--
Sean M. Burke    http://www.spinn.net/~sburke/