ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Event/Event.pm
(Generate patch)

Comparing Coro/Event/Event.pm (file contents):
Revision 1.2 by root, Fri Aug 17 01:45:39 2001 UTC vs.
Revision 1.41 by root, Fri Dec 1 02:17:37 2006 UTC

6 6
7 use Coro; 7 use Coro;
8 use Coro::Event; 8 use Coro::Event;
9 9
10 sub keyboard : Coro { 10 sub keyboard : Coro {
11 my $w = Coro::Event->io(fd => *STDIN, poll => 'r'); 11 my $w = Coro::Event->io(fd => \*STDIN, poll => 'r');
12 while() { 12 while() {
13 print "cmd> "; 13 print "cmd> ";
14 my $ev = $w->next; my $cmd = <STDIN>; 14 my $ev = $w->next; my $cmd = <STDIN>;
15 unloop unless $cmd ne ""; 15 unloop unless $cmd ne "";
16 print "data> "; 16 print "data> ";
17 my $ev = $w->next; my $data = <STDIN>; 17 my $ev = $w->next; my $data = <STDIN>;
18 } 18 }
19 } 19 }
20 20
21 &loop; 21 loop;
22 22
23=head1 DESCRIPTION 23=head1 DESCRIPTION
24 24
25This module enables you to create programs using the powerful Event model 25This module enables you to create programs using the powerful Event model
26(and module), while retaining the linear style known from simple or 26(and module), while retaining the linear style known from simple or
30(I<flavour>) (see L<Event>). The only difference between these and the 30(I<flavour>) (see L<Event>). The only difference between these and the
31watcher constructors from Event is that you do not specify a callback 31watcher constructors from Event is that you do not specify a callback
32function - it will be managed by this module. 32function - it will be managed by this module.
33 33
34Your application should just create all necessary coroutines and then call 34Your application should just create all necessary coroutines and then call
35Coro::Event->main. 35Coro::Event::loop.
36
37Please note that even programs or modules (such as
38L<Coro::Handle|Coro::Handle>) that use "traditional"
39event-based/continuation style will run more efficient with this module
40then when using only Event.
36 41
37=over 4 42=over 4
38 43
39=cut 44=cut
40 45
41package Coro::Event; 46package Coro::Event;
42 47
48BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") }
49
50use Carp;
43no warnings; 51no warnings;
44 52
45use Carp; 53use Coro;
54use Coro::Timer;
55use Event qw(loop unloop); # we are re-exporting this, cooool!
46 56
47use Coro; 57use XSLoader;
48use Event qw(unloop); # we are re-exporting this, cooool!
49 58
50use base 'Exporter'; 59use base Exporter::;
51 60
52@EXPORT = qw(loop unloop sweep); 61our @EXPORT = qw(loop unloop sweep);
53 62
54BEGIN { 63BEGIN {
55 $VERSION = 0.45; 64 our $VERSION = 1.9;
56 65
57 require XSLoader; 66 local $^W = 0; # avoid redefine warning for Coro::ready;
58 XSLoader::load Coro::Event, $VERSION; 67 XSLoader::load __PACKAGE__, $VERSION;
59} 68}
60 69
61=item $w = Coro::Event->flavour(args...) 70=item $w = Coro::Event->flavour(args...)
62 71
63Create and return a watcher of the given type. 72Create and return a watcher of the given type.
81method. This is less efficient then calling the constructor once and the 90method. This is less efficient then calling the constructor once and the
82next method often, but it does save typing sometimes. 91next method often, but it does save typing sometimes.
83 92
84=cut 93=cut
85 94
86#sub std_cb {
87# my $w = $_[0]->w;
88# my $q = $w->private;
89# $q->[1] = $_[0];
90# if ($q->[0]) { # somebody waiting?
91# $q->[0]->ready;
92# &Coro::schedule;
93# } else {
94# $w->stop;
95# }
96#}
97
98for my $flavour (qw(idle var timer io signal)) { 95for my $flavour (qw(idle var timer io signal)) {
99 push @EXPORT, "do_$flavour"; 96 push @EXPORT, "do_$flavour";
100 my $new = \&{"Event::$flavour"}; 97 my $new = \&{"Event::$flavour"};
101 my $class = "Coro::Event::$flavour"; 98 my $class = "Coro::Event::$flavour";
102 my $type = $flavour eq "io" ? 1 : 0; 99 my $type = $flavour eq "io" ? 1 : 0;
103 @{"${class}::ISA"} = (Coro::Event::, "Event::$flavour"); 100 @{"${class}::ISA"} = (Coro::Event::, "Event::$flavour");
104 my $coronew = sub { 101 my $coronew = sub {
105 # how does one do method-call-by-name? 102 # how does one do method-call-by-name?
106 # my $w = $class->SUPER::$flavour(@_); 103 # my $w = $class->SUPER::$flavour(@_);
107 104
108 $_[0] eq Coro::Event:: 105 shift eq Coro::Event::
109 or croak "event constructor \"Coro::Event->$flavour\" must be called as a static method"; 106 or croak "event constructor \"Coro::Event->$flavour\" must be called as a static method";
110 107
111 my $q = []; # [$coro, $event]
112 my $w = $new->( 108 my $w = $new->($class,
113 desc => $flavour, 109 desc => $flavour,
114 @_, 110 @_,
115 parked => 1, 111 parked => 1,
116 ); 112 );
117 _install_std_cb($w, $type); 113 _install_std_cb($w, $type);
119 }; 115 };
120 *{ $flavour } = $coronew; 116 *{ $flavour } = $coronew;
121 *{"do_$flavour"} = sub { 117 *{"do_$flavour"} = sub {
122 unshift @_, Coro::Event::; 118 unshift @_, Coro::Event::;
123 my $e = (&$coronew)->next; 119 my $e = (&$coronew)->next;
124 $e->w->cancel; 120 $e->cancel; # $e === $e->w
125 $e; 121 $e;
126 }; 122 };
127} 123}
128 124
129# double calls to avoid stack-cloning ;() 125# double calls to avoid stack-cloning ;()
130# is about 20% slower, though. 126# is about 10% slower, though.
131sub next($) { 127sub next($) {
132 &_next0; 128 &Coro::schedule while &_next;
133 &Coro::schedule; 129
134 &_next1; 130 $_[0]
135} 131}
136 132
137#sub next {
138# my $w = $_[0];
139# my $q = $w->private;
140# if ($q->[1]) { # event waiting?
141# $w->again unless $w->is_cancelled;
142# } elsif ($q->[0]) {
143# croak "only one coroutine can wait for an event";
144# } else {
145# local $q->[0] = $Coro::current;
146# &Coro::schedule;
147# }
148# pop @$q;
149#}
150
151sub Coro::Event::Ev::w { $_[0][2] } 133sub Coro::Event::w { $_[0] }
134sub Coro::Event::prio { $_[0]{Coro::Event}[3] }
135sub Coro::Event::hits { $_[0]{Coro::Event}[4] }
152sub Coro::Event::Ev::got { $_[0][3] } 136sub Coro::Event::got { $_[0]{Coro::Event}[5] }
153sub Coro::Event::Ev::prio { croak "prio not supported yet, please mail to pcg\@goof.com" }
154sub Coro::Event::Ev::hits { croak "prio not supported yet, please mail to pcg\@goof.com" }
155 137
156=item sweep 138=item sweep
157 139
158Similar to Event::one_event and Event::sweep: The idle task is called once 140Similar to Event::one_event and Event::sweep: The idle task is called once
159(this has the effect of jumping back into the Event loop once to serve new 141(this has the effect of jumping back into the Event loop once to serve new
165into the Event dispatcher. 147into the Event dispatcher.
166 148
167=cut 149=cut
168 150
169sub sweep { 151sub sweep {
170 one_event(0); # for now 152 Event::one_event(0); # for now
171} 153}
172 154
173=item $result = loop([$timeout]) 155=item $result = loop([$timeout])
174 156
175This is the version of C<loop> you should use instead of C<Event::loop> 157This is the version of C<loop> you should use instead of C<Event::loop>
176when using this module - it will ensure correct scheduling in the presence 158when using this module - it will ensure correct scheduling in the presence
177of events. 159of events.
178 160
179=begin comment
180
181Unlike loop's counterpart it is not an error when no watchers are active -
182loop silently returns in this case, as if unloop(undef) were called.
183
184=end comment
185
186=cut
187
188sub loop(;$) {
189 local $Coro::idle = $Coro::current;
190 Coro::schedule; # become idle task, which is implicitly ready
191 &Event::loop;
192}
193
194=item unloop([$result]) 161=item unloop([$result])
195 162
196Same as Event::unloop (provided here for your convinience only). 163Same as Event::unloop (provided here for your convinience only).
197 164
198=cut 165=cut
199 166
200$Coro::idle = new Coro sub { 167$Coro::idle = \&Event::one_event; # inefficient
201 while () {
202 Event::one_event; # inefficient
203 Coro::schedule;
204 }
205};
206 168
2071; 1691;
208 170
171=back
172
209=head1 AUTHOR 173=head1 AUTHOR
210 174
211 Marc Lehmann <pcg@goof.com> 175 Marc Lehmann <schmorp@schmorp.de>
212 http://www.goof.com/pcg/marc/ 176 http://home.schmorp.de/
213 177
214=cut 178=cut
215 179

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines