File Coverage

blib/lib/Net/HTTP/Spore/Role/Debug.pm
Criterion Covered Total %
statement 26 31 83.8
branch 9 16 56.2
condition 0 3 0.0
subroutine 4 5 80.0
pod 0 1 0.0
total 39 56 69.6


line stmt bran cond sub pod time code
1             package Net::HTTP::Spore::Role::Debug;
2             $Net::HTTP::Spore::Role::Debug::VERSION = '0.08';
3 22     22   73350 use IO::File;
  22         55  
  22         3670  
4 22     22   149 use Moose::Role;
  22         46  
  22         189  
5              
6             has trace => (
7             is => 'rw',
8             isa => 'Str',
9             predicate => 'has_trace',
10             clearer => 'reset_trace',
11             );
12              
13             has _trace_fh => (
14             is => 'rw',
15             isa => 'GLOB',
16             );
17              
18             sub BUILD {
19 33     33 0 314220 my ($self, $args) = @_;
20 33         91 my $trace;
21              
22 33 100       142 $trace = $args->{trace} if $args->{trace};
23 33 50       151 $trace = $ENV{SPORE_TRACE} if defined $ENV{SPORE_TRACE};
24              
25 33 100       114 if (!defined $trace){
26 32         1288 $self->reset_trace;
27 32         96 return;
28             }
29              
30 1         2 my ($level, $fh);
31 1 50       8 if ( $trace =~ /(\d)=(.+)$/ ) {
32 1         4 $level = $1;
33 1         2 my $file = $2;
34 1 50       10 $fh = IO::File->new( $file, 'w' )
35             or die "Cannot open trace file $file";
36             }
37             else {
38 0         0 $level = $trace;
39 0 0       0 $fh = IO::File->new('>&STDERR')
40             or die('Duplication of STDERR for debug output failed (perhaps your STDERR is closed?)');
41             }
42 1         176 $fh->autoflush;
43 1         93 $self->_trace_fh($fh);
44 1         59 $self->trace($level);
45             }
46              
47             sub _trace_msg {
48 41     41   96 my $self = shift;
49 41         83 my $template = shift;
50 41 100       1679 return unless $self->has_trace;
51              
52 1         28 my $fh = $self->_trace_fh();
53 1         72 print $fh (sprintf( $template, @_ )."\n");
54             }
55              
56             sub _trace_verbose {
57 0     0     my $self = shift;
58 0 0 0       return unless $self->trace && $self->trace > 1;
59 0           $self->_trace_msg(@_);
60             }
61              
62             1;
63              
64             __END__
65              
66             =pod
67              
68             =encoding UTF-8
69              
70             =head1 NAME
71              
72             Net::HTTP::Spore::Role::Debug
73              
74             =head1 VERSION
75              
76             version 0.08
77              
78             =head1 AUTHORS
79              
80             =over 4
81              
82             =item *
83              
84             Franck Cuny <franck.cuny@gmail.com>
85              
86             =item *
87              
88             Ash Berlin <ash@cpan.org>
89              
90             =item *
91              
92             Ahmad Fatoum <athreef@cpan.org>
93              
94             =back
95              
96             =head1 COPYRIGHT AND LICENSE
97              
98             This software is copyright (c) 2012 by Linkfluence.
99              
100             This is free software; you can redistribute it and/or modify it under
101             the same terms as the Perl 5 programming language system itself.
102              
103             =cut