summary refs log tree commit diff
diff options
context:
space:
mode:
authorfranck cuny <franck@lumberjaph.net>2011-02-21 18:23:35 +0100
committerfranck cuny <franck@lumberjaph.net>2011-07-26 13:19:59 +0200
commit7c436e5b036f2e8b9f5d98ac8e85d57886a2713b (patch)
tree181149bbea6cdc38d46810dc4f69c8c3b269614e
parentadd host method to request object (diff)
downloadnet-http-spore-7c436e5b036f2e8b9f5d98ac8e85d57886a2713b.tar.gz
basic code to log
-rw-r--r--lib/Net/HTTP/Spore/Role/Debug.pm39
1 files changed, 34 insertions, 5 deletions
diff --git a/lib/Net/HTTP/Spore/Role/Debug.pm b/lib/Net/HTTP/Spore/Role/Debug.pm
index e178c42..e2d2fa1 100644
--- a/lib/Net/HTTP/Spore/Role/Debug.pm
+++ b/lib/Net/HTTP/Spore/Role/Debug.pm
@@ -1,21 +1,50 @@
 package Net::HTTP::Spore::Role::Debug;
 
+use IO::File;
 use Moose::Role;
 
 has trace => (
     is      => 'rw',
-    isa     => 'Bool',
+    isa     => 'Int',
     lazy    => 1,
-    default => sub { $ENV{SPORE_TRACE} ? 1 : 0; }
+    default => sub {
+        my $self      = shift;
+        my $trace_env = $ENV{SPORE_TRACE};
+        my @stack = caller; use YAML; warn Dump \@stack;
+        my ($fh, $level);
+        if ( defined($trace_env) && ( $trace_env =~ /(\d)=(.+)$/ ) ) {
+            $level = $1;
+            $fh = IO::File->new( $2, 'w' )
+              or die("Cannot open trace file $1");
+        }
+        else {
+            $level = $trace_env;
+            $fh = IO::File->new('>&STDERR')
+              or die('Duplication of STDERR for debug output failed (perhaps your STDERR is closed?)');
+        }
+        $fh->autoflush();
+        $self->_trace_fh($fh);
+        return $level;
+    }
 );
 
-has handle => (
-    is => 'rw', isa => 'Object',
+has _trace_fh => (
+    is      => 'rw',
+    isa     => 'GLOB',
 );
 
 sub _trace_msg {
+    my $self     = shift;
+    my $template = shift;
+    return unless $self->trace;
+    my $fh = $self->_trace_fh();
+    print $fh (sprintf( $template, @_ )."\n");
+}
+
+sub _trace_verbose {
     my $self = shift;
-    print STDOUT $_[0]."\n" if $self->trace;
+    return unless $self->trace && $self->trace > 1;
+    $self->_trace_msg(@_);
 }
 
 1;