File Coverage

blib/lib/Net/STOMP/Client/Peer.pm
Criterion Covered Total %
statement 26 37 70.2
branch n/a
condition n/a
subroutine 8 13 61.5
pod 6 6 100.0
total 40 56 71.4


line stmt bran cond sub pod time code
1             #+##############################################################################
2             # #
3             # File: Net/STOMP/Client/Peer.pm #
4             # #
5             # Description: Peer support for Net::STOMP::Client #
6             # #
7             #-##############################################################################
8              
9             #
10             # module definition
11             #
12              
13             package Net::STOMP::Client::Peer;
14 2     2   16 use strict;
  2         6  
  2         76  
15 2     2   10 use warnings;
  2         4  
  2         185  
16             our $VERSION = "2.5";
17             our $REVISION = sprintf("%d.%02d", q$Revision: 2.2 $ =~ /(\d+)\.(\d+)/);
18              
19             #
20             # used modules
21             #
22              
23 2     2   549 use Params::Validate qw(validate :types);
  2         9896  
  2         421  
24              
25             #
26             # constants
27             #
28              
29 2     2   17 use constant I_PROTO => 0;
  2         5  
  2         157  
30 2     2   13 use constant I_HOST => 1;
  2         4  
  2         128  
31 2     2   14 use constant I_PORT => 2;
  2         4  
  2         86  
32 2     2   12 use constant I_ADDR => 3;
  2         30  
  2         1170  
33              
34             #+++############################################################################
35             # #
36             # constructor #
37             # #
38             #---############################################################################
39              
40             my %new_options = (
41             "proto" => {
42             type => SCALAR,
43             regex => qr/^(tcp|ssl|stomp|stomp\+ssl)$/,
44             },
45             "host" => {
46             type => SCALAR,
47             regex => qr/^[a-z0-9\.\-\:]+$/,
48             },
49             "port" => {
50             type => SCALAR,
51             regex => qr/^\d+$/,
52             },
53             "addr" => {
54             optional => 1,
55             type => SCALAR,
56             regex => qr/^\d+\.\d+\.\d+\.\d+$/,
57             },
58             );
59              
60             sub new : method {
61 13     13 1 22 my($class, %option, $object);
62              
63 13         24 $class = shift(@_);
64 13         249 %option = validate(@_, \%new_options);
65 13         429 $object = [ @option{ qw(proto host port addr) } ];
66 13         66 return(bless($object, $class));
67             }
68              
69             #+++############################################################################
70             # #
71             # getters #
72             # #
73             #---############################################################################
74              
75             sub proto : method {
76 0     0 1   my($self) = @_;
77              
78 0           return($self->[I_PROTO]);
79             }
80              
81             sub host : method {
82 0     0 1   my($self) = @_;
83              
84 0           return($self->[I_HOST]);
85             }
86              
87             sub port : method {
88 0     0 1   my($self) = @_;
89              
90 0           return($self->[I_PORT]);
91             }
92              
93             sub addr : method {
94 0     0 1   my($self) = @_;
95              
96 0           return($self->[I_ADDR]);
97             }
98              
99             sub uri : method {
100 0     0 1   my($self) = @_;
101              
102 0           return(sprintf("%s://%s:%s", @{ $self }[I_PROTO, I_HOST, I_PORT]));
  0            
103             }
104              
105             1;
106              
107             __END__