File Coverage

blib/lib/Net/WAMP/Base/Message.pm
Criterion Covered Total %
statement 35 37 94.5
branch 7 10 70.0
condition 2 5 40.0
subroutine 9 9 100.0
pod 0 4 0.0
total 53 65 81.5


line stmt bran cond sub pod time code
1             package Net::WAMP::Base::Message;
2              
3 1     1   377 use strict;
  1         2  
  1         22  
4 1     1   4 use warnings;
  1         2  
  1         18  
5              
6 1     1   337 use Net::WAMP::Messages ();
  1         8  
  1         18  
7              
8 1     1   5 use constant NUMERIC => ();
  1         1  
  1         41  
9              
10 1     1   4 use constant HAS_AUXILIARY => 0;
  1         1  
  1         352  
11              
12             sub new {
13 8     8 0 9789 my ($class, @args) = @_;
14              
15 8         29 my @parts = $class->PARTS();
16              
17 8         27 my $self = { map { ( "_$parts[$_]" => $args[$_] ) } 0 .. $#args };
  22         55  
18              
19 8 100 50     37 $self->{'_Auxiliary'} ||= {} if $class->HAS_AUXILIARY();
20              
21 8         29 return bless $self, $class;
22             }
23              
24             sub get {
25 13     13 0 11560 my ($self, $key) = @_;
26              
27 13 100 33     38 if (grep { $_ eq $key } $self->PARTS()) {
  50 50       92  
28 12         51 return $self->{"_$key"};
29             }
30             elsif ( $key eq 'Options' or $key eq 'Details' ) {
31 1         4 return $self->{'_Auxiliary'};
32             }
33              
34 0         0 my $name = $self->get_type();
35 0         0 die "Unrecognized attribute of “$name” message: “$key”";
36             }
37              
38             sub get_type {
39 10     10 0 17 my ($self) = @_;
40              
41 10 50       49 ref($self) =~ m<.+::(.+)> or die "module name ($self)??";
42              
43 10         42 return $1;
44             }
45              
46             #Leaving this undocumented since there’s no good reason to want to
47             #use it from an application. (Right?)
48             sub to_unblessed {
49 4     4 0 7 my ($self) = @_;
50              
51             #So that our serializer will send these correctly.
52             #Other languages actually care about the difference...:-/
53 4         20 for my $num_label ( $self->NUMERIC() ) {
54 3         13 $self->{"_$num_label"} += 0;
55             }
56              
57             my @msg = (
58             Net::WAMP::Messages::get_type_number( $self->get_type() ),
59 4 50       12 ( map { exists($self->{"_$_"}) ? $self->{"_$_"} : () } $self->PARTS() ),
  11         37  
60             );
61              
62 4         14 return \@msg;
63             }
64              
65             1;