lib/MooseX/Runnable/Invocation/Plugin/Debug.pm

   1 package MooseX::Runnable::Invocation::Plugin::Debug;
   2 use Moose::Role;
   3
   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
  25 sub _debug_message {
  26     my ($self, @msg) = @_;
  27     print {*STDERR} $self->debug_prefix, "[$$] ", @msg, "\n";
  28 }
  29
  30 for my $method (qw{
  31     load_class apply_scheme validate_class
  32     create_instance start_application
  33   }){
  34     requires $method;
  35
  36     before $method => sub {
  37         my ($self, @args) = @_;
  38         my $args = join ', ', @args;
  39         $self->_debug_message("Calling $method($args)");
  40     };
  41
  42     after $method => sub {
  43         my $self = shift;
  44         $self->_debug_message("Returning from $method");
  45     };
  46 }
  47
  48 1;