File Coverage

blib/lib/Net/AMQP/Protocol/Base.pm

Criterion	Covered	Total	%
statement	13	58	22.4
branch	0	14	0.0
condition	0	11	0.0
subroutine	5	9	55.5
pod	2	4	50.0
total	20	96	20.8

package Net::AMQP::Protocol::Base;

=head1 NAME

Net::AMQP::Protocol::Base - Base class of auto-generated protocol classes

=head1 DESCRIPTION

See L for how subclasses to this class are auto-generated.

=cut

use strict;
use warnings;
use base qw(Class::Data::Inheritable Class::Accessor::Fast);

BEGIN {
    __PACKAGE__->mk_classdata($_) foreach qw(
        class_id
        method_id
        frame_arguments
        class_spec
        method_spec
    );
}

=head1 CLASS METHODS

=head2 class_id

The class id from the specficiation.

=head2 method_id

The method id from the specification.  In the case of a content  (such as Basic, File or Stream), method_id is 0 for the virtual ContentHeader method.  This allows you to create a Header frame in much the same way you create a Method frame, but with the virtual method 'ContentHeader'.  For example:

  my $header_frame = Net::AMQP::Protocol::Basic::ContentHeader->new(
    content_type => 'text/html'
  );

  print $header_frame->method_id(); # prints '0'

=head2 frame_arguments

Contains an ordered arrayref of the fields that comprise a frame for this method.  For example:

  Net::AMQP::Protocol::Channel::Open->frame_arguments([
      out_of_band => 'short_string'
  ]);

This is used by the L subclasses to (de)serialize raw binary data.  Each of these fields are also an accessor for the class objects.

=head2 class_spec

Contains the hashref that the C call generated for this class.

=head2 method_spec

Same as above, but for this method.

=back

=cut

sub new {
    my ($class, %self) = @_;

    return bless \%self, $class;
}

sub register {
    my $class = shift;

    # Inform the Frame::Method class of the existance of this method type
    if ($class->class_id && $class->method_id) {
        Net::AMQP::Frame::Method->register_method_class($class);
    }
    elsif ($class->class_id && ! $class->method_id) {
        Net::AMQP::Frame::Header->register_header_class($class);
    }

    # Create accessor methods in the subclass for frame data
    my @accessors;
    my $arguments = $class->frame_arguments;
    for (my $i = 0; $i <= $#{ $arguments }; $i += 2) {
        my ($key, $type) = ($arguments->[$i], $arguments->[$i + 1]);
        push @accessors, $key;
    }
    $class->mk_accessors(@accessors);
}

=head1 OBJECT METHODS

=head2 frame_wrap

Returns a L subclass object that wraps the given object, if possible.

=cut

sub frame_wrap {
    my $self = shift;

    if ($self->class_id && $self->method_id) {
        return Net::AMQP::Frame::Method->new( method_frame => $self );
    }
    elsif ($self->class_id) {
        return Net::AMQP::Frame::Header->new( header_frame => $self );
    }
    else {
        return $self;
    }
}

sub docs_as_pod {
    my $class = shift;
    my $package = __PACKAGE__;

    my $class_spec = $class->class_spec;
    my $method_spec = $class->method_spec;
    my $frame_arguments = $class->frame_arguments;

    my $description = "This is an auto-generated subclass of L<$package>; see the docs for that module for inherited methods.  Check the L below for details on the auto-generated methods within this class.\n";

    if ($class->method_id == 0) {
        my $base_class = 'Net::AMQP::Protocol::' . $class_spec->{name};
        $description .= "\n" . <
This class is not a real class of the AMQP spec.  Instead, it's a helper class that allows you to create L objects for L<$base_class> frames.
EOF
    }
    else {
        $description .= "\n" . "This class implements the class B<$$class_spec{name}> (id ".$class->class_id.") method B<$$method_spec{name}> (id ".$class->method_id."), which is ".($method_spec->{synchronous} ? 'a synchronous' : 'an asynchronous')." method\n";
    }

    my $synopsis_new_args = '';
    my $usage = <
 =head2 Fields and Accessors

Each of the following represents a field in the specification.  These are the optional arguments to B and are also read/write accessors.

 =over

EOF

    use Data::Dumper;
    #$usage .= Dumper($method_spec);

    foreach my $field_spec (@{ $method_spec->{fields} }) {
        my $type = $field_spec->{type}; # may be 'undef'
        if ($field_spec->{domain}) {
            $type = $Net::AMQP::Protocol::spec{domain}{ $field_spec->{domain} }{type};
        }

        my $local_name = $field_spec->{name};
        $local_name =~ s{ }{_}g;

        $field_spec->{doc} ||= '';

        $usage .= <
 =item I<$local_name> (type: $type)

$$field_spec{doc}

EOF

        $synopsis_new_args .= <
      $local_name => \$$local_name,
EOF
    }

    chomp $synopsis_new_args; # trailing \n

    $usage .= "=back\n\n";


    my $pod = <
 =pod

 =head1 NAME

$class - An auto-generated subclass of $package

 =head1 SYNOPSIS

  use $class;

  my \$object = $class\->new(
$synopsis_new_args
  );

 =head1 DESCRIPTION

$description

 =head1 USAGE

$usage

 =head1 SEE ALSO

L<$package>

EOF

    $pod =~ s{^ =}{=}gms;

    return $pod;
}

=head1 SEE ALSO

L

=head1 COPYRIGHT

Copyright (c) 2009 Eric Waters and XMission LLC (http://www.xmission.com/).  All rights reserved.  This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the LICENSE file included with this module.

=head1 AUTHOR

Eric Waters

=cut

1;