The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

package Mason::t::Plugins; ## no critic (Moose::RequireMakeImmutable)
$Mason::t::Plugins::VERSION = '2.23';
use Test::Class::Most parent => 'Mason::Test::Class';
use Capture::Tiny qw(capture_merged);
use Mason::Util qw(dump_one_line);
sub test_notify_plugin : Tests {
my $self = shift;
$self->setup_interp(
plugins => ['+Mason::Test::Plugins::Notify'],
no_source_line_numbers => 1,
);
$self->add_comp( path => '/test_plugin_support.mi', src => 'hi' );
my $output = capture_merged {
$self->test_comp(
path => '/test_plugin.mc',
src => '<& test_plugin_support.mi &>',
expect => 'hi'
);
};
my $like = sub { my $regex = shift; like( $output, $regex, $regex ) };
$like->(qr/starting interp run/);
$like->(qr/starting request run - \/test_plugin/);
$like->(qr/starting request comp - test_plugin_support.mi/);
$like->(qr/starting compilation parse - \/test_plugin.mc/);
}
# Call Mason::Test::RootClass->new, then make base classes like
# Mason::Test::RootClass::Interp are used automatically
#
sub test_notify_root_class : Tests {
my $self = shift;
my $mrc = 'Mason::Test::RootClass';
$self->setup_interp( mason_root_class => $mrc );
is( $self->interp->mason_root_class, $mrc, "mason_root_class" );
is( $self->interp->base_compilation_class, "${mrc}::Compilation", "base_compilation_class" );
is( $self->interp->base_component_class, "${mrc}::Component", "base_component_class" );
is( $self->interp->base_request_class, "${mrc}::Request", "base_request_class" );
is( $self->interp->base_result_class, "Mason::Result", "base_result_class" );
isa_ok( $self->interp, "${mrc}::Interp", "base_interp_class" );
$self->add_comp( path => '/test_plugin_support.mi', src => 'hi' );
my $output = capture_merged {
$self->test_comp(
path => '/test_plugin.mc',
src => '<& test_plugin_support.mi &>',
expect => 'hi'
);
};
my $like = sub { my $regex = shift; like( $output, $regex, $regex ) };
$like->(qr/starting interp run/);
$like->(qr/starting request run - \/test_plugin/);
$like->(qr/starting request comp - test_plugin_support.mi/);
$like->(qr/starting compilation parse - \/test_plugin.mc/);
}
sub test_strict_plugin : Tests {
my $self = shift;
$self->setup_interp(
base_component_moose_class => 'Mason::Test::Overrides::Component::StrictMoose', );
$self->add_comp( path => '/test_strict_plugin.mc', src => 'hi' );
lives_ok { $self->interp->run('/test_strict_plugin') };
throws_ok { $self->interp->run( '/test_strict_plugin', foo => 5 ) } qr/Found unknown attribute/;
}
{
$Mason::Test::Plugins::A::VERSION = '2.23';
use Moose;
with 'Mason::Plugin';
}
{
$Mason::Plugin::B::VERSION = '2.23';
use Moose;
with 'Mason::Plugin';
}
{
$Mason::Plugin::C::VERSION = '2.23';
use Moose;
with 'Mason::Plugin';
}
{
$Mason::Plugin::D::VERSION = '2.23';
use Moose;
with 'Mason::Plugin';
}
{
$Mason::Plugin::E::VERSION = '2.23';
use Moose;
with 'Mason::Plugin';
}
{
$Mason::PluginBundle::F::VERSION = '2.23';
use Moose;
sub requires_plugins { return qw(C D) }
}
{
$Mason::Test::PluginBundle::G::VERSION = '2.23';
use Moose;
sub requires_plugins { return qw(C E) }
}
{
$Mason::Plugin::H::VERSION = '2.23';
use Moose;
with 'Mason::Plugin';
sub requires_plugins { return qw(@F) }
}
{
$Mason::PluginBundle::I::VERSION = '2.23';
use Moose;
sub requires_plugins {
return ( '+Mason::Test::Plugins::A', 'B', '@F', '+Mason::Test::PluginBundle::G', );
}
}
{
$Mason::PluginBundle::J::VERSION = '2.23';
use Moose;
sub requires_plugins {
return ('@I');
}
}
sub test_plugin_specs : Tests {
my $self = shift;
my @default_plugins = Mason::PluginBundle::Default->requires_plugins
or die "no default plugins";
my $test = sub {
my ( $plugin_list, $expected_plugins ) = @_;
my $interp = Mason->new( comp_root => $self->comp_root, plugins => $plugin_list );
my $got_plugins =
[ map { /Mason::Plugin::/ ? substr( $_, 15 ) : $_ } @{ $interp->plugins } ];
cmp_deeply(
$got_plugins,
[ @$expected_plugins, @default_plugins ],
dump_one_line($plugin_list)
);
};
$test->( [], [] );
$test->( ['E'], ['E'] );
$test->( ['H'], [ 'H', 'C', 'D' ] );
$test->( ['@F'], [ 'C', 'D' ] );
$test->( ['@I'], [ 'Mason::Test::Plugins::A', 'B', 'C', 'D', 'E' ] );
$test->( [ '-C', '@I', '-+Mason::Test::Plugins::A' ], [ 'B', 'D', 'E' ] );
$test->( [ '-@I', '@J' ], [] );
throws_ok { $test->( ['@X'] ) } qr/could not load 'Mason::PluginBundle::X'/;
throws_ok { $test->( ['Y'] ) } qr/could not load 'Mason::Plugin::Y'/;
}
{
$Mason::Test::Plugins::Upper::VERSION = '2.23';
use Moose;
}
{
$Mason::Test::Plugins::Upper::Request::VERSION = '2.23';
after 'process_output' => sub {
my ( $self, $bufref ) = @_;
$$bufref = uc($$bufref);
};
}
sub test_process_output_plugin : Tests {
my $self = shift;
$self->setup_interp( plugins => ['+Mason::Test::Plugins::Upper'] );
$self->test_comp( src => 'Hello', expect => 'HELLO' );
}
1;