pax_global_header00006660000000000000000000000064115444103650014515gustar00rootroot0000000000000052 comment=171a77dd54468d53238bde98c4f8307019415307 libpoe-filter-stomp-perl-0.04/000077500000000000000000000000001154441036500162755ustar00rootroot00000000000000libpoe-filter-stomp-perl-0.04/Changes000066400000000000000000000014401154441036500175670ustar00rootroot00000000000000Revision history for Perl extension POE::Filter::Stomp. 0.01 Thu Aug 30 09:31:05 2007 - original version; created by h2xs 1.23 with options -Axc -n POE::Filter::Stomp 0.02 17-Dec-2007 K.Esteb Fixed the handling of large packets. The internal buffer was not being handled properly and large packets would be terminated. Added serveral tests, thanks lestrrat for providing the basic tests. 0.03 22-Jan-2008 K.Esteb Removed the test for pod-coverage. I don't use that style for writting documentation. Fixes a problem reported by the perl testers. 0.04 08-Apr-2010 K.Esteb Naveed Massjouni came across an issue with transfering frames between different OS's, specifically Windows and Unix. This release addresses that problem. libpoe-filter-stomp-perl-0.04/MANIFEST000066400000000000000000000004251154441036500174270ustar00rootroot00000000000000Changes Makefile.PL MANIFEST README t/01_load.t t/02_basic.t t/03_huge.t t/04_content.t t/05_put.t t/06_put_content.t t/07_pending.t t/08_nobody.t t/09_noheader.t t/99_pod.t lib/POE/Filter/Stomp.pm META.yml Module meta-data (added by MakeMaker) libpoe-filter-stomp-perl-0.04/META.yml000066400000000000000000000010621154441036500175450ustar00rootroot00000000000000--- #YAML:1.0 name: POE-Filter-Stomp version: 0.04 abstract: Perl extension for the POE Environment author: - Kevin L. Esteb license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Net::Stomp: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.52 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 libpoe-filter-stomp-perl-0.04/Makefile.PL000066400000000000000000000011021154441036500202410ustar00rootroot00000000000000use 5.008; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'POE::Filter::Stomp', VERSION_FROM => 'lib/POE/Filter/Stomp.pm', # finds $VERSION PREREQ_PM => {Net::Stomp => 0}, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/POE/Filter/Stomp.pm', # retrieve abstract from module AUTHOR => 'Kevin L. Esteb ') : ()), ); libpoe-filter-stomp-perl-0.04/README000066400000000000000000000013151154441036500171550ustar00rootroot00000000000000POE-Filter-Stomp version 0.04 ============================= This module is a input/output filter for the POE environemt. It will parse the input stream and create Net::Stomp::Frame objects. It will serialize the output stream from said objects. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: Net::Stomp COPYRIGHT AND LICENCE Copyright (C) 2007 by Kevin L. Esteb This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. libpoe-filter-stomp-perl-0.04/lib/000077500000000000000000000000001154441036500170435ustar00rootroot00000000000000libpoe-filter-stomp-perl-0.04/lib/POE/000077500000000000000000000000001154441036500174665ustar00rootroot00000000000000libpoe-filter-stomp-perl-0.04/lib/POE/Filter/000077500000000000000000000000001154441036500207135ustar00rootroot00000000000000libpoe-filter-stomp-perl-0.04/lib/POE/Filter/Stomp.pm000066400000000000000000000153341154441036500223610ustar00rootroot00000000000000# # File: Stomp.pm # Date: 30-Aug-2007 # By : Kevin Esteb # # This module will parse the input stream and create Net::Stomp::Frame # objects from that input stream. A STOMP frame looks like this: # # command # headers # # body # \000 # # notes for v0.04 # # The protocol spec calls for "newline" as the EOL. All implementatons # are translating this into "\n". This is fine, except that "\n" has # differing meanings depending on OS and/or language you are using. # This complicated matters when parsing packets. # # More information is located at http://stomp.codehaus.org/Protocol # package POE::Filter::Stomp; use 5.008; use strict; use warnings; use Net::Stomp::Frame; our $VERSION = '0.04'; # Be strick in what you send... use constant EOL => "\n"; use constant EOF => "\000"; # But lenient in what you recieve... my $eof = "\000"; my $eol = qr((\015\012?|\012\015?|\015|\012)); #my $eol = qr((\012|\015|\015\012?|\012\015?)); my $cntrl = qr((?:[[:cntrl:]])+); # --------------------------------------------------------------------- # Public methods # --------------------------------------------------------------------- sub new { my $proto = shift; my $self = {}; my $class = ref($proto) || $proto; $self->{buffer} = ""; bless($self, $class); return $self; } sub get_one_start { my ($self, $buffers) = @_; $buffers = [$buffers] unless (ref($buffers)); $self->{buffer} .= join('', @$buffers); } sub get_one { my ($self) = shift; my $frame; my $buffer; my @ret; $frame = $self->_parse_frame(); push(@ret, $frame) if ($frame); return \@ret; } sub get_pending { my ($self) = shift; return($self->{buffer}); } sub put { my ($self, $frames) = @_; my $string; my $ret = []; foreach my $frame (@$frames) { # protocol spec is unclear about the case of the command, # so uppercase the command, Why, just because I can. my $command = uc($frame->command); my $headers = $frame->headers; my $body = $frame->body; $string = $command . EOL; if ($headers->{bytes_message}) { delete $headers->{bytes_message}; $headers->{'content-length'} = length($body); } # protocol spec is unclear about spaces between headers and values # nor the case of the header, so add a space and lowercase the # header. Why, just because I can. while (my ($key, $value) = each %{$headers || {} }) { $string .= lc($key) . ': ' . $value . EOL; } $string .= EOL; $string .= $body || ''; $string .= EOF; push (@$ret, $string); } return $ret; } # --------------------------------------------------------------------- # Private methods # --------------------------------------------------------------------- sub _read_line { my ($self) = @_; my $buffer; if ($self->{buffer} =~ s/^(.+?)$eol//) { $buffer = $1; } return $buffer; } sub _parse_frame { my ($self) = @_; my $frame; my $length; my $clength; # check for a valid buffer, must have a EOL someplace return () if ($self->{buffer} !~ /$eol/); # read the command if (! $self->{command}) { if (my $command = $self->_read_line()) { $self->{command} = $command; } else { return (); } } # read the headers, parse until a double new line, # punt if they are not found. if (! $self->{headers}) { $self->{buffer} =~ m/$eol$eol/g; $clength = pos($self->{buffer}) || -1; if ($clength == -1) { pos($self->{buffer}) = 0; $self->{buffer} =~ m/$eol$eof/g; $clength = pos($self->{buffer}) || -1; } $length = length($self->{buffer}); return () if ($clength == -1); if ($clength <= $length) { my %headers = (); while (my $line = $self->_read_line()) { if ($line =~ /^([\w\-~]+)\s*:\s*(.*)/) { $headers{lc($1)} = $2; } } $self->{headers} = \%headers; $self->{buffer} =~ s/^$eol//; } else { return (); } } # read the body # # if "content-length" is defined then the body is binary, # otherwise search the buffer until an EOF is found. $clength = 0; $length = length($self->{buffer}); if ($self->{headers}->{'content-length'}) { $self->{headers}->{bytes_message} = 1; $clength = $self->{headers}->{'content-length'}; if ($clength <= $length) { $self->{body} = substr($self->{buffer}, 0, $clength); substr($self->{buffer}, 0, $clength) = ""; } else { return (); } } else { $clength = index($self->{buffer}, $eof); return () if ($clength == -1); if ($clength == 0) { $self->{body} = " "; } else { $self->{body} = substr($self->{buffer}, 0, $clength); substr($self->{buffer}, 0, $clength) = ""; } } # remove the crap from between the frames $self->{buffer} =~ s/$cntrl//; # create the frame if ($self->{command} && $self->{headers} && $self->{body}) { $frame = Net::Stomp::Frame->new( { command => $self->{command}, headers => $self->{headers}, body => $self->{body} } ); delete $self->{command}; delete $self->{headers}; delete $self->{body}; } return $frame; } 1; __END__ =head1 NAME POE::Filter::Stomp - Perl extension for the POE Environment =head1 SYNOPSIS use POE::Filter::Stomp; For a server POE::Component::Server::TCP->new( ... Filter => 'POE::Filter::Stomp', ... ); For a client POE::Component::Client::TCP->new( ... Filter => 'POE::Filter::Stomp', ... ); =head1 DESCRIPTION This module is a filter for the POE environment. It will translate the input buffer into Net::Stomp::Frame objects and serialize the output buffer from said objects. For more information an the STOMP protocol, please refer to: http://stomp.codehaus.org/Protocol . =head1 EXPORT None by default. =head1 SEE ALSO See the documentation for POE::Filter for usage. =head1 BUGS Quite possibly. It works for me, maybe it will work for you. =head1 AUTHOR Kevin L. Esteb, Ekesteb@wsipc.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2007 by Kevin L. Esteb This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available. =cut libpoe-filter-stomp-perl-0.04/t/000077500000000000000000000000001154441036500165405ustar00rootroot00000000000000libpoe-filter-stomp-perl-0.04/t/01_load.t000066400000000000000000000001771154441036500201510ustar00rootroot00000000000000use strict; use Test::More ; my @modules = qw(POE::Filter::Stomp); plan(tests => scalar(@modules)); use_ok($_) for @modules;libpoe-filter-stomp-perl-0.04/t/02_basic.t000066400000000000000000000017651154441036500203200ustar00rootroot00000000000000use strict; use Test::More (tests => 21); use Data::Dumper; BEGIN { use_ok("POE::Filter::Stomp"); } my $body = join( "\n", ("0123456789abcdefghijklmnopqrstuvwxyz0123456789abcdefghijklmnopqrstuvwxyz") x 10 ); my $message = join( "\n", "MESSAGE", "destination: /queue/foo", "", "$body\000", ); my $filter = POE::Filter::Stomp->new; for (1..2) { my @parts = split_message($message . "\n". $message); $filter->get_one_start(\@parts); for (1..2) { my $arrayref = $filter->get_one(); my $frame = $arrayref->[0]; ok($frame); isa_ok($frame, "Net::Stomp::Frame"); is($frame->command, "MESSAGE"); is($frame->headers->{destination}, "/queue/foo"); is($frame->body, $body); } } sub split_message { my $message = shift; my $len = length($message); my @ret; while ($len > 0) { push @ret, substr($message, 0, int(rand($len) + 1), ''); $len = length($message); } return @ret; } libpoe-filter-stomp-perl-0.04/t/03_huge.t000066400000000000000000000020041154441036500201530ustar00rootroot00000000000000use strict; use Test::More (tests => 21); BEGIN { use_ok("POE::Filter::Stomp"); } # This is bigger my $body = join( "\n", ("0123456789abcdefghijklmnopqrstuvwxyz0123456789abcdefghijklmnopqrstuvwxyz") x 2000 ); my $count = 1; my $message = join( "\n", "MESSAGE", "destination: /queue/foo", "", "$body\000", ); my $filter = POE::Filter::Stomp->new; for (1..2) { my @parts = split_message($message . "\n". $message); $filter->get_one_start(\@parts); for (1..2) { my $arrayref = $filter->get_one; my $frame = $arrayref->[0]; ok($frame); isa_ok($frame, "Net::Stomp::Frame"); is($frame->command, "MESSAGE"); is($frame->headers->{destination}, "/queue/foo"); is($frame->body, $body); } } sub split_message { my $message = shift; my $len = length($message); my @ret; while ($len > 0) { push @ret, substr($message, 0, int(rand($len) + 1), ''); $len = length($message); } return @ret; } libpoe-filter-stomp-perl-0.04/t/04_content.t000066400000000000000000000017001154441036500207000ustar00rootroot00000000000000use strict; use Test::More (tests => 13); BEGIN { use_ok("POE::Filter::Stomp"); } my $body = join( "\n", ("0123456789abcdefghijklmnopqrstuvwxyz0123456789abcdefghijklmnopqrstuvwxyz") x 10 ); my $length = length($body); my $message = join( "\n", "MESSAGE", "destination: /queue/foo", "content-length: " . $length, "", "$body\000", ); my $filter = POE::Filter::Stomp->new; for (1..2) { my @parts = split_message($message . "\n" . $message); $filter->get_one_start(\@parts); for (1..2) { my $arrayref = $filter->get_one; my $frame = $arrayref->[0]; ok($frame); isa_ok($frame, "Net::Stomp::Frame"); is( $frame->body, $body ); } } sub split_message { my $message = shift; my $len = length($message); my @ret; while ($len > 0) { push @ret, substr($message, 0, int(rand($len) + 1), ''); $len = length($message); } return @ret; } libpoe-filter-stomp-perl-0.04/t/05_put.t000066400000000000000000000021401154441036500200360ustar00rootroot00000000000000use strict; use Test::More (tests => 11); use Data::Dumper; BEGIN { use_ok("POE::Filter::Stomp"); } my $body = join( "\n", ("0123456789abcdefghijklmnopqrstuvwxyz0123456789abcdefghijklmnopqrstuvwxyz") x 10 ); my $message = join( "\n", "MESSAGE", "destination: /queue/foo", "", "$body\000", ); my @parts = split_message($message . "\n" . $message); my $filter = POE::Filter::Stomp->new; $filter->get_one_start(\@parts); for(1..2) { my @buffers; my $arrayref = $filter->get_one; my $frame = $arrayref->[0]; ok($frame); isa_ok($frame, "Net::Stomp::Frame"); is( $frame->body, $body ); @buffers = $filter->put([$frame]); for my $buffer (@buffers) { $filter->get_one_start($buffer); $arrayref = $filter->get_one; $frame = $arrayref->[0]; ok($frame); isa_ok($frame, "Net::Stomp::Frame") } } sub split_message { my $message = shift; my $len = length($message); my @ret; while ($len > 0) { push @ret, substr($message, 0, int(rand($len) + 1), ''); $len = length($message); } return @ret; } libpoe-filter-stomp-perl-0.04/t/06_put_content.t000066400000000000000000000022351154441036500215760ustar00rootroot00000000000000use strict; use Test::More (tests => 11); use Data::Dumper; BEGIN { use_ok("POE::Filter::Stomp"); } my $body = join( "\n", ("0123456789abcdefghijklmnopqrstuvwxyz0123456789abcdefghijklmnopqrstuvwxyz") x 10 ); my $length = length($body); my $message = join( "\n", "MESSAGE", "destination: /queue/foo", "content-length: " . $length, "", "$body\000", ); my @parts = split_message($message . "\n" . $message); my $filter = POE::Filter::Stomp->new; $filter->get_one_start(\@parts); for(1..2) { my @buffers; my $arrayref = $filter->get_one; my $frame = $arrayref->[0]; ok($frame); isa_ok($frame, "Net::Stomp::Frame"); is( $frame->body, $body ); @buffers = $filter->put([$frame]); for my $buffer (@buffers) { $filter->get_one_start($buffer); $arrayref = $filter->get_one; $frame = $arrayref->[0]; ok($frame); isa_ok($frame, "Net::Stomp::Frame") } } sub split_message { my $message = shift; my $len = length($message); my @ret; while ($len > 0) { push @ret, substr($message, 0, int(rand($len) + 1), ''); $len = length($message); } return @ret; } libpoe-filter-stomp-perl-0.04/t/07_pending.t000066400000000000000000000015361154441036500206640ustar00rootroot00000000000000use strict; use Test::More (tests => 5); BEGIN { use_ok("POE::Filter::Stomp"); } my $body = join( "\n", ("0123456789abcdefghijklmnopqrstuvwxyz0123456789abcdefghijklmnopqrstuvwxyz") x 10 ); my $message = join( "\n", "MESSAGE", "destination: /queue/foo", "", "$body\000", ); my @parts = split_message($message . "\n" . $message); my $filter = POE::Filter::Stomp->new; $filter->get_one_start(\@parts); my $arrayref = $filter->get_one; my $frame = $arrayref->[0]; ok($frame); isa_ok($frame, "Net::Stomp::Frame"); is( $frame->body, $body ); my $buffer = $filter->get_pending; ok($buffer); sub split_message { my $message = shift; my $len = length($message); my @ret; while ($len > 0) { push @ret, substr($message, 0, int(rand($len) + 1), ''); $len = length($message); } return @ret; } libpoe-filter-stomp-perl-0.04/t/08_nobody.t000066400000000000000000000015161154441036500205310ustar00rootroot00000000000000use strict; use Test::More (tests => 17); use Data::Dumper; BEGIN { use_ok("POE::Filter::Stomp"); } my $message = join( "\n", "CONNECTED", "session: client-290", "", "\000", ); my $filter = POE::Filter::Stomp->new; for (1..2) { my @parts = split_message($message . $message); $filter->get_one_start(\@parts); for (1..2) { my $arrayref = $filter->get_one; my $frame = $arrayref->[0]; ok($frame); isa_ok($frame, "Net::Stomp::Frame"); is($frame->command, "CONNECTED"); is($frame->headers->{session}, "client-290"); } } sub split_message { my $message = shift; my $len = length($message); my @ret; while ($len > 0) { push @ret, substr($message, 0, int(rand($len) + 1), ''); $len = length($message); } return @ret; } libpoe-filter-stomp-perl-0.04/t/09_noheader.t000066400000000000000000000014141154441036500210220ustar00rootroot00000000000000use strict; use Test::More (tests => 19); use Data::Dumper; BEGIN { use_ok("POE::Filter::Stomp"); } my $message = join( "\n", "DISCONNECT", "", "\000", ); my $filter = POE::Filter::Stomp->new; for (1..2) { my @parts = split_message($message . $message. $message); $filter->get_one_start(\@parts); for (1..3) { my $arrayref = $filter->get_one; my $frame = $arrayref->[0]; ok($frame); isa_ok($frame, "Net::Stomp::Frame"); is($frame->command, "DISCONNECT"); } } sub split_message { my $message = shift; my $len = length($message); my @ret; while ($len > 0) { push @ret, substr($message, 0, int(rand($len) + 1), ''); $len = length($message); } return @ret; } libpoe-filter-stomp-perl-0.04/t/99_pod.t000066400000000000000000000004201154441036500200240ustar00rootroot00000000000000use Test::More; use strict; if (! $ENV{TEST_POD}) { plan skip_all => "Enable TEST_POD environment variable to test POD"; } else { eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; Test::Pod::all_pod_files_ok(); }