File Coverage

blib/lib/Apache/DumpHeaders.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Apache::DumpHeaders;
use strict;
use Apache;
use Apache::Constants qw(DECLINED OK);
use vars qw($VERSION);

$VERSION = "0.94";

sub handler {
  my $r = shift;
  my $note = $r->notes("DumpHeaders");
  if ($r->dir_config("DumpHeaders_Conditional")) {
    return DECLINED unless $note;
  }
  if ($r->dir_config("DumpHeaders_Percent")) {
    return DECLINED unless rand(100) < $r->dir_config("DumpHeaders_Percent");
  }
  if ($r->dir_config("DumpHeaders_IP")) {
    my $remote_ip = $r->connection->remote_ip;
    return DECLINED unless grep { /\Q$remote_ip\E/ }
      split (/\s+/, $r->dir_config("DumpHeaders_IP"));
  }
  my $filename = $r->dir_config("DumpHeaders_File") or return DECLINED;
  unless (open OUT, ">>$filename") {
    warn "Failed to open $filename: $!";
    return DECLINED;
  }
  my $msg = ($note and $note =~ /\D/) ? "$note " : "";
  print OUT "\n======= ", scalar localtime, " $msg=======\n";
  print OUT $r->as_string;
  close OUT;
  return OK;
}

1;

__END__