Hi, Geoff
> 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...
Every code snippet that you produce and find it useful, at some point
might be useful to other programmers. Therefore it's a good idea to make
it available even if there is no interest when you post it (I don't say
there is not :) So if no one replies with naming suggestion or else, go
ahead and release it on CPAN.
Did you know that CPAN tolerates even the packages with no Makefile.PL? I
don't try to disencourage you to write Makefile.PL (feel free to "steal"
one from your favorite module), but if you really cannot build yours
release it as it is. It still might save one of us days of work, which in
return might give you something that you need.
> 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
>
______________________________________________________________________
Stas Bekman | JAm_pH -- Just Another mod_perl Hacker
http://stason.org/ | mod_perl Guide http://perl.apache.org/guide/
mailto:[EMAIL PROTECTED] | http://perl.org http://stason.org/TULARC/
http://singlesheaven.com| http://perlmonth.com http://sourcegarden.org
----------------------------------------------------------------------
