File Coverage

blib/lib/CGI/Test/Page.pm
Criterion Covered Total %
statement 40 44 90.9
branch 2 2 100.0
condition 1 2 50.0
subroutine 15 18 83.3
pod 9 15 60.0
total 67 81 82.7


line stmt bran cond sub pod time code
1             package CGI::Test::Page;
2 23     23   92 use strict;
  23         23  
  23         550  
3 23     23   69 use warnings;
  23         18  
  23         582  
4             ####################################################################
5             # $Id: Page.pm 411 2011-09-26 11:19:30Z nohuhu@nohuhu.org $
6             # $Name: cgi-test_0-104_t1 $
7             ####################################################################
8             #
9             # Copyright (c) 2001, Raphael Manfredi
10             #
11             # You may redistribute only under the terms of the Artistic License,
12             # as specified in the README file that comes with the distribution.
13             #
14              
15             #
16             # An abstract representation of a page, returned by an HTTP request.
17             # The page can be an error, or a real page, each with its own class hierarchy.
18             #
19              
20 23     23   69 use Carp;
  23         16  
  23         7508  
21              
22             ######################################################################
23             #
24             # ->new
25             #
26             # Creation routine
27             #
28             ######################################################################
29             sub new
30             {
31 0     0 0 0 confess "deferred";
32             }
33              
34             #
35             # Common attribute access
36             #
37              
38             sub raw_content {
39 28     28 0 158 my ($self) = @_;
40              
41 28         361 return $self->{raw_content};
42             }
43              
44             sub raw_content_ref {
45 3     3 0 27 my ($self) = @_;
46              
47 3         23 return \$self->{raw_content};
48             }
49              
50             sub headers {
51 3     3 0 277 my ($self) = @_;
52              
53 3   50     15 return $self->{headers} || {};
54             }
55              
56             sub header {
57 2     2 0 621 my ($self, $hdr) = @_;
58              
59 2         2 my %header = %{ $self->headers };
  2         4  
60              
61 2         2 my $value;
62              
63 2         4 $hdr = lc $hdr;
64              
65             # We're not concerned with performance here and would rather save
66             # the original headers as they were; hence searching instead of
67             # lowercasing header keys in _read_raw_content.
68 2         6 while ( my ($k, $v) = each %header ) {
69 4 100       11 if ( $hdr eq lc $k ) {
70 2         3 $value = $v;
71 2         2 last;
72             }
73             }
74              
75 2         6 return $value;
76             }
77              
78             ######################################################################
79             sub content_length
80             {
81 1     1 0 2 my $this = shift;
82 1         7 return $this->{content_length};
83             }
84              
85             ######################################################################
86             sub content_type
87             {
88 1     1 1 291 my $this = shift;
89 1         6 $this->{content_type};
90             }
91              
92             ######################################################################
93             sub user
94             {
95 19     19 1 116 my $this = shift;
96 19         111 $this->{user};
97             }
98              
99             ######################################################################
100             sub server
101             {
102 19     19 1 36 my $this = shift;
103 19         46 return $this->{server};
104             }
105             ######################################################################
106              
107             #
108             # Queries
109             #
110              
111             ######################################################################
112             # Error code (0 = OK)
113             ######################################################################
114             sub error_code
115             {
116 9     9 1 68 0
117             }
118              
119             ######################################################################
120             # True if page indicates HTTP error
121             ######################################################################
122             sub is_error
123             {
124 20     20 1 218 0
125             }
126              
127             ######################################################################
128             sub form_count
129             {
130 0     0 1 0 0
131             }
132              
133             ######################################################################
134             sub is_ok
135             {
136 11     11 1 137 my $this = shift;
137 11         100 return !$this->is_error;
138             }
139              
140             ######################################################################
141             #
142             # ->forms
143             #
144             # Returns list ref of CGI::Test::Form objects, one per
in the
145             # document. The order is the same as the one in the raw document.
146             #
147             # Meant to be redefined in CGI::Test::Page::HTML.
148             #
149             ######################################################################
150             sub forms
151             {
152 0     0 1 0 my $this = shift;
153 0         0 return [];
154             }
155              
156             ######################################################################
157             #
158             # ->delete
159             #
160             # Done with this page, cleanup by breaking circular refs.
161             #
162             ######################################################################
163             sub delete
164             {
165 3     3 1 362 my $this = shift;
166 3         4 $this->{server} = undef;
167 3         5 return;
168             }
169              
170             1;
171              
172             =head1 NAME
173              
174             CGI::Test::Page - Abstract represention of an HTTP reply content
175              
176             =head1 SYNOPSIS
177              
178             # Deferred class, only heirs can be created
179             # $page holds a CGI::Test::Page object
180              
181             use CGI::Test;
182              
183             ok 1, $page->is_ok;
184             ok 2, $page->user ne ''; # authenticated access
185              
186             my $ctype = $page->content_type;
187             ok 3, $ctype eq "text/plain";
188              
189             $page->delete;
190              
191             =head1 DESCRIPTION
192              
193             The C class is deferred. It is an abstract representation
194             of an HTTP reply content, which would be displayed on a browser, as a page.
195             It does not necessarily hold HTML content.
196              
197             Here is an outline of the class hierarchy tree, with the leading C
198             string stripped for readability, and a trailing C<*> indicating deferred
199             clases:
200              
201             Page*
202             Page::Error
203             Page::Real*
204             Page::HTML
205             Page::Other
206             Page::Text
207              
208             Those classes are constructed as needed by C. You must always
209             call I on them to break the circular references if you care about
210             reclaiming unused memory.
211              
212             =head1 INTERFACE
213              
214             This is the interface defined at the C level.
215             Each subclass may add further specific features, but the following is
216             available to the whole hierarchy:
217              
218             =over 4
219              
220             =item C
221              
222             The MIME content type, along with parameters, as it appeared in the headers.
223             For instance, it can be:
224              
225             text/html; charset=ISO-8859-1
226              
227             Don't assume it to be just C though. Use something like:
228              
229             ok 1, $page->content_type =~ m|^text/html\b|;
230              
231             in your regression tests, which will match whether there are parameters
232             following the content type or not.
233              
234             =item C
235              
236             Breaks circular references to allow proper reclaiming of unused memory.
237             Must be the last thing to call on the object before forgetting about it.
238              
239             =item C
240              
241             The error code. Will be 0 to mean OK, but otherwise HTTP error codes
242             are used, as described by L.
243              
244             =item C
245              
246             Returns a list reference containing all the CGI forms on the page,
247             as C objects. Will be an empty list for anything
248             but C, naturally.
249              
250             =item C
251              
252             The amount of forms held in the C list.
253              
254             =item C
255              
256             Returns I when the page indicates an HTTP error.
257              
258             =item C
259              
260             Returns I when the page is not the result of an HTTP error.
261              
262             =item C
263              
264             Returns the server object that returned the page. Currently, this is
265             the C object, but it might change one day. In any case, this
266             is the place where GET/POST requests may be addresed.
267              
268             =item C
269              
270             The authenticated user that requested this page, or C if no
271             authentication was made.
272              
273             =back
274              
275             =head1 AUTHORS
276              
277             The original author is Raphael Manfredi.
278              
279             Steven Hilton was long time maintainer of this module.
280              
281             Current maintainer is Alexander Tokarev Ftokarev@cpan.orgE>.
282              
283             =head1 SEE ALSO
284              
285             CGI::Test::Page::Error(3), CGI::Test::Page::Real(3).
286              
287             =cut
288