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

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