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

   1 package MooseX::Runnable::Invocation::Plugin::Debug;
   2 # ABSTRACT: print debugging information
   3
   4 use Moose::Role;
   5
   6 with 'MooseX::Runnable::Invocation::Plugin::Role::CmdlineArgs';
   7
   8 # this is an example to cargo-cult, rather than a useful feature :)
   9 has 'debug_prefix' => (
  10     is       => 'ro',
  11     isa      => 'Str',
  12     required => 1,
  13     default  => sub { "" },
  14 );
  15
  16 sub _build_initargs_from_cmdline {
  17     my ($class, @args) = @_;
  18     confess 'Bad args passed to Debug plugin'
  19       unless @args % 2 == 0;
  20
  21     my %args = @args;
  22
  23     if(my $p = $args{'--prefix'}){
  24         return { debug_prefix => $p };
  25     }
  26     return;
  27 }
  28
  29 sub _debug_message {
  30     my ($self, @msg) = @_;
  31     print {*STDERR} $self->debug_prefix, "[$$] ", @msg, "\n";
  32 }
  33
  34 for my $method (qw{
  35     load_class apply_scheme validate_class
  36     create_instance start_application
  37   }){
  38     requires $method;
  39
  40     before $method => sub {
  41         my ($self, @args) = @_;
  42         my $args = join ', ', @args;
  43         $self->_debug_message("Calling $method($args)");
  44     };
  45
  46     after $method => sub {
  47         my $self = shift;
  48         $self->_debug_message("Returning from $method");
  49     };
  50 }
  51
  52 1;
  53
  54 __END__
  55
  56 =pod
  57
  58 =head1 DESCRIPTION
  59
  60 This is an example plugin, showing how you could write your own.  It
  61 prints a message for each stage of the "run" process.  It is also used
  62 by other plugins to determine whether or not to print debugging
  63 messages.
  64
  65 =head1 SEE ALSO
  66
  67 L<MooseX::Runnable>
  68
  69 =cut