/usr/share/perl5/CGI/Test/Page/HTML.pm is in libcgi-test-perl 1.111-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 | package CGI::Test::Page::HTML;
use strict;
use warnings;
####################################################################
# $Id: HTML.pm 411 2011-09-26 11:19:30Z nohuhu@nohuhu.org $
# $Name: cgi-test_0-104_t1 $
####################################################################
#
# Copyright (c) 2001, Raphael Manfredi
#
# You may redistribute only under the terms of the Artistic License,
# as specified in the README file that comes with the distribution.
require CGI::Test::Page::Real;
use base qw(CGI::Test::Page::Real);
#
# ->new
#
# Creation routine
#
sub new
{
my $this = bless {}, shift;
$this->_init(@_);
return $this;
}
#
# Attribute access
#
sub tree
{
my $this = shift;
return $this->{tree} || $this->_build_tree();
}
sub forms
{
my $this = shift;
return $this->{forms} || $this->_xtract_forms();
}
sub form_count
{
my $this = shift;
$this->_xtract_forms() unless exists $this->{form_count};
return $this->{form_count};
}
#
# ->_build_tree
#
# Parse HTML content from `raw_content' into an HTML tree.
# Only called the first time an access to `tree' is requested.
#
# Returns constructed tree object.
#
sub _build_tree
{
my $this = shift;
require HTML::TreeBuilder;
my $tree = HTML::TreeBuilder->new();
$tree->ignore_unknown(0); # Keep everything, even unknown tags
$tree->store_comments(1); # Useful things may hide in "comments"
$tree->store_declarations(1); # Store everything that we may test
$tree->store_pis(1); # Idem
$tree->warn(1); # We want to know if there's a problem
$tree->parse($this->raw_content);
$tree->eof;
return $this->{tree} = $tree;
}
#
# _xtract_forms
#
# Extract <FORMS> tags out of the tree, and for each form, build a
# CGI::Test::Form object that represents it.
# Only called the first time an access to `forms' is requested.
#
# Side effect: updates the `forms' and `form_count' attributes.
#
# Returns list ref of objects, in the order they were found.
#
sub _xtract_forms
{
my $this = shift;
my $tree = $this->tree;
require CGI::Test::Form;
#
# The CGI::Test::Form objects we're about to create will refer back to
# us, because they are conceptually part of this page. Besides, their
# HTML tree is a direct reference into our own tree.
#
my @forms = $tree->look_down(sub {$_[ 0 ]->tag eq "form"});
@forms = map {CGI::Test::Form->new($_, $this)} @forms;
$this->{form_count} = scalar @forms;
return $this->{forms} = \@forms;
}
#
# ->delete
#
# Break circular references
#
sub delete
{
my $this = shift;
#
# The following attributes are "lazy", i.e. calculated on demand.
# Therefore, take precautions before de-referencing them.
#
$this->{tree} = $this->{tree}->delete if ref $this->{tree};
if (ref $this->{forms})
{
foreach my $form (@{$this->{forms}})
{
$form->delete;
}
delete $this->{forms};
}
$this->SUPER::delete;
return;
}
#
# (DESTROY)
#
# Dispose of HTML tree properly
#
sub DESTROY
{
my $this = shift;
return unless ref $this->{tree};
$this->{tree} = $this->{tree}->delete;
return;
}
1;
=head1 NAME
CGI::Test::Page::HTML - A HTML page reply
=head1 SYNOPSIS
# Inherits from CGI::Test::Page::Real
=head1 DESCRIPTION
This class represents an HTTP reply containing C<text/html> data.
When testing CGI scripts, this is usually what one gets back.
=head1 INTERFACE
The interface is the same as the one described in L<CGI::Test::Page::Real>,
with the following addition:
=over 4
=item C<tree>
Returns the root of the HTML tree of the page content, as an
HTML::Element node.
=back
=head1 AUTHORS
The original author is Raphael Manfredi.
Steven Hilton was long time maintainer of this module.
Current maintainer is Alexander Tokarev F<E<lt>tokarev@cpan.orgE<gt>>.
=head1 SEE ALSO
CGI::Test::Page::Real(3), HTML::Element(3).
=cut
|