| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Net::AMQP; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | =head1 NAME | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | Net::AMQP - Advanced Message Queue Protocol (de)serialization and representation | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | use Net::AMQP; | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | Net::AMQP::Protocol->load_xml_spec('amqp0-8.xml'); | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | ... | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | my @frames = Net::AMQP->parse_raw_frames(\$input); | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | ... | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | foreach my $frame (@frames) { | 
| 20 |  |  |  |  |  |  | if ($frame->can('method_frame') && $frame->method_frame->isa('Net::AMQP::Protocol::Connection::Start')) { | 
| 21 |  |  |  |  |  |  | my $output = Net::AMQP::Frame::Method->new( | 
| 22 |  |  |  |  |  |  | channel => 0, | 
| 23 |  |  |  |  |  |  | method_frame => Net::AMQP::Protocol::Connection::StartOk->new( | 
| 24 |  |  |  |  |  |  | client_properties => { ... }, | 
| 25 |  |  |  |  |  |  | mechanism         => 'AMQPLAIN', | 
| 26 |  |  |  |  |  |  | locale            => 'en_US', | 
| 27 |  |  |  |  |  |  | response          => { | 
| 28 |  |  |  |  |  |  | LOGIN    => 'guest', | 
| 29 |  |  |  |  |  |  | PASSWORD => 'guest', | 
| 30 |  |  |  |  |  |  | }, | 
| 31 |  |  |  |  |  |  | ), | 
| 32 |  |  |  |  |  |  | ); | 
| 33 |  |  |  |  |  |  | print OUT $output->to_raw_frame(); | 
| 34 |  |  |  |  |  |  | } | 
| 35 |  |  |  |  |  |  | } | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 38 |  |  |  |  |  |  |  | 
| 39 |  |  |  |  |  |  | This module implements the frame (de)serialization and representation of the Advanced Message Queue Protocol (http://www.amqp.org/).  It is to be used in conjunction with client or server software that does the actual TCP/IP communication. | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | =cut | 
| 42 |  |  |  |  |  |  |  | 
| 43 | 5 |  |  | 5 |  | 125375 | use strict; | 
|  | 5 |  |  |  |  | 10 |  | 
|  | 5 |  |  |  |  | 172 |  | 
| 44 | 5 |  |  | 5 |  | 25 | use warnings; | 
|  | 5 |  |  |  |  | 9 |  | 
|  | 5 |  |  |  |  | 125 |  | 
| 45 | 5 |  |  | 5 |  | 2681 | use Net::AMQP::Protocol; | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | use Net::AMQP::Frame; | 
| 47 |  |  |  |  |  |  | use Net::AMQP::Value; | 
| 48 |  |  |  |  |  |  | use Carp; | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | our $VERSION = 0.06; | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | use constant { | 
| 53 |  |  |  |  |  |  | _HEADER_LEN => 7,  # 'CnN' | 
| 54 |  |  |  |  |  |  | _FOOTER_LEN => 1,  # 'C' | 
| 55 |  |  |  |  |  |  | }; | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | =head1 CLASS METHODS | 
| 58 |  |  |  |  |  |  |  | 
| 59 |  |  |  |  |  |  | =head2 parse_raw_frames | 
| 60 |  |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  | Net::AMQP->parse_raw_frames(\$binary_payload) | 
| 62 |  |  |  |  |  |  |  | 
| 63 |  |  |  |  |  |  | Given a scalar reference to a binary string, return a list of L objects, consuming the data in the string.  Croaks on invalid input. | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  | =cut | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | sub parse_raw_frames { | 
| 68 |  |  |  |  |  |  | my ($class, $input_ref) = @_; | 
| 69 |  |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  | my @frames; | 
| 71 |  |  |  |  |  |  | while (length($$input_ref) >= _HEADER_LEN + _FOOTER_LEN) { | 
| 72 |  |  |  |  |  |  | my ($type_id, $channel, $size) = unpack 'CnN', $$input_ref; | 
| 73 |  |  |  |  |  |  | last if length($$input_ref) < _HEADER_LEN + $size + _FOOTER_LEN; | 
| 74 |  |  |  |  |  |  | substr $$input_ref, 0, _HEADER_LEN, ''; | 
| 75 |  |  |  |  |  |  |  | 
| 76 |  |  |  |  |  |  | my $payload = substr $$input_ref, 0, $size, ''; | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  | my $frame_end_octet = unpack 'C', substr $$input_ref, 0, _FOOTER_LEN, ''; | 
| 79 |  |  |  |  |  |  | if ($frame_end_octet != 206) { | 
| 80 |  |  |  |  |  |  | croak "Invalid frame-end octet ($frame_end_octet)"; | 
| 81 |  |  |  |  |  |  | } | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | push @frames, Net::AMQP::Frame->factory( | 
| 84 |  |  |  |  |  |  | type_id => $type_id, | 
| 85 |  |  |  |  |  |  | channel => $channel, | 
| 86 |  |  |  |  |  |  | payload => $payload, | 
| 87 |  |  |  |  |  |  | ); | 
| 88 |  |  |  |  |  |  | } | 
| 89 |  |  |  |  |  |  | return @frames; | 
| 90 |  |  |  |  |  |  | } | 
| 91 |  |  |  |  |  |  |  | 
| 92 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 93 |  |  |  |  |  |  |  | 
| 94 |  |  |  |  |  |  | L, L, L, | 
| 95 |  |  |  |  |  |  | L, L | 
| 96 |  |  |  |  |  |  |  | 
| 97 |  |  |  |  |  |  | =head1 AMQP VERSIONS | 
| 98 |  |  |  |  |  |  |  | 
| 99 |  |  |  |  |  |  | AMQP 0-8 is fully supported. | 
| 100 |  |  |  |  |  |  |  | 
| 101 |  |  |  |  |  |  | AMQP 0-9, 0-9-1, and 0-10 are usably supported.  There are interoperability | 
| 102 |  |  |  |  |  |  | issues with table encodings because the standard disagrees with the dialects of | 
| 103 |  |  |  |  |  |  | major implementations (RabbitMQ and Qpid).  For now, Net::AMQP limits itself to | 
| 104 |  |  |  |  |  |  | universally agreed table elements.  See | 
| 105 |  |  |  |  |  |  | L for details. | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  | AMQP 1.0 has not been tested. | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | =head1 TODO | 
| 110 |  |  |  |  |  |  |  | 
| 111 |  |  |  |  |  |  | Address the dialect problem, either via modified spec files that completely | 
| 112 |  |  |  |  |  |  | control the wire protocol, or by programmatic request.  The former has | 
| 113 |  |  |  |  |  |  | precedent (viz L), but could cause a combinatorial explosion | 
| 114 |  |  |  |  |  |  | as more brokers and versions are added.  The latter adds interface complexity. | 
| 115 |  |  |  |  |  |  |  | 
| 116 |  |  |  |  |  |  | =head1 QUOTES | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | "All problems in computer science can be solved by another level of indirection." -- David Wheeler's observation | 
| 119 |  |  |  |  |  |  |  | 
| 120 |  |  |  |  |  |  | "...except for the problem of too many layers of indirection." -- Kevlin Henney's corollary | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | =head1 COPYRIGHT | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | Copyright (c) 2009 Eric Waters and XMission LLC (http://www.xmission.com/). | 
| 125 |  |  |  |  |  |  | Copyright (c) 2012, 2013 Chip Salzenberg and Topsy Labs (http://labs.topsy.com/). | 
| 126 |  |  |  |  |  |  | All rights reserved. | 
| 127 |  |  |  |  |  |  |  | 
| 128 |  |  |  |  |  |  | This program is free software; you can redistribute it and/or modify it under | 
| 129 |  |  |  |  |  |  | the same terms as Perl itself.  The full text of the license can be found in | 
| 130 |  |  |  |  |  |  | the LICENSE file included with this module. | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | =head1 AUTHOR | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | Eric Waters | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  | =cut | 
| 137 |  |  |  |  |  |  |  | 
| 138 |  |  |  |  |  |  | 1; |