make Debug plugin accept an argument (as an example)

[gitmo/MooseX-Runnable.git] / lib / MooseX / Runnable / Invocation / Plugin / Debug.pm

diff --git a/lib/MooseX/Runnable/Invocation/Plugin/Debug.pm b/lib/MooseX/Runnable/Invocation/Plugin/Debug.pm
index 60db341..00db16a 100644 (file)
--- a/lib/MooseX/Runnable/Invocation/Plugin/Debug.pm
+++ b/lib/MooseX/Runnable/Invocation/Plugin/Debug.pm
@@ -1,20 +1,42 @@
 package MooseX::Runnable::Invocation::Plugin::Debug;
 use Moose::Role;
-use Context::Preserve qw(preserve_context);
 
-for my $method (qw/load_class apply_scheme validate_class create_instance start_application/){
+# this is an example to cargo-cult, rather than a useful feature :)
+has 'debug_prefix' => (
+    is       => 'ro',
+    isa      => 'Str',
+    required => 1,
+    default  => sub { "" },
+);
 
+sub _build_initargs_from_cmdline {
+    my ($class, @args) = @_;
+    confess 'Bad args passed to Debug plugin'
+      unless @args % 2 == 0;
+
+    my %args = @args;
+
+    if(my $p = $args{'--prefix'}){
+        return { debug_prefix => $p };
+    }
+    return;
+}
+
+for my $method (qw{
+    load_class apply_scheme validate_class
+    create_instance start_application
+  }){
     requires $method;
 
     before $method => sub {
-        my ($self, @args);
+        my ($self, @args) = @_;
         my $args = join ', ', @args;
-        print "Calling $method($args)\n";
+        print $self->debug_prefix, "Calling $method($args)\n";
     };
 
     after $method => sub {
-        my ($next, $self, @args) = @_;
-        print "Returning from $method\n";
+        my $self = shift;
+        print $self->debug_prefix, "Returning from $method\n";
     };
 }