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