File Coverage

blib/lib/POE/Filter/YahooMessengerPacket.pm
Criterion Covered Total %
statement 12 41 29.2
branch 0 8 0.0
condition 0 5 0.0
subroutine 4 9 44.4
pod 0 4 0.0
total 16 67 23.8


line stmt bran cond sub pod time code
1             package POE::Filter::YahooMessengerPacket;
2 1     1   172545 use strict;
  1         2  
  1         38  
3 1     1   568 use POE::Component::YahooMessenger::Constants;
  1         2  
  1         208  
4 1     1   589 use POE::Component::YahooMessenger::Event;
  1         4  
  1         70  
5              
6             sub new {
7 0     0 0   my $class = shift;
8 0           bless {
9             buffer => '',
10             get_state => 'header',
11             body_info => {},
12             identifier => undef,
13             }, $class;
14             }
15              
16 1     1   6 use constant DEBUG => 0;
  1         2  
  1         615  
17 0     0 0   sub Dumper { require Data::Dumper; Data::Dumper::Dumper(@_) }
  0            
18              
19             sub get {
20 0     0 0   my($self, $stream) = @_;
21 0           $self->{buffer} .= join '', @$stream;
22              
23 0 0         if ($self->{get_state} eq 'header') {
24             # not enough header bytes
25 0 0         return [] if length($self->{buffer}) < 20;
26              
27 0           my $header = substr $self->{buffer}, 0, 20, '';
28 0           my($signature, $version, $length, $event_code, $option, $identifier)
29             = unpack "a4Cx3nnNN", $header;
30 0 0         if ($signature ne $MessageHeader) {
31 0           _carp("signateure mismatch: $signature");
32 0           return [];
33             }
34 0   0       $self->{identifier} ||= $identifier;
35              
36             # switch to body mode
37 0           $self->{get_state} = 'body';
38 0           $self->{body_info} = {
39             length => $length,
40             event_code => $event_code,
41             identifier => $identifier,
42             };
43             }
44              
45             # not enough body bytes
46 0 0         return [] if length($self->{buffer}) < $self->{body_info}->{length};
47              
48             # we have enough body bytes
49 0           my $body = substr $self->{buffer}, 0, $self->{body_info}->{length}, '';
50 0           $self->{get_state} = 'header';
51              
52 0           my $event = POE::Component::YahooMessenger::Event->new_from_body(
53             $self->{body_info}->{event_code}, $body,
54             );
55 0           DEBUG and warn("GET: ", Dumper($event));
56 0           return [ $event ];
57             }
58              
59             sub put {
60 0     0 0   my($self, $events) = @_;
61 0           return [ map $self->_put($_), @$events ];
62             }
63              
64             sub _put {
65 0     0     my($self, $event) = @_;
66 0           DEBUG and warn("PUT: ", Dumper($event));
67 0           my $body = $event->body;
68 0   0       my $header = pack(
69             "a4Cx3nnNN",
70             $MessageHeader, 9, length($body), $event->code, $event->option, $self->{identifier} || 0,
71             );
72 0           return $header. $body;
73             }
74              
75             1;