summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorfranck cuny <franck@lumberjaph.net>2011-07-11 15:34:33 +0200
committerfranck cuny <franck@lumberjaph.net>2011-07-26 13:21:01 +0200
commit50580a77f80711dcf66383049f3af5d845838ae3 (patch)
tree8a270d4e4af30c7d08f8000a7886135e1318139c
parentadd test for timeout (diff)
downloadnet-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.pm49
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");
}