Commit | Line | Data |
098b6cb6 |
1 | package MooseX::Runnable::Invocation::Plugin::Debug; |
2 | use Moose::Role; |
098b6cb6 |
3 | |
0c9cfd21 |
4 | # this is an example to cargo-cult, rather than a useful feature :) |
5 | has 'debug_prefix' => ( |
6 | is => 'ro', |
7 | isa => 'Str', |
8 | required => 1, |
9 | default => sub { "" }, |
10 | ); |
11 | |
12 | sub _build_initargs_from_cmdline { |
13 | my ($class, @args) = @_; |
14 | confess 'Bad args passed to Debug plugin' |
15 | unless @args % 2 == 0; |
16 | |
17 | my %args = @args; |
18 | |
19 | if(my $p = $args{'--prefix'}){ |
20 | return { debug_prefix => $p }; |
21 | } |
22 | return; |
23 | } |
24 | |
00fc26d5 |
25 | for my $method (qw{ |
26 | load_class apply_scheme validate_class |
27 | create_instance start_application |
28 | }){ |
098b6cb6 |
29 | requires $method; |
30 | |
31 | before $method => sub { |
00fc26d5 |
32 | my ($self, @args) = @_; |
098b6cb6 |
33 | my $args = join ', ', @args; |
0c9cfd21 |
34 | print $self->debug_prefix, "Calling $method($args)\n"; |
098b6cb6 |
35 | }; |
36 | |
37 | after $method => sub { |
0c9cfd21 |
38 | my $self = shift; |
39 | print $self->debug_prefix, "Returning from $method\n"; |
098b6cb6 |
40 | }; |
41 | } |
42 | |
43 | 1; |