File Coverage

blib/lib/HTTP/WebTest/Plugin/Hooks.pm
Criterion Covered Total %
statement 36 37 97.3
branch 7 8 87.5
condition n/a
subroutine 9 9 100.0
pod 1 6 16.6
total 53 60 88.3


line stmt bran cond sub pod time code
1             # $Id: Hooks.pm,v 1.11 2003/03/02 11:52:09 m_ilya Exp $
2              
3             package HTTP::WebTest::Plugin::Hooks;
4              
5             =head1 NAME
6              
7             HTTP::WebTest::Plugin::Hooks - Provides callbacks called during test run
8              
9             =head1 SYNOPSIS
10              
11             plugins = ( ::Hooks )
12              
13             # do some test sequence initialization
14             on_start = { My::init() }
15              
16             # do some test sequence deinitialization
17             on_finish = { My::stop() }
18              
19             test_name = Name1
20             ....
21             # do some test initialization
22             on_request = { My::local_init() }
23             end_test
24              
25             test_name = Name2
26             ....
27             # define custom test
28             on_response = ( { My::test() ? 'yes' : 'no' } => 'My test' )
29             end_test
30              
31             test_name = Name3
32             ....
33             # call finalization code with returning any test results
34             on_response = { My::finalize(); return [] }
35             end_test
36              
37             =head1 DESCRIPTION
38              
39             This plugin module adds test parameters whose values are evaluated at
40             specific times of the L test run. It can be
41             used to do some initialization before doing test request, to do some
42             finalization when test response is received or to implement user
43             defined tests without writing a new plugin module.
44              
45             =cut
46              
47 1     1   5 use strict;
  1         3  
  1         39  
48 1     1   5 use URI;
  1         2  
  1         27  
49              
50 1     1   5 use base qw(HTTP::WebTest::Plugin);
  1         2  
  1         557  
51              
52             =head1 TEST PARAMETERS
53              
54             =for pod_merge copy opt_params
55              
56             =head2 on_start
57              
58             The value of this test parameter is ignored. However, it is evaluted
59             before the test sequence is run, so it can be used to do initalization
60             before the test sequence run.
61              
62             =head3 Example
63              
64             See example in L.
65              
66             =head2 on_finish
67              
68             The value of this test parameter is ignored. However, it is evaluted
69             before the test sequence is run, so it can be used to run finalization
70             code when the test sequence is finished.
71              
72             =head3 Example
73              
74             See example in L.
75              
76             =head2 on_request
77              
78             The value of this test parameter is ignored. However, it is evaluted
79             before the HTTP request is done, so it can be used to do
80             initalization before the request.
81              
82             =head2 on_response
83              
84             This is a list parameter which is treated as test result. It is
85             evaluted when the HTTP response for the test request is received.
86              
87             It can be used to define custom tests without writing new plugins.
88             It can also be used to run some code when the HTTP response for the test
89             request is received.
90              
91             =head3 Allowed values
92              
93             ( YESNO1, COMMENT1
94             YESNO2, COMMENT2
95             ....
96             YESNON, COMMENTN )
97              
98             Here C, C is a test result. C is either
99             C if test is successful or C if it is not. C is a
100             comment associated with this test.
101              
102             =head3 Example
103              
104             See example in L.
105              
106             =cut
107              
108             sub param_types {
109 38     38 1 513 return q(on_start anything
110             on_request anything
111             on_response test_results
112             on_finish anything);
113             }
114              
115             # implements check for parameter type 'test_results'
116             sub check_test_results {
117 6     6 0 14 my $self = shift;
118 6         15 my $param = shift;
119 6         13 my $value = shift;
120 6         13 my @spec = @_;
121              
122             # first of all check if it is a list
123 6         43 $self->check_list($param, $value);
124              
125             # check if it has even number of elements
126 6 50       33 unless(@$value % 2 == 0) {
127 0         0 die "HTTP::WebTest: parameter '$param' is not a list with even number of elements";
128             }
129              
130 6         77 for my $i (0 .. @$value / 2 - 1) {
131 4         22 my ($ok, $comment) = @$value[2 * $i, 2 * $i + 1];
132 4         34 $self->validate_value("$param\[$i]", $ok, 'yesno');
133 4         27 $self->validate_value("$param\[" . ($i + 1) . "]", $ok, 'scalar');
134             }
135             }
136              
137             sub start_tests {
138 7     7 0 110 my $self = shift;
139              
140             # both checks and evaluates test parameter
141 7         30 $self->validate_params(qw(on_start));
142             }
143              
144             sub end_tests {
145 7     7 0 10 my $self = shift;
146              
147             # both checks and evaluates test parameter
148 7         26 $self->validate_params(qw(on_finish));
149             }
150              
151             sub prepare_request {
152 12     12 0 23 my $self = shift;
153              
154             # both checks and evaluates test parameter
155 12         38 $self->validate_params(qw(on_request));
156             }
157              
158             sub check_response {
159 12     12 0 26 my $self = shift;
160              
161 12         38 $self->validate_params(qw(on_response));
162              
163 12         53 my $results = $self->test_param('on_response');
164              
165 12 100       40 if(defined $results) {
166 6         14 my @results = ();
167 6         22 for my $i (0 .. @$results / 2 - 1) {
168 4         15 my ($ok, $comment) = @$results[2 * $i, 2 * $i + 1];
169 4 100       35 push @results, $self->test_result($ok =~ /yes/i ? 1 : 0, $comment);
170             }
171              
172 6 100       37 return ['User defined tests', @results] if @results;
173             }
174              
175 9         48 return [];
176             }
177              
178             =head1 COPYRIGHT
179              
180             Copyright (c) 2001-2003 Ilya Martynov. All rights reserved.
181              
182             This program is free software; you can redistribute it and/or modify
183             it under the same terms as Perl itself.
184              
185             =head1 SEE ALSO
186              
187             L
188              
189             L
190              
191             L
192              
193             L
194              
195             =cut
196              
197             1;