File Coverage

blib/lib/IO/Statistics.pm
Criterion Covered Total %
statement 22 22 100.0
branch 4 4 100.0
condition n/a
subroutine 7 7 100.0
pod 0 2 0.0
total 33 35 94.2


line stmt bran cond sub pod time code
1             package IO::Statistics;
2 2     2   30942 use 5.008;
  2         8  
  2         82  
3 2     2   12 use strict;
  2         3  
  2         69  
4 2     2   10 use warnings;
  2         18  
  2         77  
5 2     2   1972 use PerlIO::via::dynamic '0.10';
  2         21960  
  2         518  
6             our $VERSION = '0.13';
7              
8             =head1 NAME
9              
10             IO::Statistics - Transparently perform statistics on IO handles
11              
12             =head1 SYNOPSIS
13              
14             use IO::Statistics;
15              
16             my ($read, $write) = (0, 0);
17             IO::Statistics->count (\$read, \$write, \*STDOUT);
18              
19             # alternatively:
20             my $ios = IO::Statistics->new (\$read, \$write);
21             $ios->via (\*STDOUT);
22              
23             print "fooo";
24             print "bkzlfdlkf\n";
25              
26             END {
27             print "read $read bytes read, wrote $write bytes\n";
28             }
29              
30             =head1 DESCRIPTION
31              
32             This module allows you to count IO activity on a file handle transparently.
33              
34             =cut
35              
36             sub new {
37 3     3 0 9 my ($class, $read, $write) = @_;
38 3         13 my %map = (translate => $write, untranslate => $read);
39              
40 6         12 return PerlIO::via::dynamic->new
41             ( use_read => 1,
42 3         13 map { my $ref = $map{$_};
43 6 100   3   50 $ref ? ($_ => sub { $$ref += length ($_[1])}) : ()
  3         2955  
44             } keys %map);
45              
46             }
47              
48             sub count {
49 3     3 0 3653 my ($class, $read, $write, @handle) = @_;
50 3         14 my $ios = $class->new ($read, $write);
51 3 100       571 die "more than one handle not supported yet" if $#handle > 0;
52 2         17 $ios->via ($_) for @handle;
53             }
54              
55             =head1 BUGS
56              
57             Using this IO layer on a global filehandle might result in segfault on
58             C.
59              
60             =head1 TEST COVERAGE
61              
62             ----------------------------------- ------ ------ ------ ------ ------ ------
63             File stmt branch cond sub time total
64             ----------------------------------- ------ ------ ------ ------ ------ ------
65             blib/lib/IO/Statistics.pm 100.0 100.0 n/a 100.0 100.0 100.0
66             Total 100.0 100.0 n/a 100.0 100.0 100.0
67             ----------------------------------- ------ ------ ------ ------ ------ ------
68              
69             =head1 AUTHORS
70              
71             Chia-liang Kao Eclkao@clkao.orgE
72              
73             =head1 COPYRIGHT
74              
75             Copyright 2004 by Chia-liang Kao Eclkao@clkao.orgE.
76              
77             This program is free software; you can redistribute it and/or modify it
78             under the same terms as Perl itself.
79              
80             See L
81              
82             =cut
83              
84             1;