webgui/t/lib/WebGUI/Test/Maker/HTML.pm

256 lines
5.5 KiB
Perl

package WebGUI::Test::Maker::HTML;
use base 'WebGUI::Test::Maker';
use Scalar::Util qw( blessed );
use Carp qw( croak );
use Test::More;
=head1 NAME
WebGUI::Test::Maker::HTML -- Test::Maker subclass for WebGUI HTMLs
=head1 SYNOPSIS
use Test::More;
use WebGUI::Test::Maker::HTML;
my $maker = WebGUI::Test::Maker::HTML->new();
$maker->prepare({
object => $object,
method => "www_editSave",
user => WebGUI::User->new,
userId => "userId",
formParams => { ... },
uploads => { ... },
# Test for a WebGUI::Session::Privilege page
test_privilege => "permission",
# Test for some regular expressions
test_regex => [ qr/../, qr/.../, ... ],
});
plan tests => $maker->plan;
$maker->run;
=head1 DESCRIPTION
This Test::Maker subclass tests the HTML output by WebGUI methods in a
variety of ways.
Uses WebGUI::Test->getPage to get the HTML for a page, and so is limited
to whatever C<getPage> can access.
=head1 TODO
Provide a method to give a proper HTML::Parser to test with.
Provide a method to test that a certain page was created with a certain
template.
=head1 DEPENDS
This module depends on
=over 4
=item *
Test::More
=back
=head1 METHODS
=head2 new
Create a new WebGUI::Test::Maker::HTML object.
=head2 get
Get a setting. Set L<set> for a list of settings.
=cut
#----------------------------------------------------------------------------
=head2 plan
This module plans as follows:
- 1 and only 1 test for any test_privilege test
- 1 test for each member of a test_regex test
=cut
sub plan {
my $self = shift;
my $plan;
for my $test ( @{ $self->{_tests} } ) {
if ($test->{test_privilege}) {
$plan++;
next;
}
if ($test->{test_regex}) {
$plan += @{$test->{test_regex}};
}
}
return $plan;
}
#----------------------------------------------------------------------------
=head2 plan_per_test
Returns undef. There is no way to pre-calculate how many tests this will run
=cut
sub plan_per_test {
return undef;
}
#----------------------------------------------------------------------------
=head2 prepare
Prepare a test(s). Returns the object for convenience. The following keys
are required:
=over 4
=item object
An instanciated object to work on.
=item method
The permissions method to test
=back
At least one of the following keys are required:
=over 4
=item test_privilege
Tests for a WebGUI::Session::Privilege response. Valid values for this key
are: adminOnly, insufficient, noAccess, notMember, vitalComponent
=item test_regex
Tests for some regular expressions. This key must be an array reference of
qr().
=back
The following key are optional:
=over 4
=item user
A WebGUI::User object to use for the test.
=item userId
A user ID to make a WebGUI::User object to use for the test
=item formParams
A hash reference of form parameters to use for the test
=item uploads
A hash reference of file uploads to use for the test
=back
=cut
sub prepare {
my $self = shift;
my @tests = @_;
my $test_num = 0;
for my $test (@tests) {
$test_num++;
croak("Couldn't prepare: Test $test_num has no object")
unless $test->{object};
croak("Couldn't prepare: Test $test_num has no method")
unless $test->{method};
croak("Couldn't prepare: Test $test_num has test (test_privilege or test_regex)")
unless $test->{test_privilege} || $test->{test_regex};
croak("Couldn't prepare: Test $test_num, test_regex is not an array reference")
if $test->{test_regex} && ref $test->{test_regex} ne "ARRAY";
croak("Couldn't prepare: Test $test_num, $test->{test_privilege} is not a valid test_privilege value (adminOnly, insufficient, noAccess, notMember, vitalComponent)")
if $test->{test_privilege} && $test->{test_privilege} !~ m/adminOnly|insufficient|noAccess|notMember|vitalComponent/;
push @{$self->{_tests}}, $test;
}
return $self;
}
#----------------------------------------------------------------------------
=head2 run
Run the tests we've prepared and delete them as we run them.
=cut
sub run {
my $self = shift;
# This is to fix detection of SKIP and TODO
local $Test::Builder::Level = $Test::Builder::Level + 1;
while (my $test = shift @{ $self->{_tests} }) {
my $o = $test->{object};
my $m = $test->{method};
# Get the HTML
my $opts = {};
for my $key (qw{ }) {
$opts->{$key} = $test->{$key};
}
my $html
= WebGUI::Test->getPage( $o, $m, $opts );
# Run the tests
if ($test->{test_privilege}) {
my $priv_method = $test->{test_privilege};
my $test = $o->session->privilege->$priv_method();
like( $html, $test, "$m contains privilege message $priv_method for object " . blessed $o );
next;
}
if ($test->{test_regex}) {
for my $regex ( @{ $test->{test_regex} } ) {
like( $html, $regex, "$m contains $regex for object " . blessed $o );
}
}
}
}
#----------------------------------------------------------------------------
=head2 set
Set a setting.
Currently this module has no settings
=cut
1;