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