diff options
author | franck cuny <franck@lumberjaph.net> | 2011-07-11 15:34:33 +0200 |
---|---|---|
committer | franck cuny <franck@lumberjaph.net> | 2011-07-26 13:21:01 +0200 |
commit | 50580a77f80711dcf66383049f3af5d845838ae3 (patch) | |
tree | 8a270d4e4af30c7d08f8000a7886135e1318139c | |
parent | add test for timeout (diff) | |
download | net-http-spore-50580a77f80711dcf66383049f3af5d845838ae3.tar.gz |
enable trace with environment or constructor
Signed-off-by: franck cuny <franck@lumberjaph.net>
-rw-r--r-- | lib/Net/HTTP/Spore/Role/Debug.pm | 49 |
1 files changed, 26 insertions, 23 deletions
diff --git a/lib/Net/HTTP/Spore/Role/Debug.pm b/lib/Net/HTTP/Spore/Role/Debug.pm index e229229..3989293 100644 --- a/lib/Net/HTTP/Spore/Role/Debug.pm +++ b/lib/Net/HTTP/Spore/Role/Debug.pm @@ -4,28 +4,9 @@ use IO::File; use Moose::Role; has trace => ( - is => 'rw', - isa => 'Int', - lazy => 1, - default => sub { - my $self = shift; - my $trace_env = $ENV{SPORE_TRACE} || 0; - #my @stack = caller; use YAML; warn Dump \@stack; - my ($fh, $level); - if ( $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; - } + is => 'rw', + isa => 'Str', + predicate => 'has_trace', ); has _trace_fh => ( @@ -33,10 +14,32 @@ has _trace_fh => ( isa => 'GLOB', ); +sub BUILD { + my ($self, $args) = @_; + my $trace = $ENV{SPORE_TRACE} || $args->{trace}; + return unless defined $trace; + + my ($level, $fh); + if ( $trace =~ /(\d)=(.+)$/ ) { + $level = $1; + my $file = $2; + $fh = IO::File->new( $file, 'w' ) + or die "Cannot open trace file $file"; + } + else { + $level = $trace; + $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); + $self->trace($level); +} + sub _trace_msg { my $self = shift; my $template = shift; - return unless $self->trace; + return unless $self->has_trace; my $fh = $self->_trace_fh(); print $fh (sprintf( $template, @_ )."\n"); } |