#!/usr/bin/perl -w use strict; use HTML::Mason::Tests; { package HTML::Mason::Request::Test; @HTML::Mason::Request::Test::ISA = 'HTML::Mason::Request'; __PACKAGE__->valid_params( foo_val => { parse => 'string', type => Params::Validate::SCALAR } ); # shuts up 5.00503 warnings 1 if $HTML::Mason::ApacheHandler::VERSION; 1 if $HTML::Mason::CGIHandler::VERSION; sub new { my $class = shift; $class->alter_superclass( $HTML::Mason::ApacheHandler::VERSION ? 'HTML::Mason::Request::ApacheHandler' : $HTML::Mason::CGIHandler::VERSION ? 'HTML::Mason::Request::CGI' : 'HTML::Mason::Request' ); my $self = $class->SUPER::new(@_); } sub foo_val { $_[0]->{foo_val} } } { package HTML::Mason::Request::Test::Subclass; @HTML::Mason::Request::Test::Subclass::ISA = 'HTML::Mason::Request::Test'; __PACKAGE__->valid_params( bar_val => { parse => 'string', type => Params::Validate::SCALAR } ); sub bar_val { $_[0]->{bar_val} } } { package HTML::Mason::Lexer::Test; @HTML::Mason::Lexer::Test::ISA = 'HTML::Mason::Lexer'; __PACKAGE__->valid_params( bar_val => { parse => 'string', type => Params::Validate::SCALAR } ); sub bar_val { $_[0]->{bar_val} } } { package HTML::Mason::Compiler::ToObject::Test; @HTML::Mason::Compiler::ToObject::Test::ISA = 'HTML::Mason::Compiler::ToObject'; __PACKAGE__->valid_params( baz_val => { parse => 'string', type => Params::Validate::SCALAR } ); sub baz_val { $_[0]->{baz_val} } sub compiled_component { my $self = shift; my $comp = $self->SUPER::compiled_component(@_); $$comp =~ s/!!BAZ!!/$self->{baz_val}/g; return $comp; } } my $tests = make_tests(); $tests->run; sub make_tests { my $group = HTML::Mason::Tests->tests_class->new( name => 'subclass', description => 'Test use of subclasses for various core classes' ); #------------------------------------------------------------ $group->add_test( name => 'request_subclass', description => 'use a HTML::Mason::Request subclass', interp_params => { request_class => 'HTML::Mason::Request::Test', foo_val => 77 }, component => <<'EOF', % if ( $m->can('foo_val') ) { foo_val is <% $m->foo_val %> % } else { this request cannot ->foo_val! % } EOF expect => <<'EOF', foo_val is 77 EOF ); #------------------------------------------------------------ $group->add_test( name => 'request_subclass_of_subclass', description => 'use a HTML::Mason::Request grandchild', interp_params => { request_class => 'HTML::Mason::Request::Test::Subclass', foo_val => 77, bar_val => 42, }, component => <<'EOF', % if ( $m->can('foo_val') ) { foo_val is <% $m->foo_val %> % } else { this request cannot ->foo_val! % } % if ( $m->can('bar_val') ) { bar_val is <% $m->bar_val %> % } else { this request cannot ->bar_val! % } EOF expect => <<'EOF', foo_val is 77 bar_val is 42 EOF ); #------------------------------------------------------------ $group->add_test( name => 'lexer_subclass', description => 'use a HTML::Mason::Lexer subclass', interp_params => { lexer_class => 'HTML::Mason::Lexer::Test', bar_val => 76 }, component => <<'EOF', % my $lex = $m->interp->compiler->lexer; % if ( $lex->can('bar_val') ) { bar_val is <% $lex->bar_val %> % } else { this lexer cannot ->bar_val! % } EOF expect => <<'EOF', bar_val is 76 EOF ); #------------------------------------------------------------ # We don't use object files, because we want to catch the output # of compiled_component() instead of writing it to a file $group->add_test( name => 'compiler_subclass', description => 'use a HTML::Mason::Compiler subclass', interp_params => { compiler_class => 'HTML::Mason::Compiler::ToObject::Test', use_object_files => 0, baz_val => 75 }, component => <<'EOF', baz is !!BAZ!! EOF expect => <<'EOF', baz is 75 EOF ); #------------------------------------------------------------ return $group; }