File Coverage

blib/lib/Log/Agent/File/Native.pm
Criterion Covered Total %
statement 14 14 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod 2 3 66.6
total 21 22 95.4


line stmt bran cond sub pod time code
1             ###########################################################################
2             #
3             # Native.pm
4             #
5             # Copyright (C) 1999 Raphael Manfredi.
6             # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org;
7             # all rights reserved.
8             #
9             # See the README file included with the
10             # distribution for license information.
11             #
12             ##########################################################################
13            
14 8     8   55 use strict;
  8         16  
  8         1341  
15            
16             ########################################################################
17             package Log::Agent::File::Native;
18            
19             #
20             # A native Perl filehandle.
21             #
22             # I'm no longer using the IO::* hierarchy because it is not adapted
23             # to what we're trying to achieve here.
24             #
25            
26             #
27             # ->make
28             #
29             # Creation routine.
30             # Turns on autoflush as a side effect.
31             #
32             sub make {
33 32     32 1 119 my $class = shift;
34 32         69 my ($glob) = @_;
35 32         214 select((select($glob), $| = 1)[0]); # autoflush turned on
36 32         131 return bless $glob, $class;
37             }
38            
39             #
40             # ->print
41             #
42             # Print to file, propagates print() status.
43             #
44             sub print {
45 69     69 1 126 my $glob = shift;
46 69         277 local $\ = undef;
47 69         915 return CORE::print $glob @_;
48             }
49            
50             #
51             # ->close
52             #
53             # Close file.
54             #
55             sub close {
56 19     19 0 28 my $glob = shift;
57 19         602 CORE::close $glob;
58             }
59            
60             #
61             # ->DESTROY
62             #
63             sub DESTROY {
64 19     19   40 my $glob = shift;
65 19         429 CORE::close $glob;
66             }
67            
68             1; # for require
69             __END__