File Coverage

lib/Mojo/Reactor/Glib.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Mojo::Reactor::Glib;
2 1     1   18328 use Mojo::Base 'Mojo::Reactor';
  1         6879  
  1         6  
3              
4 1     1   53945 use strict;
  1         2  
  1         23  
5 1     1   4 use warnings;
  1         5  
  1         23  
6              
7 1     1   258 use Glib;
  0            
  0            
8              
9             =head1 NAME
10              
11             Mojo::Reactor::Glib - Glib::MainLoop backend for Mojo
12              
13             =head1 VERSION
14              
15             Version 0.002
16              
17             I hope I need not to emphasise that this is in VERY EARLY STAGES OF DEVELOPMENT.
18              
19             =cut
20              
21             our $VERSION = '0.002';
22              
23             =head1 SYNOPSIS
24              
25             B is a backend for L, build on top of the L main loop,
26             allowing you to use various Mojo(licious) modules within a Glib or Gtk program.
27              
28             BEGIN {
29             $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Glib';
30             }
31              
32             use Gtk2 -init;
33             use Mojo::UserAgent;
34              
35             my $ua = Mojo::UserAgent->new();
36              
37             Glib::Timeout->add(1000, sub {
38             $ua->get('http://example.com/' => sub {
39             my ($ua, $tx) = @_;
40             say $tx->res->body;
41             });
42             return Glib::SOURCE_CONTINUE;
43             });
44              
45             Gtk2->main();
46              
47             =cut
48              
49             my $Glib;
50             $ENV{MOJO_REACTOR} ||= 'Mojo::Reactor::Glib';
51              
52             sub CLONE {
53             die "We don't work with ithreads.\n"; ## To be honest, I don't know, don't care, don't want.
54             }
55              
56             sub DESTROY {
57             undef $Glib;
58             }
59              
60             =head1 METHODS
61              
62             =head2 Mojo::Reactor::Glib->new()
63             X
64              
65             Just the constructor. You probably won't ever call it yourself.
66              
67             =cut
68             sub new {
69             my $class = shift;
70              
71             if ($Glib) {
72             return $Glib;
73             } else {
74             my $r = {
75             loop => undef,
76             timers => {},
77             io => {},
78             };
79             bless($r, $class);
80             $Glib = $r;
81             return $r;
82             }
83             }
84              
85             #####
86              
87             =head2 $r->again($id)
88             X
89              
90             Runs the timer known by C<$id> again
91              
92             =cut
93             sub again {
94             my $r = shift;
95             my ($id) = @_;
96              
97             if (my $s = $r->{timers}->{$id}) {
98             $r->_timer($s->{recurring}, $s->{after_sec}, $s->{cb});
99             }
100             }
101              
102             =head2 $r->io($handle, $cb)
103             X
104              
105             Assigns a callback function C<$cb> to the IO handle C<$handle>. This is required before you can use L.
106              
107             Returns the reactor C<$r> so you can chain the calls.
108              
109             =cut
110             sub io {
111             my $r = shift;
112             my ($handle, $cb) = @_;
113              
114             my $fd = fileno($handle);
115             $r->{io}->{$fd} //= {};
116             $r->{io}->{$fd}->{handle} = $handle;
117             $r->{io}->{$fd}->{cb} = $cb;
118              
119             return $r;
120             }
121              
122             =head2 $r->is_running()
123             X
124              
125             Returns true if the loop is running, otherwise returns false
126              
127             =cut
128             sub is_running {
129             my $r = shift;
130             return ($r->{loop} ? $r->{loop}->is_running() : 0);
131             }
132              
133             =head2 $r->one_tick()
134             X
135              
136             Does a single L iteration. Returns true if events were dispatched during this iteration
137             (whether or not they had been B events), false if nothing happened.
138              
139             =cut
140             sub one_tick {
141             my $r = shift;
142              
143             if ($r->{loop}) {
144             my $ctx = $r->{loop}->get_context();
145             $ctx && $ctx->iteration(Glib::FALSE);
146             }
147             }
148              
149             =head2 $r->recurring($after_sec, $cb)
150             X
151              
152             Starts a recurring timer that beats every C<$after_sec> seconds (N.B. Glib allows for millisecond granularity),
153             which will result in C<$cb> being fired.
154              
155             Returns the B ID that you can use to L the timer.
156              
157             See also L
158              
159             =cut
160             sub recurring {
161             my $r = shift;
162              
163             $r->_timer(Glib::SOURCE_CONTINUE, @_);
164             }
165              
166             =head2 $r->remove($id)
167             X
168              
169             Removes the timer identified by C<$id>, returning true if this was successful, and a false-ish value otherwise.
170              
171             =cut
172             sub remove {
173             my $r = shift;
174             my ($id) = @_;
175              
176             my $removed;
177             if (exists $r->{timers}->{$id}) {
178             $removed = Glib::Source->remove($id);
179             delete $r->{timers}->{$id};
180             }
181              
182             return $removed;
183             }
184              
185             =head2 $r->reset()
186             X
187              
188             Stops all timers and watches.
189              
190             =cut
191             sub reset {
192             my $r = shift;
193              
194             for my $id (keys %{$r->{timers}}) {
195             Glib::Source->remove($id);
196             delete $r->{timers}->{$id};
197             }
198             for my $fd (keys %{$r->{io}}) {
199             my $handle = $r->{io}->{$fd}->{handle};
200             $r->watch($handle, 0, 0);
201             }
202             }
203              
204             =head2 $r->start()
205             X
206              
207             Starts the loop if it isn't already running.
208              
209             =cut
210             sub start {
211             my $r = shift;
212              
213             if (not $r->{loop}) {
214             $r->{loop} = Glib::MainLoop->new(undef, Glib::FALSE);
215             }
216              
217             if ($r->{loop} and not $r->{loop}->is_running()) {
218             $r->{loop}->run();
219             }
220             }
221              
222             =head2 $r->stop()
223             X
224              
225             Stops the loop.
226              
227             =cut
228             sub stop {
229             my $r = shift;
230              
231             if ($r->{loop}) {
232             $r->{loop}->quit();
233             }
234             }
235              
236             =head2 $r->timer($after_sec, $cb)
237             X
238              
239             Starts a one-shot timer that beats after C<$after_sec> seconds (N.B. Glib allows for millisecond granularity),
240             which will result in C<$cb> being fired.
241              
242             Returns the B ID that you can use to L or L the timer.
243              
244             See also L.
245              
246             =cut
247             sub timer {
248             my $r = shift;
249              
250             $r->_timer(Glib::SOURCE_REMOVE, @_);
251             }
252              
253             =head2 $r->watch($handle, $read, $write)
254             X
255              
256             Adds an IO watch for C<$read> or C<$write> (booleans) on C<$handle>. If both C<$read>
257             and C<$write> are false, it removes the watch.
258              
259             Requires L to be run on C<$handle> first, as that associates the callback function with the handle.
260              
261             See also L.
262              
263             =cut
264             sub watch {
265             my $r = shift;
266             my ($handle, $read, $write) = @_;
267              
268             my $fd = fileno($handle);
269             my $io = $r->{io}->{$fd};
270              
271             if (not defined $io) {
272             return; ## Croak?
273             }
274              
275             if ($io->{id}) {
276             Glib::Source->remove($io->{id});
277             }
278              
279             if ($read or $write) {
280             my $watchlist = [
281             'hup', 'err',
282             ($read ? 'in' : ()),
283             ($write ? 'out' : ()),
284             ];
285             my $id = Glib::IO->add_watch($fd, $watchlist, sub {
286             my ($fd, $iocondition) = @_;
287             $io->{cb}->($r, $iocondition eq 'out' ? 1 : 0);
288              
289             return Glib::SOURCE_CONTINUE;
290             });
291             $io->{id} = $id;
292             }
293              
294             return $r;
295             }
296              
297              
298             sub _timer {
299             my $r = shift;
300             my ($recurring, $after_sec, $cb) = @_;
301              
302             $after_sec = 0 if $after_sec < 0;
303             my $after_ms = int($after_sec * 1000);
304              
305             my $id = Glib::Timeout->add($after_ms, sub {
306             $cb->();
307             return $recurring;
308             });
309              
310             $r->{timers}->{$id} = {
311             recurring => $recurring,
312             after_sec => $after_sec,
313             cb => $cb,
314             };
315              
316             return $id;
317             }
318              
319             =head1 AUTHOR
320              
321             Ralesk C<< >>
322              
323             =head1 BUGS
324              
325             Please report issues at L
326              
327             =head2 KNOWN ISSUES
328              
329             =over
330              
331             =item *
332              
333             Breaks on Win32, Mojo::UserAgent can't do non-blocking calls at least.
334              
335             =item *
336              
337             Can't latch onto an existing Gtk event loop (no API for that), not sure if we actually should be able to or if we're good here in a sub-loop.
338              
339             =back
340              
341             =head1 LICENCE AND COPYRIGHT
342              
343             Copyright (C) 2014 Henrik Pauli
344              
345             This program is free software; you can redistribute it and/or modify it
346             under the terms of the Artistic License (2.0). You may obtain a
347             copy of the full licence at:
348              
349             L
350              
351             =cut
352              
353             1; # End of Mojo::Reactor::Glib