Commit | Line | Data |
c527660e |
1 | package MooseX::Runnable::Invocation; |
2 | use Moose; |
3 | use MooseX::Types -declare => ['RunnableClass']; |
4 | use MooseX::Types::Moose qw(Str ClassName); |
5 | |
6 | require Class::MOP; |
7 | |
8 | # we can't load the class until plugins are loaded, |
9 | # so we have to handle this outside of coerce |
10 | |
11 | subtype RunnableClass, |
12 | as Str, |
13 | where { $_ =~ /^[:A-Za-z_]+$/ }; |
14 | |
15 | use namespace::clean -except => 'meta'; |
16 | |
17 | # this class is just as runnable as any other, so I guess we should tag it |
18 | with 'MooseX::Runnable', 'MooseX::Object::Pluggable'; |
19 | |
20 | has '+_plugin_ns' => ( default => 'MooseX::Runnable::Invocation::Plugin' ); |
21 | |
22 | has 'class' => ( |
23 | is => 'ro', |
24 | isa => RunnableClass, |
25 | required => 1, |
26 | ); |
27 | |
28 | has 'plugins' => ( |
29 | is => 'ro', |
30 | isa => 'ArrayRef[Str]', |
31 | default => sub { [] }, |
32 | required => 1, |
33 | auto_deref => 1, |
34 | ); |
35 | |
36 | sub BUILD { |
37 | my $self = shift; |
38 | $self->load_plugin($_) for $self->plugins; |
39 | } |
40 | |
41 | sub load_class { |
42 | my $self = shift; |
43 | my $class = $self->class; |
44 | |
45 | Class::MOP::load_class( $class ); |
46 | |
47 | confess 'We can only work with Moose classes with "meta" methods' |
48 | if !$class->can('meta'); |
49 | |
50 | my $meta = $class->meta; |
51 | |
52 | confess "The metaclass of $class is not a Moose::Meta::Class, it's $meta" |
53 | unless $meta->isa('Moose::Meta::Class'); |
54 | |
55 | confess 'MooseX::Runnable can only run classes tagged with '. |
56 | 'the MooseX::Runnable role' |
57 | unless $meta->does_role('MooseX::Runnable'); |
58 | |
59 | return $meta; |
60 | } |
61 | |
62 | sub apply_scheme { |
63 | my ($self, $class) = @_; |
64 | |
65 | my @schemes = grep { defined } map { |
66 | $self->_convert_role_to_scheme($_) |
67 | } $class->calculate_all_roles; |
68 | |
69 | foreach my $scheme (@schemes) { |
70 | $scheme->apply($self); |
71 | } |
72 | } |
73 | |
780724cb |
74 | |
75 | sub _convert_role_to_scheme { |
76 | my ($self, $role) = @_; |
77 | |
78 | my $name = $role->name; |
79 | return if $name =~ /\|/; |
80 | $name = "MooseX::Runnable::Invocation::Scheme::$name"; |
81 | |
82 | return eval { |
83 | Class::MOP::load_class($name); |
84 | warn "$name was loaded OK, but it's not a role!" and return |
85 | unless $name->meta->isa('Moose::Meta::Role'); |
86 | return $name->meta; |
87 | }; |
88 | } |
89 | |
90 | |
c527660e |
91 | sub validate_class { |
92 | my ($self, $class) = @_; |
93 | |
94 | my @bad_attributes = map { $_->name } grep { |
95 | $_->is_required && $_->has_default || $_->has_builder |
96 | } $class->compute_all_applicable_attributes; |
97 | |
98 | confess |
99 | 'By default, MooseX::Runnable calls the constructor with no'. |
100 | ' args, but that will result in an error for your class. You'. |
101 | ' need to provide a MooseX::Runnable::Invocation::Plugin or'. |
102 | ' ::Scheme for this class that will satisfy the requirements.'. |
103 | "\n". |
104 | "The class is @{[$class->name]}, and the required attributes are ". |
105 | join ', ', map { "'$_'" } @bad_attributes |
106 | if @bad_attributes; |
107 | |
108 | return; # return value is meaningless |
109 | } |
110 | |
c527660e |
111 | sub create_instance { |
112 | my ($self, $class, @args) = @_; |
113 | return ($class->name->new, @args); |
114 | } |
115 | |
116 | sub start_application { |
117 | my $self = shift; |
118 | my $instance = shift; |
119 | my @args = @_; |
120 | |
121 | return $instance->run(@args); |
122 | } |
123 | |
124 | sub run { |
125 | my $self = shift; |
126 | my @args = @_; |
127 | |
128 | my $class = $self->load_class; |
129 | $self->apply_scheme($class); |
130 | $self->validate_class($class); |
131 | my ($instance, @more_args) = $self->create_instance($class, @args); |
132 | my $exit_code = $self->start_application($instance, @more_args); |
133 | return $exit_code; |
134 | } |
135 | |
136 | 1; |