File Coverage

blib/lib/HTTP/Request/FromTemplate.pm

Criterion	Covered	Total	%
statement	34	35	97.1
branch	4	8	50.0
condition	2	5	40.0
subroutine	7	7	100.0
pod	1	2	50.0
total	48	57	84.2

line	stmt	bran	cond	sub	pod	time	code
1							package HTTP::Request::FromTemplate;
2	3			3		461	use strict;
	3					4
	3					62
3	3			3		1155	use HTTP::Request;
	3					41360
	3					63
4	3			3		1371	use Template;
	3					38798
	3					68
5	3			3		15	use base 'Class::Accessor';
	3					2
	3					480
6
7	3			3		4774	use vars qw($VERSION);
	3					3
	3					785
8
9							$VERSION = '0.05';
10
11							=head1 NAME
12
13							HTTP::Request::FromTemplate - Create HTTP requests from templates
14
15							=head1 SYNOPSIS
16
17							use HTTP::Request::FromTemplate;
18							use LWP::UserAgent;
19
20							my $ua = LWP::UserAgent->new();
21
22							# A request, snarfed from your network monitor logs:
23							my $template = <
24							POST http://[% host %][% path %][% query %] HTTP/1.1
25							Host: [% host %]
26							Connection: keep-alive
27							Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7
28							Accept-Encoding: gzip,deflate
29							Accept-Language: en-us,en;q=0.5
30							User-Agent: QuickTime (qtver=5.0.2;os=Windows NT 5.1)
31							Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,/;q=0.5
32							Keep-Alive: 300
33							Referer: http://[% host %][% path %][% query %]
34
35							TEMPLATE
36							my $t = HTTP::Request::FromTemplate->new(template => $template);
37							my $req = $t->process({ 'host' => 'apple.com',
38							'path' => '/',
39							'query' => '?',
40							});
41							my $response = $ua->request($request); # replay the request
42
43							=head1 ABSTRACT
44
45							I wanted this for a long time already. It makes it very convenient
46							to just paste a logged session from the
47							L
48							into a template file and be able to faithfully replay a request
49							or to parametrize it without needing to manually compare what
50							is sent against what I want.
51
52							=head1 PREDEFINED TEMPLATE PARAMETERS
53
54							There is one predefined/magic template parameter. C
55							will be set to the length of the content (after the template has
56							been filled out) unless it was passed in via the template
57							parameters.
58
59							=head1 FEEDBACK
60
61							This is one of the modules that I created because the idea hit
62							me as crazy but useful. So if you use the module, please tell
63							me what enhancements you'd like, or where it falls short
64							of your expectations.
65
66							=head1 KNOWN BUGS
67
68							=over 4
69
70							=item * While this module tries to faithfully replicate a HTTP request
71							from a template, it uses L. This means that the order
72							of the headers will be as L thinks and not as your
73							template prescribes.
74
75							=item * Only rudimentary testing has been done.
76
77							=item * The test suite uses L, which uses L. I
78							know I will rot in hell for that, but it was so convenient at the time.
79
80							Patches are welcome.
81
82							=back
83
84							=head1 REPORTING BUGS
85
86							If you find bugs, please report them via
87							L
88							or, preferrably via mail to L.
89
90							=cut
91
92							__PACKAGE__->mk_accessors(qw(template tt));
93							our $content_length_cookie = __PACKAGE__ . "_content_length_cookie_";
94
95							sub new {
96	3			3	1	3	my $class = shift;
97	3					5	my %args;
98	3	50				8	if (@_ == 1) {
99	0					0	$args{template} = $_[0];
100							} else {
101	3					7	%args = @_;
102							};
103
104	3		50			52	$args{tt} \|\|= Template->new(delete $args{config} \|\| {});
			33
105
106	3					31715	return $class->SUPER::new(\%args);
107							};
108
109							sub process {
110	3			3	0	23	my ($self,$data) = @_;
111
112	3					3	my $replace_content_length_cookie;
113	3	50				8	if (not exists $data->{content_length}) {
114	3					17	$data->{content_length} = $content_length_cookie;
115	3					20	$replace_content_length_cookie = 1;
116							};
117
118	3					10	$self->tt->process($self->template,$data, \(my $output));
119
120							# This should also set the Content-Length properly.
121	3	50				41494	if ($replace_content_length_cookie) {
122	3	50				52	if ($output =~ m!^(.?)(?:\r?\n\r?\n)(.)\Z!sm) {
123							# We have content, so we should set the content length
124	3					5	my $content_length = length $2;
125	3					5	my $header_len = length $1;
126	3					33	substr($output,0,$header_len) =~ s!$content_length_cookie!$content_length!gms;
127							};
128							};
129
130							# This should also set/have a way for providing the Transfer-Encoding: chunked
131							# in a proper fashion
132
133	3					20	my $r = HTTP::Request->parse($output); # Wrong! This destroys the order of the headers :-(
134
135	3					11270	$r
136							};
137
138							1;
139
140							__END__