File Coverage

blib/lib/ZMQ/Raw/Loop/Event.pm
Criterion Covered Total %
statement 44 45 97.7
branch 12 12 100.0
condition 11 15 73.3
subroutine 13 15 86.6
pod 3 3 100.0
total 83 90 92.2


line stmt bran cond sub pod time code
1             package ZMQ::Raw::Loop::Event;
2             $ZMQ::Raw::Loop::Event::VERSION = '0.39';
3 14     14   98 use strict;
  14         23  
  14         395  
4 14     14   64 use warnings;
  14         25  
  14         315  
5 14     14   63 use Carp;
  14         22  
  14         703  
6 14     14   72 use Scalar::Util qw/weaken/;
  14         34  
  14         1290  
7              
8 0     0   0 sub CLONE_SKIP { 1 }
9              
10             my @attributes;
11              
12             BEGIN
13             {
14 14     14   80 @attributes = qw/
15             read_handle
16             write_handle
17             timeout
18             timer
19             on_set
20             on_timeout
21             /;
22              
23 14     14   120 no strict 'refs';
  14         34  
  14         1365  
24 14         33 foreach my $accessor (@attributes)
25             {
26 84         727 *{$accessor} = sub
27             {
28 264 100   264   2557 @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor}
        264      
        264      
        0      
29 84         402 };
30             }
31             }
32              
33 14     14   109 use ZMQ::Raw;
  14         29  
  14         5521  
34              
35             =head1 NAME
36              
37             ZMQ::Raw::Loop::Event - Event class
38              
39             =head1 VERSION
40              
41             version 0.39
42              
43             =head1 DESCRIPTION
44              
45             A L represents an event, usable in a
46             L.
47              
48             B: The API of this module is unstable and may change without warning
49             (any change will be appropriately documented in the changelog).
50              
51             =head1 SYNOPSIS
52              
53             use ZMQ::Raw;
54              
55             my $event = ZMQ::Raw::Loop::Event->new
56             (
57             $ctx,
58             on_set => sub
59             {
60             print "Event set!\n";
61             },
62             timeout => 10000,
63             on_timeout =>
64             {
65             print "Event timed out\n";
66             }
67             );
68              
69             my $timer = ZMQ::Raw::Loop::Timer->new
70             (
71             timer => ZMQ::Raw::Timer->new ($ctx, after => 100),
72             on_timeout => sub
73             {
74             $event->set;
75             },
76             );
77              
78             my $loop = ZMQ::Raw::Loop->new;
79             $loop->add ($event);
80             $loop->run;
81              
82             =head1 METHODS
83              
84             =head2 new( $context, %args )
85              
86             Create a new loop event
87              
88             =head2 set( )
89              
90             Set the event
91              
92             =head2 reset( )
93              
94             Reset the event
95              
96             =cut
97              
98             our $id = 0;
99              
100             sub new
101             {
102 10     10 1 2893 my ($this, $context, %args) = @_;
103              
104 10 100 66     62 if (!defined ($context) || ref ($context) ne 'ZMQ::Raw::Context')
105             {
106 1         169 croak "context not set or not a 'ZMQ::Raw::Context'";
107             }
108              
109 9 100 66     52 if (!$args{on_set} || ref ($args{on_set}) ne 'CODE')
110             {
111 1         105 croak "on_set not set or not a code ref";
112             }
113              
114 8 100 100     35 if ($args{on_timeout} && ref ($args{on_timeout}) ne 'CODE')
115             {
116 1         82 croak "on_timeout not a code ref";
117             }
118              
119 7 100 100     38 if ($args{on_timeout} && !exists ($args{timeout}))
120             {
121 1         80 croak "on_timeout provided but timeout not set";
122             }
123              
124 6         21 my $endpoint = "inproc://_loop_event-".(++$id);
125 6         42 my $read = ZMQ::Raw::Socket->new ($context, ZMQ::Raw->ZMQ_PAIR);
126 6         208 $read->bind ($endpoint);
127              
128 6         48 my $write = ZMQ::Raw::Socket->new ($context, ZMQ::Raw->ZMQ_PAIR);
129 6         281 $write->connect ($endpoint);
130              
131 6   33     43 my $class = ref ($this) || $this;
132             my $self =
133             {
134             read_handle => $read,
135             write_handle => $write,
136             timeout => $args{timeout},
137             on_set => $args{on_set},
138             on_timeout => $args{on_timeout},
139 6         43 };
140              
141 6         41 return bless $self, $class;
142             }
143              
144              
145              
146             sub set
147             {
148 15     15 1 60 my ($this) = @_;
149              
150 15         70 $this->write_handle->send ('', ZMQ::Raw->ZMQ_DONTWAIT);
151             }
152              
153              
154              
155             sub reset
156             {
157 21     21 1 52 my ($this) = @_;
158              
159 35 100       112 AGAIN:
160             goto AGAIN if (defined ($this->read_handle->recv (ZMQ::Raw->ZMQ_DONTWAIT)));
161             }
162              
163             =for Pod::Coverage read_handle write_handle timeout timer on_set on_timeout
164              
165             =head1 AUTHOR
166              
167             Jacques Germishuys
168              
169             =head1 LICENSE AND COPYRIGHT
170              
171             Copyright 2017 Jacques Germishuys.
172              
173             This program is free software; you can redistribute it and/or modify it
174             under the terms of either: the GNU General Public License as published
175             by the Free Software Foundation; or the Artistic License.
176              
177             See http://dev.perl.org/licenses/ for more information.
178              
179             =cut
180              
181             1; # End of ZMQ::Raw::Loop::Event