#!perl -w # $Id: 07combined.t 682 2004-09-28 05:59:10Z theory $ use strict; use FindBin qw($Bin); use File::Spec::Functions qw(catdir catfile); use Test::More; use HTML::Mason::Interp; my $base_key = 'OOTester'; my $comp = '/dhandler'; ############################################################################## # Figure out if the current configuration can handle OO callbacks. BEGIN { plan skip_all => 'Object-oriented callbacks require Perl 5.6.0 or later' if $] < 5.006; plan skip_all => 'Attribute::Handlers and Class::ISA required for' . ' object-oriented callbacks' unless eval { require Attribute::Handlers } and eval { require Class::ISA }; plan tests => 16; } ############################################################################## # Set up the callback class. ############################################################################## package Params::Callback::TestObjects; use strict; use base 'Params::Callback'; __PACKAGE__->register_subclass( class_key => $base_key); use Params::CallbackRequest::Exceptions abbr => [qw(throw_cb_exec)]; sub simple : Callback { my $self = shift; main::isa_ok($self, 'Params::Callback'); main::isa_ok($self, __PACKAGE__); my $params = $self->params; $params->{result} = 'Simple Success'; } sub lowerit : PostCallback { my $self = shift; my $params = $self->params; if ($params->{do_lower}) { main::isa_ok($self, 'Params::Callback'); main::isa_ok($self, __PACKAGE__); $params->{result} = lc $params->{result}; } } 1; ############################################################################## # Set up another callback class to test the default class key. package Params::Callback::TestKey; use strict; use base 'Params::Callback'; __PACKAGE__->register_subclass; sub my_key : Callback { my $self = shift; main::is($self->pkg_key, __PACKAGE__, "Check package key" ); main::is($self->class_key, __PACKAGE__, "Check class key" ); } ############################################################################## # Back in the real world... ############################################################################## package main; use strict; use_ok('MasonX::Interp::WithCallbacks'); ############################################################################## # Set up a functional callback we can use. sub another { my $cb = shift; main::isa_ok($cb, 'Params::Callback'); my $params = $cb->params; $params->{result} = 'Another Success'; } ############################################################################## # And a functional request callback. sub presto { my $cb = shift; main::isa_ok($cb, 'Params::Callback'); my $params = $cb->params; $params->{result} = 'PRESTO' if $params->{do_presto}; } ############################################################################## # Construct the combined callback exec object. my $outbuf; ok( my $interp = MasonX::Interp::WithCallbacks->new (comp_root => catdir($Bin, qw(htdocs)), out_method => \$outbuf, callbacks => [{ pkg_key => 'foo', cb_key => 'another', cb => \&another}], cb_classes => 'ALL', pre_callbacks => [\&presto] ), "Construct combined CBExec object" ); ############################################################################## # Make sure the functional callback works. $interp->exec($comp, 'foo|another_cb' => 1); is( $outbuf, 'Another Success', "Check functional result" ); $outbuf = ''; ############################################################################## # Make sure OO callback works. $interp->exec($comp, "$base_key|simple_cb" => 1); is( $outbuf, 'Simple Success', "Check OO result" ); $outbuf = ''; ############################################################################## # Make sure that functional and OO request callbacks execute, too. $interp->exec($comp, do_lower => 1, do_presto => 1); is( $outbuf, 'presto', "Check request result" ); $outbuf = ''; ############################################################################## # Make sure that the default class key is the class name. $interp->exec($comp, "Params::Callback::TestKey|my_key_cb" => 1); $outbuf = ''; 1; __END__