File Coverage

blib/lib/Tickit/Async.pm
Criterion Covered Total %
statement 24 75 32.0
branch 0 4 0.0
condition 0 3 0.0
subroutine 8 19 42.1
pod n/a
total 32 101 31.6


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2011-2013 -- leonerd@leonerd.org.uk
5              
6             package Tickit::Async;
7              
8 5     5   232701 use strict;
  5         9  
  5         131  
9 5     5   17 use warnings;
  5         5  
  5         147  
10 5     5   26 use base qw( Tickit IO::Async::Notifier );
  5         6  
  5         4192  
11             Tickit->VERSION( '0.17' );
12             IO::Async::Notifier->VERSION( '0.43' ); # Need support for being a nonprinciple mixin
13              
14             our $VERSION = '0.20';
15              
16 5     5   60427 use IO::Async::Loop 0.47; # ->run and ->stop methods
  5         35518  
  5         166  
17 5     5   2383 use IO::Async::Signal;
  5         2491  
  5         118  
18 5     5   2921 use IO::Async::Stream;
  5         94901  
  5         215  
19 5     5   38 use IO::Async::Handle;
  5         9  
  5         113  
20 5     5   2612 use IO::Async::Timer::Countdown;
  5         7121  
  5         2555  
21              
22             =head1 NAME
23              
24             C - use C with C
25              
26             =head1 SYNOPSIS
27              
28             use IO::Async;
29             use Tickit::Async;
30              
31             my $tickit = Tickit::Async->new;
32              
33             # Create some widgets
34             # ...
35              
36             $tickit->set_root_widget( $rootwidget );
37              
38             my $loop = IO::Async::Loop->new;
39             $loop->add( $tickit );
40              
41             $tickit->run;
42              
43             =head1 DESCRIPTION
44              
45             This class allows a L user interface to run alongside other
46             L-driven code, using C as a source of IO events.
47              
48             As a shortcut convenience, a containing L will be constructed
49             using the default magic constructor the first time it is needed, if the object
50             is not already a member of a loop. This will allow a C object
51             to be used without being aware it is not a simple C object.
52              
53             To avoid accidentally creating multiple loops, callers should be careful to
54             C the C object to the main application's loop if one
55             already exists as soon as possible after construction.
56              
57             =cut
58              
59             sub new
60             {
61 0     0     my $class = shift;
62 0           my $self = $class->Tickit::new( @_ );
63              
64 0           $self->add_child( IO::Async::Signal->new(
65             name => "WINCH",
66             on_receipt => $self->_capture_weakself( "_SIGWINCH" ),
67             ) );
68              
69 0           $self->add_child( IO::Async::Handle->new(
70             read_handle => $self->term->get_input_handle,
71             on_read_ready => $self->_capture_weakself( "_input_readready" ),
72             ) );
73              
74 0           $self->add_child( $self->{timer} = IO::Async::Timer::Countdown->new(
75             on_expire => $self->_capture_weakself( "_timeout" ),
76             ) );
77              
78 0           return $self;
79             }
80              
81             sub get_loop
82             {
83 0     0     my $self = shift;
84 0   0       return $self->SUPER::get_loop || do {
85             my $newloop = IO::Async::Loop->new;
86             $newloop->add( $self );
87             $newloop;
88             };
89             }
90              
91             sub _make_writer
92             {
93 0     0     my $self = shift;
94 0           my ( $out ) = @_;
95              
96 0           my $writer = IO::Async::Stream->new(
97             write_handle => $out,
98             autoflush => 1,
99             );
100              
101 0           $self->add_child( $writer );
102              
103 0           return $writer;
104             }
105              
106             sub _input_readready
107             {
108 0     0     my $self = shift;
109 0           my $term = $self->term;
110              
111 0           $self->{timer}->stop;
112              
113 0           $term->input_readable;
114              
115 0           $self->_timeout;
116             }
117              
118             sub _timeout
119             {
120 0     0     my $self = shift;
121 0           my $term = $self->term;
122              
123 0 0         if( defined( my $timeout = $term->check_timeout ) ) {
124 0           $self->{timer}->configure( delay => $timeout / 1000 ); # msec
125 0           $self->{timer}->start;
126             }
127             }
128              
129             sub later
130             {
131 0     0     my $self = shift;
132 0           my ( $code ) = @_;
133              
134 0           $self->get_loop->later( $code );
135             }
136              
137             sub timer
138             {
139 0     0     my $self = shift;
140 0           my ( $mode, $amount, $code ) = @_;
141              
142 0           $self->get_loop->watch_time( $mode => $amount, code => $code );
143             }
144              
145             sub tick
146             {
147 0     0     my $self = shift;
148 0           $self->get_loop->loop_once;
149             }
150              
151             sub stop
152             {
153 0     0     my $self = shift;
154 0           $self->get_loop->stop;
155             }
156              
157             sub run
158             {
159 0     0     my $self = shift;
160              
161 0           my $loop = $self->get_loop;
162              
163 0           $self->setup_term;
164              
165 0           my $running = 1;
166              
167             $loop->add( my $sigint_notifier = IO::Async::Signal->new(
168             name => "INT",
169 0     0     on_receipt => $self->_capture_weakself( sub { undef $running }),
  0            
170             ) );
171              
172 0           my $ret = eval {
173 0           $self->_flush;
174 0           while($running) {
175 0           $loop->loop_once;
176 0           $self->_flush;
177             }
178             };
179 0           my $e = $@;
180              
181             {
182 0           local $@;
  0            
183              
184 0           $self->teardown_term;
185 0           $loop->remove( $sigint_notifier );
186             }
187              
188 0 0         die $@ if $@;
189 0           return $ret;
190             }
191              
192             =head1 AUTHOR
193              
194             Paul Evans
195              
196             =cut
197              
198             0x55AA;