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