[new module] proposal Apache::DebugHeaders

[Geoffrey Young]

ok, this isn't all that clever, but recently I got tired of writing loops of
warnings to debug headers_in and headers_out over and over again...

all this one does is spit out headers_in in the init phase and headers_out
in the cleanup phase.  Not terribly extensible, but perhaps practical

if anyone thinks it worthy of CPAN, I'll throw it up.  If folks are real
interested, maybe it can be altered somewhat to start an Apache::Debug::
series with stuff working toward similar ends...

Otherwise, feel free to discard it at will...

--Geoff

package Apache::DebugHeaders;

#---------------------------------------------------------------------
#
# usage: PerlInitHandler Apache::DebugHeaders
#
#---------------------------------------------------------------------

use 5.004;
use mod_perl 1.21;
use Apache::Constants qw( OK );
use Apache::Log;
use strict;

$Apache::DebugHeaders::VERSION = '0.01';

# set debug level
#  0 - messages at info or debug log levels
#  1 - verbose output at info or debug log levels
$Apache::DebugHeaders::DEBUG = 1;

sub handler {
#---------------------------------------------------------------------
# initialize request object
#---------------------------------------------------------------------
  
  my $r               = shift;
  my $log             = $r->server->log;

#---------------------------------------------------------------------
# do some preliminary stuff...
#---------------------------------------------------------------------

  $log->info("Using Apache::DebugHeaders") 
     if $Apache::DebugHeaders::DEBUG;

#---------------------------------------------------------------------
# push the PerlFixupHander and PerlCleanupHandler onto the stack
#---------------------------------------------------------------------

  $r->push_handlers(PerlInitHandler    => 'Apache::DebugHeaders::in');
  $r->push_handlers(PerlCleanupHandler => 'Apache::DebugHeaders::out');

#---------------------------------------------------------------------
# wrap up...
#---------------------------------------------------------------------

  $log->info("Exiting Apache::DebugHeaders")
     if $Apache::DebugHeaders::DEBUG;

  return OK;
}

sub in {
#---------------------------------------------------------------------
# initialize request object
#---------------------------------------------------------------------
  
  my $r               = shift;
  my $log             = $r->server->log;

#---------------------------------------------------------------------
# print $r->headers_in in a pretty format
#---------------------------------------------------------------------

  my $headers_in = $r->headers_in;

  $log->info("headers_in:");

  $headers_in->do(sub {
    my ($field, $value) = @_;
    if ($field =~ m/Cookie/) {
      my @values = split /; /, $value;
      foreach my $cookie (@values) {
        $log->info("\tfield = $field, value = $cookie");
      }
    }
    else { 
      $log->info("\tfield = $field, value = $value");
    }
    1;
  });   

#---------------------------------------------------------------------
# wrap up...
#---------------------------------------------------------------------

  return OK;
}

sub out {
#---------------------------------------------------------------------
# initialize request object
#---------------------------------------------------------------------
  
  my $r               = shift;
  my $log             = $r->server->log;

#---------------------------------------------------------------------
# print $r->headers_out in a pretty format
#---------------------------------------------------------------------

  my $headers_out = $r->headers_out;

  $log->info("headers_out:");

  $headers_out->do(sub {
    my ($field, $value) = @_;
    if ($field =~ m/Cookie/) {
      my @values = split /;/, $value;
      $log->info("\tfield = $field, value = $values[0]");
      for (my $i=1;$i < @values; $i++) {
        $log->info("\t\t\t\t   $values[$i]");
      }
    }
    else { 
      $log->info("\tfield = $field, value = $value");
    }
    1;
  });   

#---------------------------------------------------------------------
# wrap up...
#---------------------------------------------------------------------

  return OK;
}

1;

__END__

=head1 NAME

Apache::DebugHeaders - log the incoming and outbound HTTP headers

=head1 SYNOPSIS

  httpd.conf:

    PerlInitHandler Apache::DebugHeaders

=head1 DESCRIPTION

  Apache::DebugHeaders merely itterates through $r->headers_in and
  $r->headers_out and prints them to the error_log.  It provides an
  easy way to quickly enable and disable debugging behavior - that's
  all.

=head1 NOTES

  Verbose debugging is enabled by setting the variable
  $Apache::DebugHeaders::DEBUG=1 to or greater. To turn off all debug
  information (including the header info, which is the point of this
  module), set your apache LogLevel above info level.

  This is alpha software, and as such has not been tested on multiple
  platforms or environments.  It requires PERL_INIT=1, PERL_CLEANUP=1,
  PERL_LOG_API=1, PERL_STACKED_HANDLERS=1, and maybe other hooks to 
  function properly.

=head1 FEATURES/BUGS

  No known bugs or unexpected features at this time.

=head1 SEE ALSO

  perl(1), mod_perl(1), Apache(3), Apache::Table(3)

=head1 AUTHOR

  Geoffrey Young <[EMAIL PROTECTED]>

=head1 COPYRIGHT

  Copyright 2000 Geoffrey Young - all rights reserved.

  This library is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.

=cut