File Coverage

blib/lib/Net/Async/Tangence/Protocol.pm
Criterion Covered Total %
statement 32 33 96.9
branch 7 8 87.5
condition 2 2 100.0
subroutine 9 9 100.0
pod 3 3 100.0
total 53 55 96.3


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 0.16;
7              
8 9     9   170270 use v5.14;
  9         41  
9 9     9   48 use warnings;
  9         20  
  9         329  
10              
11 9     9   52 use base qw( IO::Async::Stream Tangence::Stream );
  9         19  
  9         6059  
12              
13 9     9   338084 use Carp;
  9         29  
  9         2865  
14              
15             =head1 NAME
16              
17             C - concrete implementation of
18             C for C
19              
20             =head1 DESCRIPTION
21              
22             This subclass of L provides a concrete implementation of
23             the L mixin. It is not intended to be directly used by
24             server implementations. Instead, it is subclassed as
25             L and L.
26              
27             =cut
28              
29             sub _init
30             {
31 14     14   16364 my $self = shift;
32 14         36 my ( $params ) = @_;
33              
34 14         100 $self->SUPER::_init( $params );
35              
36 14   100     378 $params->{on_closed} ||= undef;
37             }
38              
39             sub configure
40             {
41 25     25 1 69 my $self = shift;
42 25         79 my %params = @_;
43              
44 25 100       96 if( exists $params{on_closed} ) {
45 14         42 my $on_closed = delete $params{on_closed};
46              
47             $params{on_closed} = sub {
48 3     3   15832 my ( $self ) = @_;
49 3 100       17 $on_closed->( $self ) if $on_closed;
50              
51 3         160 $self->tangence_closed;
52              
53 3 50       444 if( my $parent = $self->parent ) {
    100          
54 0         0 $parent->remove_child( $self );
55             }
56             elsif( my $loop = $self->get_loop ) {
57 1         24 $loop->remove( $self );
58             }
59 14         75 };
60             }
61              
62 25         154 $self->SUPER::configure( %params );
63             }
64              
65             sub tangence_write
66             {
67 55     55 1 56928 my $self = shift;
68 55         335 $self->write( $_[0] );
69             }
70              
71             sub on_read
72             {
73 44     44 1 271901 my $self = shift;
74 44         127 my ( $buffref, $closed ) = @_;
75              
76 44         299 $self->tangence_readfrom( $$buffref );
77              
78 44         49576 return 0;
79             }
80              
81             =head1 AUTHOR
82              
83             Paul Evans
84              
85             =cut
86              
87             0x55AA;