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
13package Net::STOMP::Client::Peer;
14use strict;
15use warnings;
16our $VERSION  = "2.3";
17our $REVISION = sprintf("%d.%02d", q$Revision: 2.1 $ =~ /(\d+)\.(\d+)/);
18
19#
20# used modules
21#
22
23use Params::Validate qw(validate :types);
24
25#
26# constants
27#
28
29use constant I_PROTO => 0;
30use constant I_HOST  => 1;
31use constant I_PORT  => 2;
32use constant I_ADDR  => 3;
33
34#+++############################################################################
35#                                                                              #
36# constructor                                                                  #
37#                                                                              #
38#---############################################################################
39
40my %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
60sub new : method {
61    my($class, %option, $object);
62
63    $class = shift(@_);
64    %option = validate(@_, \%new_options);
65    $object = [ @option{ qw(proto host port addr) } ];
66    return(bless($object, $class));
67}
68
69#+++############################################################################
70#                                                                              #
71# getters                                                                      #
72#                                                                              #
73#---############################################################################
74
75sub proto : method {
76    my($self) = @_;
77
78    return($self->[I_PROTO]);
79}
80
81sub host : method {
82    my($self) = @_;
83
84    return($self->[I_HOST]);
85}
86
87sub port : method {
88    my($self) = @_;
89
90    return($self->[I_PORT]);
91}
92
93sub addr : method {
94    my($self) = @_;
95
96    return($self->[I_ADDR]);
97}
98
99sub uri : method {
100    my($self) = @_;
101
102    return(sprintf("%s://%s:%s", @{ $self }[I_PROTO, I_HOST, I_PORT]));
103}
104
1051;
106
107__END__
108
109=head1 NAME
110
111Net::STOMP::Client::Peer - Peer support for Net::STOMP::Client
112
113=head1 SYNOPSIS
114
115  use Net::STOMP::Client;
116  $stomp = Net::STOMP::Client->new(host => "127.0.0.1", port => 61613);
117  ...
118  $peer = $stomp->peer();
119  if ($peer) {
120      # we are indeed connected to a STOMP server
121      printf("server uri is %s\n", $peer->uri());
122  }
123
124=head1 DESCRIPTION
125
126This module is used internally by L<Net::STOMP::Client> before connection
127and also afterwards to expose information about the STOMP server that the
128client is connected to.
129
130=head1 METHODS
131
132This module provides the following methods:
133
134=over
135
136=item new([OPTIONS])
137
138return a new Net::STOMP::Client::Peer object (class method)
139
140=item proto([STRING])
141
142get the protocol
143
144=item host([STRING])
145
146get the host name or address
147
148=item port([STRING])
149
150get the port number
151
152=item addr([STRING])
153
154get the host numerical IP address
155
156=item uri()
157
158get the host URI in the form C<PROTO://HOST:PORT>
159
160=back
161
162=head1 SEE ALSO
163
164L<Net::STOMP::Client>.
165
166=head1 AUTHOR
167
168Lionel Cons L<http://cern.ch/lionel.cons>
169
170Copyright (C) CERN 2010-2017
171