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.1 by root, Thu Aug 16 21:55:34 2001 UTC vs.
Revision 1.40 by root, Fri Nov 24 15:34:33 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 reschedule);
53 62
54$VERSION = 0.45; 63BEGIN {
64 our $VERSION = 1.9;
65
66 local $^W = 0; # avoid redefine warning for Coro::ready;
67 XSLoader::load __PACKAGE__, $VERSION;
68}
55 69
56=item $w = Coro::Event->flavour(args...) 70=item $w = Coro::Event->flavour(args...)
57 71
58Create and return a watcher of the given type. 72Create and return a watcher of the given type.
59 73
… …
76method. This is less efficient then calling the constructor once and the 90method. This is less efficient then calling the constructor once and the
77next method often, but it does save typing sometimes. 91next method often, but it does save typing sometimes.
78 92
79=cut 93=cut
80 94
81#Event->add_hooks(prepare => sub {
82# &Coro::cede while &Coro::nready;
83# 1e6;
84#});
85
86sub 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";
99 my $type = $flavour eq "io" ? 1 : 0;
102 @{"${class}::ISA"} = (Coro::Event::, "Event::$flavour"); 100 @{"${class}::ISA"} = (Coro::Event::, "Event::$flavour");
103 my $coronew = sub { 101 my $coronew = sub {
104 # how does one do method-call-by-name? 102 # how does one do method-call-by-name?
105 # my $w = $class->SUPER::$flavour(@_); 103 # my $w = $class->SUPER::$flavour(@_);
106 104
107 $_[0] eq Coro::Event:: 105 shift eq Coro::Event::
108 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";
109 107
110 my $q = []; # [$coro, $event]
111 my $w = $new->( 108 my $w = $new->($class,
112 desc => $flavour, 109 desc => $flavour,
113 @_, 110 @_,
114 cb => \&std_cb, 111 parked => 1,
115 ); 112 );
116 $w->private($q); # using private as attribute is pretty useless... 113 _install_std_cb($w, $type);
117 bless $w, $class; # reblessing due to broken Event 114 bless $w, $class; # reblessing due to broken Event
118 }; 115 };
119 *{ $flavour } = $coronew; 116 *{ $flavour } = $coronew;
120 *{"do_$flavour"} = sub { 117 *{"do_$flavour"} = sub {
121 unshift @_, Coro::Event::; 118 unshift @_, Coro::Event::;
122 my $e = (&$coronew)->next; 119 my $e = (&$coronew)->next;
123 $e->w->cancel; 120 $e->cancel; # $e === $e->w
124 $e; 121 $e;
125 }; 122 };
126} 123}
127 124
125# double calls to avoid stack-cloning ;()
126# is about 10% slower, though.
128sub next { 127sub next($) {
129 my $w = $_[0]; 128 &Coro::schedule if &_next; $_[0];
130 my $q = $w->private;
131 if ($q->[1]) { # event waiting?
132 $w->again unless $w->is_cancelled;
133 } elsif ($q->[0]) {
134 croak "only one coroutine can wait for an event";
135 } else {
136 local $q->[0] = $Coro::current;
137 &Coro::schedule;
138 }
139 pop @$q;
140} 129}
130
131sub Coro::Event::w { $_[0] }
132sub Coro::Event::prio { $_[0]{Coro::Event}[3] }
133sub Coro::Event::hits { $_[0]{Coro::Event}[4] }
134sub Coro::Event::got { $_[0]{Coro::Event}[5] }
141 135
142=item sweep 136=item sweep
143 137
144Similar to Event::one_event and Event::sweep: The idle task is called once 138Similar to Event::one_event and Event::sweep: The idle task is called once
145(this has the effect of jumping back into the Event loop once to serve new 139(this has the effect of jumping back into the Event loop once to serve new
… …
151into the Event dispatcher. 145into the Event dispatcher.
152 146
153=cut 147=cut
154 148
155sub sweep { 149sub sweep {
156 one_event(0); # for now 150 Event::one_event(0); # for now
157} 151}
158 152
159=item $result = loop([$timeout]) 153=item $result = loop([$timeout])
160 154
161This is the version of C<loop> you should use instead of C<Event::loop> 155This is the version of C<loop> you should use instead of C<Event::loop>
162when using this module - it will ensure correct scheduling in the presence 156when using this module - it will ensure correct scheduling in the presence
163of events. 157of events.
164 158
165=begin comment
166
167Unlike loop's counterpart it is not an error when no watchers are active -
168loop silently returns in this case, as if unloop(undef) were called.
169
170=end comment
171
172=cut
173
174sub loop(;$) {
175 local $Coro::idle = $Coro::current;
176 Coro::schedule; # become idle task, which is implicitly ready
177 &Event::loop;
178}
179
180=item unloop([$result]) 159=item unloop([$result])
181 160
182Same as Event::unloop (provided here for your convinience only). 161Same as Event::unloop (provided here for your convinience only).
183 162
184=cut 163=cut
185 164
186$Coro::idle = new Coro sub { 165$Coro::idle = \&Event::one_event; # inefficient
187 while () {
188 Event::one_event; # inefficient
189 Coro::schedule;
190 }
191};
192 166
1931; 1671;
194 168
169=back
170
195=head1 AUTHOR 171=head1 AUTHOR
196 172
197 Marc Lehmann <pcg@goof.com> 173 Marc Lehmann <schmorp@schmorp.de>
198 http://www.goof.com/pcg/marc/ 174 http://home.schmorp.de/
199 175
200=cut 176=cut
201 177

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines