File: | lib/ZMQx/Class/Socket.pm |
Coverage: | 97.6% |
line | stmt | bran | cond | sub | time | code |
---|---|---|---|---|---|---|
1 | package ZMQx::Class::Socket; | |||||
2 | 4 4 4 | 7 4 63 | use strict; | |||
3 | 4 4 4 | 8 2 47 | use warnings; | |||
4 | 4 4 4 | 39 7 74 | use 5.010; | |||
5 | ||||||
6 | # ABSTRACT: A ZMQ Socket | |||||
7 | ||||||
8 | 4 4 4 | 834 1932958 59 | use Moose; | |||
9 | 4 4 4 | 38946 8 135 | use Carp qw(croak); | |||
10 | 4 4 4 | 780 14447 49 | use namespace::autoclean; | |||
11 | 4 4 4 | 318 4 52 | use Package::Stash; | |||
12 | 4 4 4 | 765 10221 337 | use ZMQ::LibZMQ3; | |||
13 | ||||||
14 | 4 4 4 | 17 3 57 | use ZMQ::Constants ':all'; | |||
15 | ||||||
16 | has 'socket' => ( | |||||
17 | is=>'ro', | |||||
18 | isa=>'ZMQ::LibZMQ3::Socket', | |||||
19 | required=>1, | |||||
20 | ); | |||||
21 | ||||||
22 | has 'type' => ( | |||||
23 | is=>'ro', | |||||
24 | required=>1, | |||||
25 | ); | |||||
26 | ||||||
27 | sub bind { | |||||
28 | 6 | 11 | my ($self, $address) = @_; | |||
29 | 6 | 98 | zmq_bind($self->socket,$address); | |||
30 | } | |||||
31 | ||||||
32 | sub connect { | |||||
33 | 6 | 10 | my ($self, $address) = @_; | |||
34 | 6 | 96 | zmq_connect($self->socket,$address); | |||
35 | } | |||||
36 | ||||||
37 | sub setsockopt { | |||||
38 | 1 | 80 | my $self = shift; | |||
39 | 1 | 18 | zmq_setsockopt($self->socket, @_); | |||
40 | } | |||||
41 | ||||||
42 | sub getsockopt { | |||||
43 | 1 | 318 | my $self = shift; | |||
44 | 1 | 17 | zmq_getsockopt($self->socket, @_); | |||
45 | } | |||||
46 | ||||||
47 | #sub send { | |||||
48 | # my ($self, $msg) = @_; | |||||
49 | # zmq_msg_send($msg, $self->socket); | |||||
50 | #} | |||||
51 | # | |||||
52 | #sub send_multipart { # remove, make send smarter | |||||
53 | # my ($self, @parts) = @_; | |||||
54 | # my $socket = $self->socket; | |||||
55 | # my $last = pop(@parts); | |||||
56 | # foreach (@parts) { | |||||
57 | # zmq_msg_send( $_, $socket, ZMQ_SNDMORE ); | |||||
58 | # } | |||||
59 | # zmq_msg_send($last, $socket ); | |||||
60 | #} | |||||
61 | ||||||
62 | sub send { | |||||
63 | 6 | 1005846 | my ($self, $parts, $flags) = @_; | |||
64 | 6 | 17 | $flags //= 0; | |||
65 | ||||||
66 | 6 6 | 7 10 | my $max_idx = $#{$parts}; | |||
67 | 6 | 13 | if ($max_idx == 0) { # single part message | |||
68 | 2 | 38 | return zmq_msg_send($parts->[0], $self->socket, $flags); | |||
69 | } | |||||
70 | ||||||
71 | # multipart | |||||
72 | 4 | 108 | my $socket = $self->socket; | |||
73 | 4 | 11 | my $mflags = $flags ? $flags | ZMQ_SNDMORE : ZMQ_SNDMORE; | |||
74 | 4 | 14 | foreach (0 .. $max_idx - 1) { | |||
75 | 4 | 77 | zmq_msg_send( $parts->[$_], $socket, $mflags); | |||
76 | } | |||||
77 | 4 | 257 | zmq_msg_send( $parts->[$max_idx], $socket, $flags); | |||
78 | } | |||||
79 | ||||||
80 | sub receive_multipart { | |||||
81 | 4 | 112 | my ($self, $blocking) = @_; | |||
82 | 4 | 98 | my $socket = $self->socket; | |||
83 | 4 | 7 | my @parts; | |||
84 | 4 | 263 | while ( my $rmsg = zmq_recvmsg( $socket, $blocking ? 0 : ZMQ_DONTWAIT)) { | |||
85 | 6 | 188 | push (@parts,zmq_msg_data( $rmsg )); | |||
86 | 6 | 169 | if (!zmq_getsockopt($socket, ZMQ_RCVMORE)) { | |||
87 | 4 | 294 | return \@parts; | |||
88 | } | |||||
89 | } | |||||
90 | } | |||||
91 | ||||||
92 | =method receive_all_multipart_messages | |||||
93 | ||||||
94 | my $w;$w = AnyEvent->io ( | |||||
95 | fh => $fh, | |||||
96 | poll => "r", | |||||
97 | cb => sub { | |||||
98 | my $msgs = receive_multipart_messages($pull); | |||||
99 | foreach (@$msgs) { | |||||
100 | say "got $_"; | |||||
101 | } | |||||
102 | }, | |||||
103 | ); | |||||
104 | ||||||
105 | =cut | |||||
106 | ||||||
107 | sub receive_all_multipart_messages { | |||||
108 | 2 | 155 | my ($self, $blocking) = @_; | |||
109 | 2 | 47 | my $socket = $self->socket; | |||
110 | 2 | 2 | my @parts; | |||
111 | 2 | 1 | my @msgs; | |||
112 | 2 | 27 | while (my $rmsg = zmq_recvmsg( $socket, $blocking ? 0 : ZMQ_DONTWAIT)) { | |||
113 | 6 | 150 | push (@parts,zmq_msg_data( $rmsg )); | |||
114 | 6 | 79 | if (! zmq_getsockopt($socket, ZMQ_RCVMORE)) { | |||
115 | 3 | 101 | push(@msgs,[ @parts ]); | |||
116 | 3 | 34 | undef @parts; | |||
117 | } | |||||
118 | } | |||||
119 | 2 | 12 | return \@msgs; | |||
120 | } | |||||
121 | ||||||
122 | sub wait_for_message { | |||||
123 | 1 | 1000272 | my $socket = shift; | |||
124 | 1 | 3 | my $msg; | |||
125 | 1 | 58 | my $got_message = AnyEvent->condvar; | |||
126 | 1 | 69 | my $fh = $socket->get_fh; | |||
127 | my $watcher = AnyEvent->io ( | |||||
128 | fh => $fh, | |||||
129 | poll => "r", | |||||
130 | cb => sub { | |||||
131 | 1 | 83 | $msg = $socket->receive_multipart; | |||
132 | 1 | 33 | $got_message->send; | |||
133 | }, | |||||
134 | 1 | 143 | ); | |||
135 | 1 | 70 | $got_message->recv; | |||
136 | 1 | 116 | return $msg; | |||
137 | } | |||||
138 | ||||||
139 | sub subscribe { | |||||
140 | 2 | 57 | my ($self, $subscribe) = @_; | |||
141 | 2 | 77 | croak('$socket->subscribe only works on SUB sockets') unless $self->type =~/^X?SUB$/; | |||
142 | 2 | 14 | croak('required paramater $subscription missing') unless defined $subscribe; | |||
143 | 2 | 56 | zmq_setsockopt($self->socket,ZMQ_SUBSCRIBE,$subscribe); | |||
144 | } | |||||
145 | ||||||
146 | sub get_fh { | |||||
147 | 3 | 7 | my $self = shift; | |||
148 | 3 | 101 | return zmq_getsockopt($self->socket, ZMQ_FD); | |||
149 | } | |||||
150 | ||||||
151 | { | |||||
152 | 4 4 4 | 2538 4 538 | no strict 'refs'; | |||
153 | my @sockopt_constants=qw(ZMQ_SNDHWM ZMQ_RCVHWM ZMQ_AFFINITY ZMQ_SUBSCRIBE ZMQ_UNSUBSCRIBE ZMQ_IDENTITY ZMQ_RATE ZMQ_RECOVERY_IVL ZMQ_SNDBUF ZMQ_RCVBUF ZMQ_LINGER ZMQ_RECONNECT_IVL ZMQ_RECONNECT_IVL_MAX ZMQ_BACKLOG ZMQ_MAXMSGSIZE ZMQ_MULTICAST_HOPS ZMQ_RCVTIMEO ZMQ_SNDTIMEO ZMQ_IPV4ONLY); | |||||
154 | my $stash = Package::Stash->new(__PACKAGE__); | |||||
155 | foreach my $const (@sockopt_constants) { | |||||
156 | my $get = my $set = lc($const); | |||||
157 | $set =~s/^zmq_/set_/; | |||||
158 | $get =~s/^zmq_/get_/; | |||||
159 | ||||||
160 | if ($stash->has_symbol('&'.$const)) { | |||||
161 | my $constval = &$const; | |||||
162 | $stash->add_symbol('&'.$set => sub { | |||||
163 | 1 | 573 | my $self = shift; | |||
164 | 1 | 18 | zmq_setsockopt($self->socket,$constval,@_); | |||
165 | 1 | 47 | return $self; | |||
166 | }); | |||||
167 | $stash->add_symbol('&'.$get => sub { | |||||
168 | 1 | 237 | my $self = shift; | |||
169 | 1 | 18 | return zmq_getsockopt($self->socket,$constval); | |||
170 | }); | |||||
171 | } | |||||
172 | } | |||||
173 | } | |||||
174 | 1; |