1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
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(
<style type="text/css">
tr.even{background-color:#eee}
</style>
<table><thead><th colspan="2">Incoming HTTP Headers</th></thead><tbody> $cgi </tbody></table>
<table><thead><th colspan="2">Outgoing HTTP Headers</th></thead><tbody><tr><td style="white-space:pre">$out</td></tr></tbody></table>
<table><thead><th colspan="2">Environment Dump</th></thead><tbody><tr><td> $env </td></tr></tbody></table>
)
);
}
sub _env_report
{
my $self = shift;
my $r=0;
my $report = join $/, map {
$r=1-$r;
qq{<tr class="@{[$r?'odd':'even']}"><td valign="top"> $_ </td><td> $ENV{$_} </td></tr>}
}
sort keys %ENV;
return $report;
}
sub _cgi_report
{
my $self = shift;
my $r=0;
my $q = $self->query;
my $report = '';
eval {
$report = '<tr><th colspan="2">http</th></tr>' .
join $/, map {
$r=1-$r;
qq{<tr class="@{[$r?'odd':'even']}"><td valign="top"> $_ </td><td> @{[$q->http($_)]} </td></tr>}
}
sort $q->http;
};
return "<tr><td>Your query object doesn't have a http() method</td></tr>" if $@;
eval {
$report .= '<tr><th colspan="2">https</th></tr>' .
join $/, , map {
$r=1-$r;
qq{<tr class="@{[$r?'odd':'even']}"><td valign="top"> $_ </td><td> @{[$q->https($_)]} </td></tr>}
}
sort $q->https if $q->https;
};
return $report;
}
1; # End of CGI::Application::Plugin::DevPopup::HTTPHeaders
__END__
=head1 NAME
CGI::Application::Plugin::DevPopup::HTTPHeaders - show incoming and outgoing HTTP headers
=head1 VERSION
version 1.08
=head1 SYNOPSIS
use CGI::Application::Plugin::DevPopup;
use CGI::Application::Plugin::DevPopup::HTTPHeaders;
The rest of your application follows
...
Output looks roughly like this:
Incoming HTTP Headers
-----------------------------------
http
-----------------------------------
HTTP_ACCEPT text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
HTTP_ACCEPT_CHARSET UTF-8,*;q=0.5
HTTP_HOST www.example.com
Outgoing HTTP Headers
-----------------------------------
Content-Type: text/html; charset=utf8
Environment Dump
-----------------------------------
CAP_DEVPOPUP_EXEC 1
DOCUMENT_ROOT /var/www/html
GATEWAY_INTERFACE CGI/1.1
QUERY_STRING
REMOTE_ADDR 127.0.0.1
=head1 LIMITATIONS
For obvious reasons, the outgoing headers only display what CGI::Application will generate.
=head1 SEE ALSO
L<CGI::Application::Plugin::DevPopup>, L<CGI::Application>
=head1 AUTHOR
Rhesa Rozendaal, L<rhesa@cpan.org>
=head1 BUGS
Please report any bugs or feature requests to
L<bug-cgi-application-plugin-devpopup@rt.cpan.org>, or through the web
interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Application-Plugin-DevPopup>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
=head1 COPYRIGHT & LICENSE
Copyright 2005 Rhesa Rozendaal, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
|
