File Coverage

blib/lib/Net/Async/Tangence/Protocol.pm
Criterion Covered Total %
statement 33 34 97.0
branch 7 8 87.5
condition 2 2 100.0
subroutine 9 9 100.0
pod 3 3 100.0
total 54 56 96.4


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2010-2011 -- leonerd@leonerd.org.uk
5              
6             package Net::Async::Tangence::Protocol;
7              
8 6     6   84883 use strict;
  6         9  
  6         154  
9 6     6   17 use warnings;
  6         8  
  6         205  
10              
11             our $VERSION = '0.14';
12              
13 6     6   25 use base qw( IO::Async::Stream Tangence::Stream );
  6         7  
  6         2848  
14              
15 6     6   157975 use Carp;
  6         9  
  6         1410  
16              
17             =head1 NAME
18              
19             C - concrete implementation of
20             C for C
21              
22             =head1 DESCRIPTION
23              
24             This subclass of L provides a concrete implementation of
25             the L mixin. It is not intended to be directly used by
26             server implementations. Instead, it is subclassed as
27             L and L.
28              
29             =cut
30              
31             sub _init
32             {
33 9     9   4061 my $self = shift;
34 9         12 my ( $params ) = @_;
35              
36 9         54 $self->SUPER::_init( $params );
37              
38 9   100     145 $params->{on_closed} ||= undef;
39             }
40              
41             sub configure
42             {
43 15     15 1 22 my $self = shift;
44 15         22 my %params = @_;
45              
46 15 100       41 if( exists $params{on_closed} ) {
47 9         22 my $on_closed = delete $params{on_closed};
48              
49             $params{on_closed} = sub {
50 3     3   8120 my ( $self ) = @_;
51 3 100       14 $on_closed->( $self ) if $on_closed;
52              
53 3         99 $self->tangence_closed;
54              
55 3 50       274 if( my $parent = $self->parent ) {
    100          
56 0         0 $parent->remove_child( $self );
57             }
58             elsif( my $loop = $self->get_loop ) {
59 1         18 $loop->remove( $self );
60             }
61 9         38 };
62             }
63              
64 15         55 $self->SUPER::configure( %params );
65             }
66              
67             sub tangence_write
68             {
69 40     40 1 22228 my $self = shift;
70 40         136 $self->write( $_[0] );
71             }
72              
73             sub on_read
74             {
75 34     34 1 25729 my $self = shift;
76 34         39 my ( $buffref, $closed ) = @_;
77              
78 34         105 $self->tangence_readfrom( $$buffref );
79              
80 34         17171 return 0;
81             }
82              
83             =head1 AUTHOR
84              
85             Paul Evans
86              
87             =cut
88              
89             0x55AA;