File Coverage

blib/lib/Net/WAMP/Role/Base/Client.pm
Criterion Covered Total %
statement 56 59 94.9
branch 6 12 50.0
condition 1 3 33.3
subroutine 14 14 100.0
pod 0 3 0.0
total 77 91 84.6


line stmt bran cond sub pod time code
1             package Net::WAMP::Role::Base::Client;
2              
3 1     1   354 use strict;
  1         1  
  1         21  
4 1     1   2 use warnings;
  1         1  
  1         17  
5              
6 1     1   398 use Module::Load ();
  1         947  
  1         18  
7              
8 1     1   4 use parent qw( Net::WAMP::Role::Base::Peer );
  1         1  
  1         8  
9              
10 1     1   55 use Net::WAMP::Session ();
  1         1  
  1         21  
11              
12 1     1   388 use Net::WAMP::Role::Base::Client::Features ();
  1         1  
  1         15  
13 1     1   286 use Net::WAMP::X ();
  1         2  
  1         25  
14              
15 1         79 use constant PEER_CAN_ACCEPT => (
16             __PACKAGE__->SUPER::PEER_CAN_ACCEPT(),
17             'HELLO',
18 1     1   5 );
  1         62  
19              
20             use constant {
21 1         336 DEFAULT_GOODBYE_REASON => 'wamp.error.close_realm',
22 1     1   5 };
  1         1  
23              
24             sub send_HELLO {
25 1     1 0 10 my ($self, $realm, $details_hr_in) = @_;
26              
27 1         6 my $details_hr = $self->GET_DETAILS_HR();
28              
29 1 50       3 if ($details_hr_in) {
30 1         2 Module::Load::load('Hash::Merge');
31 1         2410 $details_hr = Hash::Merge::merge( $details_hr, $details_hr_in );
32             }
33              
34              
35              
36 1         3309 return $self->_create_and_send_msg( 'HELLO', $realm, $details_hr );
37             }
38              
39             #Subclasses can safely override. They’ll probably want to call into
40             #this one as well and Hash::Merge their contents.
41             sub GET_DETAILS_HR {
42 1     1 0 1 my ($self) = @_;
43              
44 1         3 my $details_hr = {
45             roles => \%Net::WAMP::Role::Base::Client::Features::FEATURES,
46             };
47              
48 1 50       8 if (my $agent = $self->get_agent_string()) {
49 1         1 $details_hr->{'agent'} = $agent;
50             }
51              
52 1         3 return $details_hr;
53             }
54              
55             #----------------------------------------------------------------------
56              
57             sub _receive_WELCOME {
58 1     1   1 my ($self, $msg) = @_;
59              
60 1 50       7 if ( $self->{'_got_WELCOME'} ) {
61 0         0 $self->_ABORT_from_protocol_error('duplicate WELCOME');
62             }
63             else {
64 1         2 $self->{'_got_WELCOME'} = 1;
65              
66 1         6 my $roles_hr = $msg->get('Details')->{'roles'};
67 1 50       3 if (!$roles_hr) {
68 0         0 $self->_ABORT_from_protocol_error('missing “Details.roles”');
69             }
70             else {
71 1 50       3 if ( $self->{'_session_id'} = $msg->get('Session') ) {
72 1         5 $self->{'_session'}->set_peer_roles($roles_hr);
73 1         1 $self->{'_handshake_done'} = 1;
74             }
75             else {
76 0         0 $self->_ABORT_from_protocol_error('missing “Session”');
77             }
78             }
79             }
80              
81 1         2 return;
82             }
83              
84             #----------------------------------------------------------------------
85             # The below were originally in Peer.pm …
86             #----------------------------------------------------------------------
87              
88             #serialization
89             sub new {
90 1     1 0 29 my ($class, %opts) = @_;
91              
92 1         8 my $self = {
93             _session => Net::WAMP::Session->new(%opts),
94             };
95              
96 1         4 return bless $self, $class;
97             }
98              
99             #----------------------------------------------------------------------
100              
101             sub _check_peer_roles_before_send {
102 2     2   4 my ($self, $msg) = @_;
103              
104             #cache
105 2 50       8 if ($self->REQUIRE_STRICT_PEER_ROLES()) {
106 2   33     11 $self->{'_peer_groks_msg'}{$msg->get_type()} ||= do {
107 2         5 $self->_verify_receiver_can_accept_msg_type($msg->get_type());
108 2         5 1;
109             };
110             }
111              
112 2         4 return;
113             }
114              
115             1;