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 | |
7ebff650 |
25 | sub _debug_message { |
26 | my ($self, @msg) = @_; |
27 | print {*STDERR} $self->debug_prefix, "[$$] ", @msg, "\n"; |
28 | } |
29 | |
00fc26d5 |
30 | for my $method (qw{ |
31 | load_class apply_scheme validate_class |
32 | create_instance start_application |
33 | }){ |
098b6cb6 |
34 | requires $method; |
35 | |
36 | before $method => sub { |
00fc26d5 |
37 | my ($self, @args) = @_; |
098b6cb6 |
38 | my $args = join ', ', @args; |
7ebff650 |
39 | $self->_debug_message("Calling $method($args)"); |
098b6cb6 |
40 | }; |
41 | |
42 | after $method => sub { |
0c9cfd21 |
43 | my $self = shift; |
7ebff650 |
44 | $self->_debug_message("Returning from $method"); |
098b6cb6 |
45 | }; |
46 | } |
47 | |
48 | 1; |