root/POE-Component-Client-MSN/trunk/lib/POE/Filter/MSN.pm

Revision 926 (checked in by miyagawa, 17 years ago)

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 package POE::Filter::MSN;
2 use strict;
3
4 use POE qw(Component::Client::MSN::Command);
5
6 use vars qw($Debug);
7 $Debug = 1;
8
9 sub Dumper { require Data::Dumper; local $Data::Dumper::Indent = 1; Data::Dumper::Dumper(@_) }
10
11 sub new {
12     my $class = shift;
13     bless {
14         buffer => '',
15         get_state => 'line',
16         body_info => {},
17     }, $class;
18 }
19
20 sub get {
21     my($self, $stream) = @_;
22     $self->{buffer} .= join '', @$stream;
23     my @commands;
24     if ($self->{get_state} eq 'line') {
25         while ($self->{buffer} =~ s/^(.{3}) (?:(\d+) )?(.*?)\r\n//){
26             my $command =  POE::Component::Client::MSN::Command->new($1, $3, $2);
27             if ($command->name eq 'MSG') {
28                 # switch to body
29                 $self->{get_state} = 'body';
30                 $self->{body_info} = {
31                     command => $command,
32                     length  => $command->args->[2],
33                 };
34                 last;
35             } else {
36                 push @commands, $command;
37             }
38         }
39     }
40
41     if ($self->{get_state} eq 'body') {
42         if (length($self->{buffer}) < $self->{body_info}->{length}) {
43             # not enough bytes
44             $Debug and warn Dumper \@commands;
45             return \@commands;
46         }
47         my $message = substr($self->{buffer}, 0, $self->{body_info}->{length}, '');
48         my $command = $self->{body_info}->{command};
49         $command->message($message);
50         push @commands, $command;
51
52         # switch to head
53         $self->{get_state} = 'line';
54     }
55     $Debug and warn "GET: ", Dumper \@commands;
56     return \@commands;
57 }
58
59 sub put {
60     my($self, $commands) = @_;
61     return [ map $self->_put($_), @$commands ];
62 }
63
64 sub _put {
65     my($self, $command) = @_;
66     $Debug and warn "PUT: ", Dumper $command;
67     return sprintf "%s %d %s%s",
68         $command->name, $command->transaction, $command->data, ($command->no_newline ? '' : "\r\n");
69 }
70
71 1;
72
Note: See TracBrowser for help on using the browser.