From 5a9062731842e3f0d5330c95f1a4eb21e1e6181c Mon Sep 17 00:00:00 2001 From: Bob Kleemann Date: Mon, 21 Jul 2014 11:39:11 -0700 Subject: [PATCH 1/5] Add support for additional field types --- lib/Net/AMQP/Common.pm | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/lib/Net/AMQP/Common.pm b/lib/Net/AMQP/Common.pm index 0b74e21..215c711 100644 --- a/lib/Net/AMQP/Common.pm +++ b/lib/Net/AMQP/Common.pm @@ -234,19 +234,29 @@ sub _pack_field_value { } my %_unpack_field_types = ( - V => sub { undef }, - S => \&unpack_long_string, - I => \&unpack_long_integer, + A => \&unpack_field_array, + B => \&unpack_unsigned_short_integer, + b => \&unpack_short_integer, D => sub { my $input_ref = shift; my $exp = unpack_octet($input_ref); my $num = unpack_long_integer($input_ref); $num / 10.0 ** $exp; }, + #d => \&unpack_double, F => \&unpack_field_table, - A => \&unpack_field_array, + #f => \&unpack_float, + I => \&unpack_long_integer, + i => \&unpack_unsigned_long_integer, + L => \&unpack_long_long_integer, + l => \&unpack_unsigned_long_long_integer, + S => \&unpack_long_string, + s => \&unpack_short_string, T => \&unpack_timestamp, t => \&unpack_boolean, + U => \&unpack_short_integer, + u => \&unpack_unsigned_short_integer, + V => sub { undef }, ); sub unpack_field_table { From a4da8cc03f40001313054de48f9592b4a0f2b5c4 Mon Sep 17 00:00:00 2001 From: Lubomir Host Date: Wed, 10 Jun 2015 20:51:28 +0200 Subject: [PATCH 2/5] Performance optimization. --- lib/Net/AMQP/Common.pm | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/lib/Net/AMQP/Common.pm b/lib/Net/AMQP/Common.pm index 215c711..eb26335 100644 --- a/lib/Net/AMQP/Common.pm +++ b/lib/Net/AMQP/Common.pm @@ -149,8 +149,7 @@ sub pack_timestamp { goto &pack_unsigned_long_long_integer } sub unpack_timestamp { goto &unpack_unsigned_long_long_integer } sub pack_short_string { - my $str = shift; - $str = '' unless defined $str; + my $str = $_[0] || ''; return pack('C', length $str) . $str; } @@ -167,8 +166,7 @@ sub pack_long_string { # Here for Connection::StartOk->response return pack_field_table(@_); } - my $str = shift; - $str = '' unless defined $str; + my $str = $_[0] || ''; return pack('N', length $str) . $str; } @@ -179,15 +177,14 @@ sub unpack_long_string { } sub pack_field_table { - my $table = shift; - $table = {} unless defined $table; - + my $table = $_[0] || {}; my $table_packed = ''; - foreach my $key (sort keys %$table) { # sort so I can compare raw frames - my $value = $table->{$key}; - $table_packed .= pack_short_string($key); - $table_packed .= _pack_field_value($table->{$key}); - } + + while( my ($key, $val) = each %{$table}) { + $table_packed .= pack_short_string($key); + $table_packed .= _pack_field_value($val); + } + return pack('N', length $table_packed) . $table_packed; } From 10c850f0df22b632eb4dc7f8800c318907e284f8 Mon Sep 17 00:00:00 2001 From: Lubomir Host Date: Wed, 10 Jun 2015 20:46:52 +0200 Subject: [PATCH 3/5] Performance optimization. Minimize calculations. --- lib/Net/AMQP.pm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lib/Net/AMQP.pm b/lib/Net/AMQP.pm index 733b429..e71818e 100644 --- a/lib/Net/AMQP.pm +++ b/lib/Net/AMQP.pm @@ -52,6 +52,7 @@ our $VERSION = 0.06; use constant { _HEADER_LEN => 7, # 'CnN' _FOOTER_LEN => 1, # 'C' + _HEADER_FOOTER_LEN => 8, # = _HEADER_LEN + _FOOTER_LEN }; =head1 CLASS METHODS @@ -68,9 +69,9 @@ sub parse_raw_frames { my ($class, $input_ref) = @_; my @frames; - while (length($$input_ref) >= _HEADER_LEN + _FOOTER_LEN) { + while (length($$input_ref) >= _HEADER_FOOTER_LEN) { my ($type_id, $channel, $size) = unpack 'CnN', $$input_ref; - last if length($$input_ref) < _HEADER_LEN + $size + _FOOTER_LEN; + last if length($$input_ref) < $size + _HEADER_FOOTER_LEN; substr $$input_ref, 0, _HEADER_LEN, ''; my $payload = substr $$input_ref, 0, $size, ''; From 21ac8bfcb5d7bcc2ddfc10fe99352e0d5bb0066b Mon Sep 17 00:00:00 2001 From: Lubomir Host Date: Wed, 10 Jun 2015 20:46:55 +0200 Subject: [PATCH 4/5] =?UTF-8?q?Performance=20optimization.=20Improved=20sp?= =?UTF-8?q?eed=20of=20Net::AMQP::Frame::factory()=20from=20avg=20138=C2=B5?= =?UTF-8?q?s/call=20to=20107=C2=B5s/call=20(+22%=20faster).?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/Net/AMQP.pm | 4 +--- lib/Net/AMQP/Frame.pm | 50 +++++++++++++++++++++++++++---------------- 2 files changed, 32 insertions(+), 22 deletions(-) diff --git a/lib/Net/AMQP.pm b/lib/Net/AMQP.pm index e71818e..c567745 100644 --- a/lib/Net/AMQP.pm +++ b/lib/Net/AMQP.pm @@ -82,9 +82,7 @@ sub parse_raw_frames { } push @frames, Net::AMQP::Frame->factory( - type_id => $type_id, - channel => $channel, - payload => $payload, + $type_id, $channel, $payload, ); } return @frames; diff --git a/lib/Net/AMQP/Frame.pm b/lib/Net/AMQP/Frame.pm index 2443ea0..b9e8c7f 100644 --- a/lib/Net/AMQP/Frame.pm +++ b/lib/Net/AMQP/Frame.pm @@ -47,9 +47,9 @@ sub new { =head2 factory Net::AMQP::Frame->factory( - type_id => 1, - channel => 1, - payload => '', + $type_id, # type_id => 1, + $channel, # channel => 1, + $payload, # payload => '', ); Will attempt to identify a L subclass for further parsing, and will croak on failure. Returns a L subclass object. @@ -57,32 +57,44 @@ Will attempt to identify a L subclass for further parsing, and =cut sub factory { - my ($class, %args) = @_; + my ($class, $type_id, $channel, $payload) = @_; - unless (exists $args{type_id}) { croak "Mandatory parameter 'type_id' missing in call to Net::AMQP::Frame::factory"; } - unless (exists $args{channel}) { croak "Mandatory parameter 'channel' missing in call to Net::AMQP::Frame::factory"; } - unless (exists $args{payload}) { croak "Mandatory parameter 'payload' missing in call to Net::AMQP::Frame::factory"; } - unless (keys %args == 3) { croak "Invalid parameter passed in call to Net::AMQP::Frame::factory"; } + unless (defined $type_id) { croak "Mandatory parameter 'type_id' missing in call to Net::AMQP::Frame::factory"; } my $subclass; - if ($args{type_id} == 1) { - $subclass = 'Method'; + if ($type_id == 1) { + $subclass = 'Net::AMQP::Frame::Method'; } - elsif ($args{type_id} == 2) { - $subclass = 'Header'; + elsif ($type_id == 2) { + $subclass = 'Net::AMQP::Frame::Header'; } - elsif ($args{type_id} == 3) { - $subclass = 'Body'; + elsif ($type_id == 3) { + unless (defined $channel) { croak "Mandatory parameter 'channel' missing in call to Net::AMQP::Frame::factory"; } + unless (defined $payload) { croak "Mandatory parameter 'payload' missing in call to Net::AMQP::Frame::factory"; } + + # see Net::AMQP::Frame::Body::parse_payload() - empty function + return bless { + type_id => $type_id, + channel => $channel, + payload => $payload, + }, 'Net::AMQP::Frame::Body'; } - elsif ($args{type_id} == 8) { - $subclass = 'Heartbeat'; + elsif ($type_id == 8) { + $subclass = 'Net::AMQP::Frame::Heartbeat'; } else { - croak "Unknown type_id $args{type_id}"; + croak "Unknown type_id $type_id"; } - $subclass = 'Net::AMQP::Frame::' . $subclass; - my $object = bless \%args, $subclass; + unless (defined $channel) { croak "Mandatory parameter 'channel' missing in call to Net::AMQP::Frame::factory"; } + unless (defined $payload) { croak "Mandatory parameter 'payload' missing in call to Net::AMQP::Frame::factory"; } + +#@ my $object = bless \%args, $subclass; + my $object = bless { + type_id => $type_id, + channel => $channel, + payload => $payload, + }, $subclass; $object->parse_payload(); return $object; } From add27b9d8d748598012d4f77831d67f05643d5f6 Mon Sep 17 00:00:00 2001 From: Lubomir Host Date: Wed, 10 Jun 2015 20:46:59 +0200 Subject: [PATCH 5/5] =?UTF-8?q?Performance=20optimalization.=20Don't=20cal?= =?UTF-8?q?l=20pack()=20inside=20another=20pack()=20function.=20Improved?= =?UTF-8?q?=20speed=20of=20Net::AMQP::Frame::to=5Fraw=5Fframe()=20from=202?= =?UTF-8?q?90=C2=B5s/call=20to=20254=C2=B5s/call=20(+15%=20faster).?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/Net/AMQP/Frame.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/Net/AMQP/Frame.pm b/lib/Net/AMQP/Frame.pm index b9e8c7f..aaf2845 100644 --- a/lib/Net/AMQP/Frame.pm +++ b/lib/Net/AMQP/Frame.pm @@ -135,13 +135,13 @@ sub to_raw_frame { my $self = shift; my $class = ref $self; - if (! defined $self->channel) { - $self->channel(0); - } + my $channel = ($self->channel || 0); + my $raw_payload = $self->to_raw_payload(); - return pack('Cn', $self->type_id, $self->channel) - . pack_long_string($self->to_raw_payload()) - . pack('C', 206); + return pack('CnN', $self->type_id, $channel, length($raw_payload)) + # . pack_long_string($raw_payload) = length($raw_payload) . $raw_payload + . $raw_payload + . "\x{ce}" # . "\x{ce}" = pack('C', 206); # faster, duration of pack() = 1usec } =head2 type_string