File Coverage

blib/lib/CGI/Test/Page/Real.pm
Criterion Covered Total %
statement 38 39 97.4
branch 5 6 83.3
condition 1 2 50.0
subroutine 7 8 87.5
pod 1 2 50.0
total 52 57 91.2


line stmt bran cond sub pod time code
1             package CGI::Test::Page::Real;
2 16     16   91 use strict;
  16         795  
  16         863  
3 16     16   76 use warnings;
  16         25  
  16         456  
4             ####################################################################
5             # $Id: Real.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             # An abstract interface to a real page, which is the result of a valid output
16             # and not an HTTP error. The concrete representation is defined by heirs,
17             # depending on the Content-Type.
18             #
19              
20 16     16   64 use Carp;
  16         24  
  16         1499  
21              
22 16     16   77 use base qw(CGI::Test::Page);
  16         18  
  16         8304  
23              
24             #
25             # ->new
26             #
27             # Creation routine
28             #
29             sub new
30             {
31 0     0 0 0 confess "deferred";
32             }
33              
34             #
35             # Attribute access
36             #
37              
38             sub uri
39             {
40 19     19 1 24 my $this = shift;
41 19         50 return $this->{uri};
42             }
43              
44             #
45             # ->_init
46             #
47             # Initialize common attributes
48             #
49             sub _init
50             {
51 28     28   56 my $this = shift;
52              
53 28         238 my %params = @_;
54              
55 28         85 my $file = $params{-file};
56 28         210 $this->{server} = $params{-server};
57 28         94 $this->{content_type} = $params{-content_type};
58 28         74 $this->{user} = $params{-user};
59 28         62 $this->{uri} = $params{-uri};
60              
61 28         157 $this->_read_raw_content($file);
62              
63 28         103 return;
64             }
65              
66             #
67             # ->_read_raw_content
68             #
69             # Read file content verbatim into `raw_content', skipping header.
70             #
71             # Even in the case of an HTML content, reading the whole thing into memory
72             # as a big happy string means we can issue regexp queries.
73             #
74             sub _read_raw_content
75             {
76 28     28   48 my ($self, $file_name) = @_;
77              
78 28   50     935 open my $fh, $file_name || die "Can't open $file_name: $!";
79              
80 28         72 my %headers;
81             my $content_length;
82              
83 28         317 while (my $line = <$fh>) {
84 72 100       350 last if $line =~ /^\r?$/;
85              
86 44         186 $line =~ s/\r\n$//;
87              
88 44         241 my ($h, $v) = $line =~ /^(.*?):\s+(.*)$/;
89 44 50       169 $headers{ $h } = $v if defined $h;
90              
91 44 100       224 $content_length = $v if $h =~ /content[-_]length/i;
92             }
93              
94 28         85 $self->{headers} = \%headers;
95 28         66 $self->{content_length} = $content_length;
96              
97 28         168 local $/ = undef; # Will slurp remaining
98 28         488 $self->{raw_content} = <$fh>;
99 28         174 close $fh;
100              
101 28         159 return;
102             }
103              
104             1;
105              
106             =head1 NAME
107              
108             CGI::Test::Page::Real - Abstract representation of a real page
109              
110             =head1 SYNOPSIS
111              
112             # Inherits from CGI::Test::Page
113             # $page holds a CGI::Test::Page::Real object
114              
115             use CGI::Test;
116              
117             ok 1, $page->raw_content =~ /test is ok/;
118             ok 2, $page->uri->scheme eq "http";
119             ok 3, $page->content_type !~ /html/;
120              
121             =head1 DESCRIPTION
122              
123             This class is the representation of a real page, i.e. something physically
124             returned by the server and which is not an error.
125              
126             =head1 INTERFACE
127              
128             The interface is the same as the one described in L, with
129             the following additions:
130              
131             =over 4
132              
133             =item C
134              
135             Returns the raw content of the page, as a string.
136              
137             =item C
138              
139             Returns a reference to the raw content of the page, to avoid making yet
140             another copy.
141              
142             =item C
143              
144             The URI object, identifying the page we requested.
145              
146             =back
147              
148             =head1 AUTHORS
149              
150             The original author is Raphael Manfredi.
151              
152             Steven Hilton was long time maintainer of this module.
153              
154             Current maintainer is Alexander Tokarev Ftokarev@cpan.orgE>.
155              
156             =head1 SEE ALSO
157              
158             CGI::Test::Page(3), CGI::Test::Page::HTML(3), CGI::Test::Page::Other(3),
159             CGI::Test::Page::Text(3), URI(3).
160              
161             =cut
162