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   138504 use strict;
  6         10  
  6         171  
9 6     6   31 use warnings;
  6         13  
  6         250  
10              
11             our $VERSION = '0.13';
12              
13 6     6   39 use base qw( IO::Async::Stream Tangence::Stream );
  6         15  
  6         5077  
14              
15 6     6   253510 use Carp;
  6         13  
  6         1931  
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   6584 my $self = shift;
34 9         17 my ( $params ) = @_;
35              
36 9         57 $self->SUPER::_init( $params );
37              
38 9   100     218 $params->{on_closed} ||= undef;
39             }
40              
41             sub configure
42             {
43 15     15 1 31 my $self = shift;
44 15         44 my %params = @_;
45              
46 15 100       48 if( exists $params{on_closed} ) {
47 9         36 my $on_closed = delete $params{on_closed};
48              
49             $params{on_closed} = sub {
50 3     3   13916 my ( $self ) = @_;
51 3 100       19 $on_closed->( $self ) if $on_closed;
52              
53 3         142 $self->tangence_closed;
54              
55 3 50       400 if( my $parent = $self->parent ) {
    100          
56 0         0 $parent->remove_child( $self );
57             }
58             elsif( my $loop = $self->get_loop ) {
59 1         28 $loop->remove( $self );
60             }
61 9         62 };
62             }
63              
64 15         78 $self->SUPER::configure( %params );
65             }
66              
67             sub tangence_write
68             {
69 40     40 1 34403 my $self = shift;
70 40         171 $self->write( $_[0] );
71             }
72              
73             sub on_read
74             {
75 34     34 1 42262 my $self = shift;
76 34         64 my ( $buffref, $closed ) = @_;
77              
78 34         149 $self->tangence_readfrom( $$buffref );
79              
80 34         26830 return 0;
81             }
82              
83             =head1 AUTHOR
84              
85             Paul Evans
86              
87             =cut
88              
89             0x55AA;