File Coverage

blib/lib/POE/Component/Server/Stomp.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             #
2             # Copyright 2007-2010 David Snopek <dsnopek@gmail.com>
3             #
4             # This program is free software: you can redistribute it and/or modify
5             # it under the terms of the GNU General Public License as published by
6             # the Free Software Foundation, either version 2 of the License, or
7             # (at your option) any later version.
8             #
9             # This program is distributed in the hope that it will be useful,
10             # but WITHOUT ANY WARRANTY; without even the implied warranty of
11             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12             # GNU General Public License for more details.
13             #
14             # You should have received a copy of the GNU General Public License
15             # along with this program. If not, see <http://www.gnu.org/licenses/>.
16             #
17              
18             package POE::Component::Server::Stomp;
19              
20 1     1   1987 use POE::Session;
  0            
  0            
21             use POE::Component::Server::TCP;
22             use POE::Filter::Stomp;
23             use IO::String;
24             use Net::Stomp::Frame;
25             use Carp qw(croak);
26             use vars qw($VERSION);
27             use strict;
28              
29             $VERSION = '0.2.3';
30              
31             sub new
32             {
33             my $class = shift;
34              
35             croak "$class->new() requires an even number of arguments" if (@_ & 1);
36              
37             my $args = { @_ };
38              
39             # TCP server options
40             my $alias = delete $args->{Alias};
41             my $address = delete $args->{Address};
42             my $hname = delete $args->{Hostname};
43             my $port = delete $args->{Port};
44             my $domain = delete $args->{Domain};
45              
46             if ( not defined $port )
47             {
48             # default Stomp port
49             $port = 61613;
50             }
51              
52             # user callbacks.
53             my $handle_frame = delete $args->{HandleFrame};
54             my $client_disconnected = delete $args->{ClientDisconnected};
55             my $client_error = delete $args->{ClientError};
56              
57             # A closure? In Perl!? Hrm...
58             my $client_input = sub
59             {
60             my ($kernel, $input) = @_[ KERNEL, ARG0 ];
61              
62             # Replace ARG0 with the parsed frame.
63             splice(@_, ARG0, 1, $input);
64              
65             # pass to the user handler
66             $handle_frame->(@_);
67             };
68              
69             # create the TCP server.
70             POE::Component::Server::TCP->new(
71             Alias => $alias,
72             Address => $address,
73             Hostname => $hname,
74             Port => $port,
75             Domain => $domain,
76              
77             ClientInput => $client_input,
78             ClientError => $client_error,
79             ClientDisconnected => $client_disconnected,
80              
81             # Use Keven Esteb's awesome Stomp filter module!
82             ClientFilter => "POE::Filter::Stomp",
83              
84             # pass everything left as arguments to the PoCo::Server::TCP
85             # contructor.
86             %$args
87             );
88              
89             # POE::Component::Server::TCP does it! So, I do it too.
90             return undef;
91             }
92              
93             1;
94              
95             __END__
96              
97             =pod
98              
99             =head1 NAME
100              
101             POE::Component::Server::Stomp - A generic Stomp server for POE
102              
103             =head1 SYNOPSIS
104              
105             use POE qw(Component::Server::Stomp);
106             use Net::Stomp::Frame;
107             use strict;
108              
109             POE::Component::Server::Stomp->new(
110             HandleFrame => \&handle_frame,
111             ClientDisconnected => \&client_disconnected,
112             ClientErrorr => \&client_error
113             );
114              
115             POE::Kernel->run();
116             exit;
117              
118             sub handle_frame
119             {
120             my ($kernel, $heap, $frame) = @_[ KERNEL, HEAP, ARG0 ];
121              
122             print "Recieved frame:\n";
123             print $frame->as_string() . "\n";
124              
125             # allow Stomp clients to connect by playing along.
126             if ( $frame->command eq 'CONNECT' )
127             {
128             my $response = Net::Stomp::Frame->new({
129             command => 'CONNECTED'
130             });
131             $heap->{client}->put( $response->as_string . "\n" );
132             }
133             }
134              
135             sub client_disconnected
136             {
137             my ($kernel, $heap) = @_[ KERNEL, HEAP ];
138              
139             print "Client disconnected\n";
140             }
141              
142             sub client_error
143             {
144             my ($kernel, $name, $number, $message) = @_[ KERNEL, ARG0, ARG1, ARG2 ];
145              
146             print "ERROR: $name $number $message\n";
147             }
148              
149             =head1 DESCRIPTION
150              
151             A thin layer over L<POE::Component::Server::TCP> that parses out L<Net::Stomp::Frame>s. The
152             synopsis basically covers everything you are capable to do.
153              
154             For information on the STOMP protocol:
155              
156             L<http://stomp.codehaus.org/Protocol>
157              
158             For a full-fledged message queue that uses this module:
159              
160             L<POE::Component::MessageQueue>
161              
162             =head1 SEE ALSO
163              
164             L<POE::Component::Server::TCP>,
165             L<POE::Filter::Stomp>,
166             L<Net::Stomp>
167              
168             =head1 BUGS
169              
170             Probably.
171              
172             =head1 AUTHORS
173              
174             Copyright 2007-2010 David Snopek.
175              
176             =cut
177