line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IO::Handle::Prototype; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
53812
|
use strict; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
123
|
|
4
|
4
|
|
|
4
|
|
18
|
use warnings; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
99
|
|
5
|
|
|
|
|
|
|
|
6
|
4
|
|
|
4
|
|
30
|
use Carp (); |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
80
|
|
7
|
|
|
|
|
|
|
|
8
|
4
|
|
|
4
|
|
826
|
use parent qw(IO::Handle::Util::Overloading); |
|
4
|
|
|
|
|
386
|
|
|
4
|
|
|
|
|
28
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub new { |
11
|
21
|
|
|
21
|
0
|
77
|
my ( $class, @args ) = @_; |
12
|
|
|
|
|
|
|
|
13
|
21
|
100
|
|
|
|
72
|
my $cb = @args == 1 ? $args[0] : {@args}; |
14
|
|
|
|
|
|
|
|
15
|
21
|
|
|
|
|
156
|
bless { |
16
|
|
|
|
|
|
|
cb => $cb, |
17
|
|
|
|
|
|
|
}, $class; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub _cb { |
21
|
258
|
|
|
258
|
|
351
|
my $self = shift; |
22
|
258
|
|
|
|
|
346
|
my $name = shift; |
23
|
|
|
|
|
|
|
|
24
|
258
|
100
|
|
|
|
1097
|
if ( my $cb = $self->{cb}{$name} ) { |
25
|
237
|
|
|
|
|
1487
|
return $self->$cb(@_); |
26
|
|
|
|
|
|
|
} else { |
27
|
21
|
|
|
|
|
3952
|
Carp::croak("No implementation of '$name' provided for $self"); |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
0
|
|
|
0
|
0
|
0
|
sub open { shift->_cb(open => @_) } |
32
|
|
|
|
|
|
|
|
33
|
69
|
|
|
69
|
0
|
12095
|
sub getline { shift->_cb(getline => @_) } |
34
|
5
|
|
|
5
|
0
|
15
|
sub getlines { shift->_cb(getlines => @_) } |
35
|
38
|
|
|
38
|
0
|
6029
|
sub read { shift->_cb(read => @_) } |
36
|
0
|
|
|
0
|
0
|
0
|
sub sysread { shift->_cb(sysread => @_) } |
37
|
13
|
|
|
13
|
0
|
7174
|
sub getc { shift->_cb(getc => @_) } |
38
|
5
|
|
|
5
|
0
|
18
|
sub ungetc { shift->_cb(ungetc => @_) } |
39
|
|
|
|
|
|
|
|
40
|
9
|
|
|
9
|
0
|
9106
|
sub say { shift->_cb(say => @_) } |
41
|
27
|
|
|
27
|
0
|
25970
|
sub print { shift->_cb(print => @_) } |
42
|
3
|
|
|
3
|
0
|
3095
|
sub printf { shift->_cb(printf => @_) } |
43
|
|
|
|
|
|
|
|
44
|
0
|
|
|
0
|
0
|
0
|
sub format_write { shift->_cb(format_write => @_) } |
45
|
11
|
|
|
11
|
0
|
12311
|
sub write { shift->_cb(write => @_) } |
46
|
9
|
|
|
9
|
0
|
5598
|
sub syswrite { shift->_cb(syswrite => @_) } |
47
|
|
|
|
|
|
|
|
48
|
0
|
|
|
0
|
0
|
0
|
sub ioctl { shift->_cb(ioctl => @_) } |
49
|
0
|
|
|
0
|
0
|
0
|
sub fcntl { shift->_cb(fcntl => @_) } |
50
|
|
|
|
|
|
|
|
51
|
0
|
|
|
0
|
0
|
0
|
sub truncate { shift->_cb(truncate => @_) } |
52
|
|
|
|
|
|
|
|
53
|
0
|
|
|
0
|
0
|
0
|
sub stat { shift->_cb(stat => @_) } |
54
|
0
|
|
|
0
|
0
|
0
|
sub fileno { shift->_cb(fileno => @_) } |
55
|
|
|
|
|
|
|
|
56
|
50
|
|
|
50
|
0
|
6409
|
sub eof { shift->_cb(eof => @_) } |
57
|
|
|
|
|
|
|
|
58
|
0
|
|
|
0
|
0
|
|
sub close { shift->_cb(close => @_) } |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
__PACKAGE__ |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# ex: set sw=4 et: |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
__END__ |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=pod |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=head1 NAME |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
IO::Handle::Prototype - base class for callback based handles. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head1 SYNOPSIS |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
my $fh = IO::Handle::Prototype->new( |
75
|
|
|
|
|
|
|
getline => sub { |
76
|
|
|
|
|
|
|
my $fh = shift; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
... |
79
|
|
|
|
|
|
|
}, |
80
|
|
|
|
|
|
|
); |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head1 DESCRIPTION |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
You probably want L<IO::Handle::Prototype::Fallback> instead. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=cut |