File Coverage

blib/lib/CGI/Application/Plugin/DevPopup/HTTPHeaders.pm

Criterion	Covered	Total	%
statement	42	46	91.3
branch	5	10	50.0
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	55	64	85.9

package CGI::Application::Plugin::DevPopup::HTTPHeaders;
{
  $CGI::Application::Plugin::DevPopup::HTTPHeaders::VERSION = '1.08';
}

use strict;
use warnings;
no warnings 'uninitialized'; # don't care about empty strings
use base qw/Exporter/;

sub import
{
    my $c = scalar caller;
    $c->add_callback( 'devpopup_report', \&_header_report );
    goto &Exporter::import;
}

sub _header_report
{
    my $self = shift;
    my $env = _env_report($self);
    my $cgi = _cgi_report($self);
    my $out = $self->query->header($self->header_props);
    $out =~ s/\r//g;

    $self->devpopup->add_report(
        title => 'HTTP Headers',
        summary => 'Incoming and outgoing HTTP headers',
        report => qq(
         </td>
</tr>

<tr>
<td  class="h" >
<a name="31">31</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">         tr.even{background-color:#eee} </td>
</tr>

<tr>
<td  class="h" >
<a name="32">32</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s">
         $cgi Incoming HTTP Headers
        Outgoing HTTP Headers$out
        Environment Dump $env
        )
    );
}

sub _env_report
{
    my $self = shift;
    my $r=0;
    my $report = join $/, map {
                    $r=1-$r;
                    qq{
                }
                sort keys %ENV;

    return $report;
}

sub _cgi_report
{
    my $self = shift;

    my $r=0;
    my $q = $self->query;
    my $report = '';

    eval {
        $report = '
            join $/, map {
                    $r=1-$r;
                    qq{
                }
                sort $q->http;
    };

    return "

    eval {
        $report .= '
            join $/, , map {
                    $r=1-$r;
                    qq{
                }
                sort $q->https if $q->https;
    };

    return $report;
}

1;    # End of CGI::Application::Plugin::DevPopup::HTTPHeaders

__END__