File Coverage

lib/POE/Filter/EPPTCP.pm
Criterion Covered Total %
statement 52 52 100.0
branch 10 10 100.0
condition n/a
subroutine 10 10 100.0
pod 3 3 100.0
total 75 75 100.0


line stmt bran cond sub pod time code
1             package POE::Filter::EPPTCP;
2              
3 2     2   80861 use 5.024;
  2         19  
4 2     2   11 use utf8;
  2         3  
  2         12  
5 2     2   1123 use strictures 2;
  2         3477  
  2         87  
6              
7 2     2   1590 use English qw(-no_match_vars);
  2         5732  
  2         13  
8              
9             #ABSTRACT: EPP Frame parsing for POE
10              
11 2     2   2028 use Moose qw(has extends);
  2         1012155  
  2         15  
12 2     2   14930 use MooseX::NonMoose;
  2         2244  
  2         8  
13              
14             extends 'Moose::Object', 'POE::Filter';
15              
16             has 'buffer' => (
17             'is'      => 'ro',
18             'traits'  => ['Array'],
19             'isa'     => 'ArrayRef',
20             'lazy'    => 1,
21             'clearer' => '_clear_buffer',
22             'default' => sub { [] },
23             'handles' => {
24             'has_buffer'     => 'count',
25             'all_buffer'     => 'elements',
26             'push_buffer'    => 'push',
27             'shift_buffer'   => 'shift',
28             'unshift_buffer' => 'unshift',
29             'join_buffer'    => 'join',
30             },
31             );
32              
33             sub get_one_start {
34 7     7 1 4213 my ($self, $raw) = @_;
35              
36 7 100       27 if (defined $raw) {
37 6         10 foreach my $raw_data (@{$raw}) {
  6         17  
38 292         9684 $self->push_buffer($raw_data);
39             }
40             }
41              
42 7         21 return;
43             } ## end sub get_one_start
44              
45             sub get_one {
46              
47 13     13 1 9687 my ($self) = @_;
48              
49 13         30 my $buf = q{};
50              
51 13         31 my $frames = [];
52              
53 13         543       BUFFER_LOOP: while ($self->has_buffer()) {
54 296         552 my ($len, $eppframe) = (0, undef);
55              
56 296         9955 $buf .= $self->shift_buffer();
57              
58 296 100       628 if (4 < length $buf) {
59 285         466 my $lenbuf = substr $buf, 0, 4;
60 285         618 ($len) = unpack 'N', $lenbuf;
61              
62 285 100       583 if ($len <= length $buf) {
63              
64             # Get the whole frame, and remove it from $buf
65 12         37 $eppframe = substr $buf, 0, $len, q{};
66              
67             # Remove the header from the frame.
68 12         31 substr $eppframe, 0, 4, q{};
69             } ## end if ($len <= length $buf)
70             } ## end if (4 < length $buf)
71              
72 296 100       9420 if (defined $eppframe) {
73 12         19 push @{$frames}, $eppframe;
  12         34  
74              
75 12         47 last BUFFER_LOOP;
76             }
77             } ## end BUFFER_LOOP: while ($self->has_buffer())
78              
79             # If we have some remaining buffer, put it back into the buffer ring, at the beginning.
80 13 100       43 if (length $buf > 0) {
81 4         204 $self->unshift_buffer($buf);
82             }
83              
84 13         47 return $frames;
85             } ## end sub get_one
86              
87             sub put {
88 5     5 1 8264 my ($self, $frames) = @_;
89 5         13 my $output = [];
90              
91 5         13 foreach my $frame (@{$frames}) {
  5         13  
92 4         9 push @{$output}, pack('N', 4 + length $frame) . $frame;
  4         29  
93             }
94              
95 5         20 return $output;
96             } ## end sub put
97              
98 2     2   156380 no Moose;
  2         6  
  2         18  
99             __PACKAGE__->meta()->make_immutable();
100              
101             1;
102              
103             =pod
104             =encoding utf8
105            
106             =head1 NAME
107            
108             POE::Filter::EPPTCP - Parsing EPP-TCP Frames for the POE framework
109            
110             =head1 VERSION
111            
112             version 1.140700
113            
114             =head1 SYNOPSIS
115            
116             use POE::Filter::EPPTCP;
117             my $filter = POE::Filter::EPPTCP->new();
118            
119             my $wheel = POE::Wheel:ReadWrite->new(
120             Filter => $filter,
121             InputEvent => 'input_event',
122             );
123            
124             =head1 DESCRIPTION
125            
126             POE::Filter::EPPTCP provides POE with a completely encapsulated EPP over TCP
127             parsing strategy for POE::Wheels that will be dealing with EPP over TCP streams.
128            
129             It returns complete frames, which should be XML, but the parsing of the XML
130             is left to the consumer.
131            
132             =head1 PRIVATE_ATTRIBUTES
133            
134             =head2 buffer
135            
136             is: ro, isa: ArrayRef, traits: Array
137            
138             buffer holds the raw data to be parsed. Raw data should be split on network
139             new lines before being added to the buffer. Access to this attribute is
140             provided by the following methods:
141            
142             handles =>
143             {
144             has_buffer => 'count',
145             all_buffer => 'elements',
146             push_buffer => 'push',
147             shift_buffer => 'shift',
148             unshift_buffer => 'unshift',
149             join_buffer => 'join',
150             }
151            
152             =head1 PUBLIC_METHODS
153            
154             =head2 get_one_start
155            
156             (ArrayRef $raw?)
157            
158             This method is part of the POE::Filter API. See L<POE::Filter/get_one_start>
159             for an explanation of its usage.
160            
161             =head2 get_one
162            
163             returns (ArrayRef)
164            
165             This method is part of the POE::Filter API. See L<POE::Filter/get_one> for an
166             explanation of its usage.
167            
168             =head2 put
169            
170             (ArrayRef $nodes) returns (ArrayRef)
171            
172             This method is part of the POE::Filter API. See L<POE::Filter/put> for an
173             explanation of its usage.
174            
175             =head1 AUTHOR
176            
177             Mathieu Arnold <mat@cpan.org>
178            
179             =head1 COPYRIGHT AND LICENSE
180            
181             This software is copyright (c) 2021 by Mathieu Arnold <mat@cpan.org>
182            
183             This is free software; you can redistribute it and/or modify it under
184             the same terms as the Perl 5 programming language system itself.
185            
186             =cut
187              
188             __END__
189            
190