File Coverage

blib/lib/IO/Async/Protocol/LineStream.pm
Criterion Covered Total %
statement 28 28 100.0
branch 3 4 75.0
condition 1 2 50.0
subroutine 8 8 100.0
pod 3 3 100.0
total 43 45 95.5


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 -- leonerd@leonerd.org.uk
5              
6             package IO::Async::Protocol::LineStream;
7              
8 2     2   1999 use strict;
  2         6  
  2         69  
9 2     2   13 use warnings;
  2         4  
  2         123  
10              
11             our $VERSION = '0.79';
12              
13 2     2   28 use base qw( IO::Async::Protocol::Stream );
  2         6  
  2         635  
14              
15 2     2   16 use Carp;
  2         5  
  2         773  
16              
17             =head1 NAME
18              
19             C - stream-based protocols using lines of
20             text
21              
22             =head1 SYNOPSIS
23              
24             Most likely this class will be subclassed to implement a particular network
25             protocol.
26              
27             package Net::Async::HelloWorld;
28              
29             use strict;
30             use warnings;
31             use base qw( IO::Async::Protocol::LineStream );
32              
33             sub on_read_line
34             {
35             my $self = shift;
36             my ( $line ) = @_;
37              
38             if( $line =~ m/^HELLO (.*)/ ) {
39             my $name = $1;
40              
41             $self->invoke_event( on_hello => $name );
42             }
43             }
44              
45             sub send_hello
46             {
47             my $self = shift;
48             my ( $name ) = @_;
49              
50             $self->write_line( "HELLO $name" );
51             }
52              
53             This small example elides such details as error handling, which a real
54             protocol implementation would be likely to contain.
55              
56             =head1 DESCRIPTION
57              
58             =cut
59              
60             =head1 EVENTS
61              
62             The following events are invoked, either using subclass methods or CODE
63             references in parameters:
64              
65             =head2 on_read_line $line
66              
67             Invoked when a new complete line of input is received.
68              
69             =cut
70              
71             =head1 PARAMETERS
72              
73             The following named parameters may be passed to C or C:
74              
75             =head2 on_read_line => CODE
76              
77             CODE reference for the C event.
78              
79             =cut
80              
81             sub _init
82             {
83 2     2   6 my $self = shift;
84 2         14 $self->SUPER::_init;
85              
86 2         16 $self->{eol} = "\x0d\x0a";
87 2         17 $self->{eol_pattern} = qr/\x0d?\x0a/;
88             }
89              
90             sub configure
91             {
92 3     3 1 1340 my $self = shift;
93 3         9 my %params = @_;
94              
95 3         10 foreach (qw( on_read_line )) {
96 3 100       21 $self->{$_} = delete $params{$_} if exists $params{$_};
97             }
98              
99 3         19 $self->SUPER::configure( %params );
100             }
101              
102             sub on_read
103             {
104 4     4 1 9 my $self = shift;
105 4         10 my ( $buffref, $eof ) = @_;
106              
107             # Easiest to run each event individually, in case it returns a CODE ref
108 4 50       92 $$buffref =~ s/^(.*?)$self->{eol_pattern}// or return 0;
109              
110 4   50     18 return $self->invoke_event( on_read_line => $1 ) || 1;
111             }
112              
113             =head1 METHODS
114              
115             =cut
116              
117             =head2 write_line
118              
119             $lineprotocol->write_line( $text )
120              
121             Writes a line of text to the transport stream. The text will have the
122             end-of-line marker appended to it; C<$text> should not end with it.
123              
124             =cut
125              
126             sub write_line
127             {
128 1     1 1 1810 my $self = shift;
129 1         5 my ( $line, @args ) = @_;
130              
131 1         14 $self->write( "$line$self->{eol}", @args );
132             }
133              
134             =head1 AUTHOR
135              
136             Paul Evans
137              
138             =cut
139              
140             0x55AA;