use FindBin;
use lib;
use File::Spec;
-use namespace::autoclean;
+use namespace::autoclean -also => 'subclass_with_traits';
+use Try::Tiny;
+
+sub find_script_class {
+ my ($self, $app, $script) = @_;
+ my $class = "${app}::Script::${script}";
+
+ try {
+ Class::MOP::load_class($class);
+ }
+ catch {
+ confess $_ unless /Can't locate/;
+ $class = "Catalyst::Script::$script";
+ };
+
+ Class::MOP::load_class($class);
+ return $class;
+}
+
+sub find_script_traits {
+ my ($self, @try) = @_;
+
+ my @traits;
+ for my $try (@try) {
+ try {
+ Class::MOP::load_class($try);
+ push @traits, $try;
+ }
+ catch {
+ confess $_ unless /^Can't locate/;
+ };
+ }
+
+ return @traits;
+}
+
+sub subclass_with_traits {
+ my ($base, @traits) = @_;
+
+ my $meta = Class::MOP::class_of($base)->create_anon_class(
+ superclasses => [ $base ],
+ roles => [ @traits ],
+ cache => 1,
+ );
+ $meta->add_method(meta => sub { $meta });
+
+ return $meta->name;
+}
sub run {
- my ($self, $class, $scriptclass, %args) = @_;
- my $classtoload = "${class}::Script::$scriptclass";
+ my ($self, $appclass, $scriptclass) = @_;
lib->import(File::Spec->catdir($FindBin::Bin, '..', 'lib'));
- unless ( eval { Class::MOP::load_class($classtoload) } ) {
- warn("Could not load $classtoload - falling back to Catalyst::Script::$scriptclass : $@\n")
- if $@ !~ /Can't locate/;
- $classtoload = "Catalyst::Script::$scriptclass";
- Class::MOP::load_class($classtoload);
- }
- $classtoload->new_with_options( application_name => $class, %args )->run;
+ my $class = $self->find_script_class($appclass, $scriptclass);
+
+ my @possible_traits = ("${appclass}::TraitFor::Script::${scriptclass}", "${appclass}::TraitFor::Script");
+ my @traits = $self->find_script_traits(@possible_traits);
+
+ $class = subclass_with_traits($class, @traits)
+ if @traits;
+
+ $class->new_with_options( application_name => $appclass )->run;
}
__PACKAGE__->meta->make_immutable;
use warnings;
use Test::More;
use FindBin qw/$Bin/;
+use Test::Exception;
use lib "$Bin/../lib";
use_ok('Catalyst::ScriptRunner');
-is Catalyst::ScriptRunner->run('ScriptTestApp', 'Foo'), 'ScriptTestApp::Script::Foo',
- 'Script existing only in app';
-is Catalyst::ScriptRunner->run('ScriptTestApp', 'Bar'), 'ScriptTestApp::Script::Bar',
+is Catalyst::ScriptRunner->run('ScriptTestApp', 'Foo'), 'mooScriptTestApp::Script::Foo42',
+ 'Script existing only in app got trait applied';
+is Catalyst::ScriptRunner->run('ScriptTestApp', 'Bar'), 'mooScriptTestApp::Script::Bar23',
'Script existing in both app and Catalyst - prefers app';
-is Catalyst::ScriptRunner->run('ScriptTestApp', 'Baz'), 'Catalyst::Script::Baz',
+is Catalyst::ScriptRunner->run('ScriptTestApp', 'Baz'), 'mooCatalyst::Script::Baz',
'Script existing only in Catalyst';
# +1 test for the params passed to new_with_options in t/lib/Catalyst/Script/Baz.pm
-{
- my $warnings = '';
- local $SIG{__WARN__} = sub { $warnings .= shift };
- is 'Catalyst::Script::CompileTest', Catalyst::ScriptRunner->run('ScriptTestApp', 'CompileTest');
- like $warnings, qr/Does not compile/;
- like $warnings, qr/Could not load ScriptTestApp::Script::CompileTest - falling back to Catalyst::Script::CompileTest/;
-}
+
+throws_ok(sub {
+ Catalyst::ScriptRunner->run('ScriptTestApp', 'CompileTest');
+}, qr/Couldn't load class/);
done_testing;
--- /dev/null
+package ScriptTestApp::TraitFor::Script;
+use Moose::Role;
+use namespace::autoclean;
+
+around run => sub {
+ my ($orig, $self, @args) = @_;
+ return 'moo' . $self->$orig(@args);
+};
+
+1;
--- /dev/null
+package ScriptTestApp::TraitFor::Script::Bar;
+use Moose::Role;
+use namespace::autoclean;
+
+around run => sub {
+ my ($orig, $self, @args) = @_;
+ return $self->$orig(@args) . '23';
+};
+
+1;
--- /dev/null
+package ScriptTestApp::TraitFor::Script::Foo;
+use Moose::Role;
+use namespace::autoclean;
+
+around run => sub {
+ my ($orig, $self, @args) = @_;
+ return $self->$orig(@args) . '42';
+};
+
+1;