Commit | Line | Data |
c527660e |
1 | package MooseX::Runnable::Invocation; |
2 | use Moose; |
3 | use MooseX::Types -declare => ['RunnableClass']; |
a19e41e3 |
4 | use MooseX::Types::Moose qw(Str HashRef ArrayRef); |
6568c67d |
5 | use List::MoreUtils qw(uniq); |
19241782 |
6 | use Params::Util qw(_CLASS); |
7da369ca |
7 | use Module::Runtime 'use_module'; |
d60733e4 |
8 | use namespace::autoclean; |
c527660e |
9 | |
c527660e |
10 | # we can't load the class until plugins are loaded, |
11 | # so we have to handle this outside of coerce |
12 | |
13 | subtype RunnableClass, |
14 | as Str, |
19241782 |
15 | where { _CLASS($_) }; |
c527660e |
16 | |
c527660e |
17 | |
e8020e5e |
18 | with 'MooseX::Runnable'; # this class technically follows |
19 | # MX::Runnable's protocol |
c527660e |
20 | |
c527660e |
21 | has 'class' => ( |
22 | is => 'ro', |
23 | isa => RunnableClass, |
24 | required => 1, |
25 | ); |
26 | |
27 | has 'plugins' => ( |
28 | is => 'ro', |
a19e41e3 |
29 | isa => HashRef[ArrayRef[Str]], |
528dfa34 |
30 | default => sub { +{} }, |
c527660e |
31 | required => 1, |
32 | auto_deref => 1, |
33 | ); |
34 | |
35 | sub BUILD { |
36 | my $self = shift; |
e8020e5e |
37 | |
38 | # it would be nice to use MX::Object::Pluggable, but our plugins |
39 | # are too configurable |
40 | |
41 | my $plugin_ns = 'MooseX::Runnable::Invocation::Plugin::'; |
42 | for my $plugin (keys %{$self->plugins}){ |
43 | my $orig = $plugin; |
44 | $plugin = "$plugin_ns$plugin" unless $plugin =~ /^[+]/; |
45 | $plugin =~ s/^[+]//g; |
46 | |
7da369ca |
47 | use_module( $plugin ); |
e8020e5e |
48 | |
86c248d8 |
49 | my $does_cmdline = $plugin->meta-> |
50 | does_role('MooseX::Runnable::Invocation::Plugin::Role::CmdlineArgs'); |
51 | |
2828ce0c |
52 | my $args; |
86c248d8 |
53 | if($does_cmdline){ |
2828ce0c |
54 | $args = eval { |
55 | $plugin->_build_initargs_from_cmdline( |
56 | @{$self->plugins->{$orig}}, |
57 | ); |
58 | }; |
59 | |
60 | if($@) { |
61 | confess "Error building initargs for $plugin: $@"; |
62 | } |
e8020e5e |
63 | } |
86c248d8 |
64 | elsif(!$does_cmdline && scalar @{$self->plugins->{$orig}} > 0){ |
65 | confess "You supplied arguments to the $orig plugin, but it". |
66 | " does not know how to accept them. Perhaps the plugin". |
67 | " should consume the". |
68 | " 'MooseX::Runnable::Invocation::Plugin::Role::CmdlineArgs'". |
69 | " role?"; |
70 | } |
e8020e5e |
71 | |
72 | $plugin->meta->apply( |
73 | $self, |
74 | defined $args ? (rebless_params => $args) : (), |
75 | ); |
76 | } |
c527660e |
77 | } |
78 | |
79 | sub load_class { |
80 | my $self = shift; |
81 | my $class = $self->class; |
82 | |
7da369ca |
83 | use_module( $class ); |
c527660e |
84 | |
85 | confess 'We can only work with Moose classes with "meta" methods' |
86 | if !$class->can('meta'); |
87 | |
88 | my $meta = $class->meta; |
89 | |
90 | confess "The metaclass of $class is not a Moose::Meta::Class, it's $meta" |
91 | unless $meta->isa('Moose::Meta::Class'); |
92 | |
93 | confess 'MooseX::Runnable can only run classes tagged with '. |
94 | 'the MooseX::Runnable role' |
95 | unless $meta->does_role('MooseX::Runnable'); |
96 | |
97 | return $meta; |
98 | } |
99 | |
100 | sub apply_scheme { |
101 | my ($self, $class) = @_; |
102 | |
103 | my @schemes = grep { defined } map { |
6568c67d |
104 | eval { $self->_convert_role_to_scheme($_) } |
105 | } map { |
106 | eval { $_->meta->calculate_all_roles }; |
107 | } $class->linearized_isa; |
c527660e |
108 | |
26041d41 |
109 | eval { |
6568c67d |
110 | foreach my $scheme (uniq @schemes) { |
26041d41 |
111 | $scheme->apply($self); |
112 | } |
113 | }; |
c527660e |
114 | } |
115 | |
780724cb |
116 | |
117 | sub _convert_role_to_scheme { |
118 | my ($self, $role) = @_; |
119 | |
120 | my $name = $role->name; |
121 | return if $name =~ /\|/; |
122 | $name = "MooseX::Runnable::Invocation::Scheme::$name"; |
123 | |
124 | return eval { |
7da369ca |
125 | use_module($name); |
780724cb |
126 | warn "$name was loaded OK, but it's not a role!" and return |
127 | unless $name->meta->isa('Moose::Meta::Role'); |
128 | return $name->meta; |
129 | }; |
130 | } |
131 | |
c527660e |
132 | sub validate_class { |
133 | my ($self, $class) = @_; |
134 | |
135 | my @bad_attributes = map { $_->name } grep { |
0108a926 |
136 | $_->is_required && !($_->has_default || $_->has_builder) |
00d7989a |
137 | } $class->get_all_attributes; |
c527660e |
138 | |
139 | confess |
140 | 'By default, MooseX::Runnable calls the constructor with no'. |
141 | ' args, but that will result in an error for your class. You'. |
142 | ' need to provide a MooseX::Runnable::Invocation::Plugin or'. |
143 | ' ::Scheme for this class that will satisfy the requirements.'. |
144 | "\n". |
145 | "The class is @{[$class->name]}, and the required attributes are ". |
146 | join ', ', map { "'$_'" } @bad_attributes |
147 | if @bad_attributes; |
148 | |
149 | return; # return value is meaningless |
150 | } |
151 | |
c527660e |
152 | sub create_instance { |
153 | my ($self, $class, @args) = @_; |
154 | return ($class->name->new, @args); |
155 | } |
156 | |
157 | sub start_application { |
158 | my $self = shift; |
159 | my $instance = shift; |
160 | my @args = @_; |
161 | |
162 | return $instance->run(@args); |
163 | } |
164 | |
165 | sub run { |
166 | my $self = shift; |
167 | my @args = @_; |
168 | |
169 | my $class = $self->load_class; |
170 | $self->apply_scheme($class); |
171 | $self->validate_class($class); |
172 | my ($instance, @more_args) = $self->create_instance($class, @args); |
173 | my $exit_code = $self->start_application($instance, @more_args); |
174 | return $exit_code; |
175 | } |
176 | |
177 | 1; |