Implement automatic role loading for script classes.
[catagits/Catalyst-Runtime.git] / lib / Catalyst / ScriptRunner.pm
1 package Catalyst::ScriptRunner;
2 use Moose;
3 use FindBin;
4 use lib;
5 use File::Spec;
6 use namespace::autoclean -also => 'subclass_with_traits';
7 use Try::Tiny;
8
9 sub find_script_class {
10     my ($self, $app, $script) = @_;
11     my $class = "${app}::Script::${script}";
12
13     try {
14         Class::MOP::load_class($class);
15     }
16     catch {
17         confess $_ unless /Can't locate/;
18         $class = "Catalyst::Script::$script";
19     };
20
21     Class::MOP::load_class($class);
22     return $class;
23 }
24
25 sub find_script_traits {
26     my ($self, @try) = @_;
27
28     my @traits;
29     for my $try (@try) {
30         try {
31             Class::MOP::load_class($try);
32             push @traits, $try;
33         }
34         catch {
35             confess $_ unless /^Can't locate/;
36         };
37     }
38
39     return @traits;
40 }
41
42 sub subclass_with_traits {
43     my ($base, @traits) = @_;
44
45     my $meta = Class::MOP::class_of($base)->create_anon_class(
46         superclasses => [ $base   ],
47         roles        => [ @traits ],
48         cache        => 1,
49     );
50     $meta->add_method(meta => sub { $meta });
51
52     return $meta->name;
53 }
54
55 sub run {
56     my ($self, $appclass, $scriptclass) = @_;
57
58     lib->import(File::Spec->catdir($FindBin::Bin, '..', 'lib'));
59
60     my $class = $self->find_script_class($appclass, $scriptclass);
61
62     my @possible_traits = ("${appclass}::TraitFor::Script::${scriptclass}", "${appclass}::TraitFor::Script");
63     my @traits = $self->find_script_traits(@possible_traits);
64
65     $class = subclass_with_traits($class, @traits)
66         if @traits;
67
68     $class->new_with_options( application_name => $appclass )->run;
69 }
70
71 __PACKAGE__->meta->make_immutable;
72
73 =head1 NAME
74
75 Catalyst::ScriptRunner - The Catalyst Framework script runner
76
77 =head1 SYNOPSIS
78
79     # Will run MyApp::Script::Server if it exists, otherwise
80     # will run Catalyst::Script::Server.
81     Catalyst::ScriptRunner->run('MyApp', 'Server');
82
83 =head1 DESCRIPTION
84
85 This class is responsible for running scripts, either in the application specific namespace
86 (e.g. C<MyApp::Script::Server>), or the Catalyst namespace (e.g. C<Catalyst::Script::Server>)
87
88 =head1 METHODS
89
90 =head2 run ($application_class, $scriptclass)
91
92 Called with two parameters, the application class (e.g. MyApp)
93 and the script class, (i.e. one of Server/FastCGI/CGI/Create/Test)
94
95 =head1 AUTHORS
96
97 Catalyst Contributors, see Catalyst.pm
98
99 =head1 COPYRIGHT
100
101 This library is free software. You can redistribute it and/or modify it under
102 the same terms as Perl itself.
103
104 =cut