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.25 by root, Wed Jan 12 20:35:35 2005 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 36
37=over 4 37=over 4
38 38
39=cut 39=cut
40 40
41package Coro::Event; 41package Coro::Event;
42 42
43no warnings; 43BEGIN { eval { require warnings } && warnings->unimport ("uninitialized") }
44 44
45use Carp; 45use Carp;
46 46
47use Coro; 47use Coro;
48use Event qw(unloop); # we are re-exporting this, cooool! 48use Event qw(loop unloop); # we are re-exporting this, cooool!
49 49
50use base 'Exporter'; 50use base 'Exporter';
51 51
52@EXPORT = qw(loop unloop sweep); 52@EXPORT = qw(loop unloop sweep reschedule);
53 53
54BEGIN { 54BEGIN {
55 $VERSION = 0.45; 55 $VERSION = 1.0;
56 56
57 local $^W = 0; # avoid redefine warning for Coro::ready;
58
57 require XSLoader; 59 require DynaLoader;
58 XSLoader::load Coro::Event, $VERSION; 60 push @ISA, 'DynaLoader';
61 bootstrap Coro::Event $VERSION;
59} 62}
60 63
61=item $w = Coro::Event->flavour(args...) 64=item $w = Coro::Event->flavour(args...)
62 65
63Create and return a watcher of the given type. 66Create and return a watcher of the given type.
… …
80Create a watcher of the given type and immediately call it's next 83Create a watcher of the given type and immediately call it's next
81method. This is less efficient then calling the constructor once and the 84method. This is less efficient then calling the constructor once and the
82next method often, but it does save typing sometimes. 85next method often, but it does save typing sometimes.
83 86
84=cut 87=cut
85
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 88
98for my $flavour (qw(idle var timer io signal)) { 89for my $flavour (qw(idle var timer io signal)) {
99 push @EXPORT, "do_$flavour"; 90 push @EXPORT, "do_$flavour";
100 my $new = \&{"Event::$flavour"}; 91 my $new = \&{"Event::$flavour"};
101 my $class = "Coro::Event::$flavour"; 92 my $class = "Coro::Event::$flavour";
… …
103 @{"${class}::ISA"} = (Coro::Event::, "Event::$flavour"); 94 @{"${class}::ISA"} = (Coro::Event::, "Event::$flavour");
104 my $coronew = sub { 95 my $coronew = sub {
105 # how does one do method-call-by-name? 96 # how does one do method-call-by-name?
106 # my $w = $class->SUPER::$flavour(@_); 97 # my $w = $class->SUPER::$flavour(@_);
107 98
108 $_[0] eq Coro::Event:: 99 shift eq Coro::Event::
109 or croak "event constructor \"Coro::Event->$flavour\" must be called as a static method"; 100 or croak "event constructor \"Coro::Event->$flavour\" must be called as a static method";
110 101
111 my $q = []; # [$coro, $event]
112 my $w = $new->( 102 my $w = $new->($class,
113 desc => $flavour, 103 desc => $flavour,
114 @_, 104 @_,
115 parked => 1, 105 parked => 1,
116 ); 106 );
117 _install_std_cb($w, $type); 107 _install_std_cb($w, $type);
… …
119 }; 109 };
120 *{ $flavour } = $coronew; 110 *{ $flavour } = $coronew;
121 *{"do_$flavour"} = sub { 111 *{"do_$flavour"} = sub {
122 unshift @_, Coro::Event::; 112 unshift @_, Coro::Event::;
123 my $e = (&$coronew)->next; 113 my $e = (&$coronew)->next;
124 $e->w->cancel; 114 $e->cancel; # $e === $e->w
125 $e; 115 $e;
126 }; 116 };
127} 117}
128 118
129# double calls to avoid stack-cloning ;() 119# double calls to avoid stack-cloning ;()
130# is about 20% slower, though. 120# is about 10% slower, though.
131sub next($) { 121sub next($) {
132 &_next0; 122 &Coro::schedule if &_next; $_[0];
133 &Coro::schedule;
134 &_next1;
135} 123}
136 124
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] } 125sub Coro::Event::w { $_[0] }
126sub Coro::Event::prio { $_[0]{Coro::Event}[3] }
127sub Coro::Event::hits { $_[0]{Coro::Event}[4] }
152sub Coro::Event::Ev::got { $_[0][3] } 128sub 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 129
156=item sweep 130=item sweep
157 131
158Similar to Event::one_event and Event::sweep: The idle task is called once 132Similar 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 133(this has the effect of jumping back into the Event loop once to serve new
… …
165into the Event dispatcher. 139into the Event dispatcher.
166 140
167=cut 141=cut
168 142
169sub sweep { 143sub sweep {
170 one_event(0); # for now 144 Event::one_event(0); # for now
171} 145}
172 146
173=item $result = loop([$timeout]) 147=item $result = loop([$timeout])
174 148
175This is the version of C<loop> you should use instead of C<Event::loop> 149This is the version of C<loop> you should use instead of C<Event::loop>
… …
183 157
184=end comment 158=end comment
185 159
186=cut 160=cut
187 161
162# no longer do something special - it's done internally now
163
188sub loop(;$) { 164#sub loop(;$) {
189 local $Coro::idle = $Coro::current; 165# #local $Coro::idle = $Coro::current;
190 Coro::schedule; # become idle task, which is implicitly ready 166# #Coro::schedule; # become idle task, which is implicitly ready
191 &Event::loop; 167# &Event::loop;
192} 168#}
193 169
194=item unloop([$result]) 170=item unloop([$result])
195 171
196Same as Event::unloop (provided here for your convinience only). 172Same as Event::unloop (provided here for your convinience only).
197 173
… …
202 Event::one_event; # inefficient 178 Event::one_event; # inefficient
203 Coro::schedule; 179 Coro::schedule;
204 } 180 }
205}; 181};
206 182
183# provide hooks for Coro::Timer
184
185package Coro::Timer;
186
187unless ($override) {
188 $override = 1;
189 *_new_timer = sub {
190 Event->timer(at => $_[0], cb => $_[1]);
191 };
192}
193
2071; 1941;
208 195
209=head1 AUTHOR 196=head1 AUTHOR
210 197
211 Marc Lehmann <pcg@goof.com> 198 Marc Lehmann <pcg@goof.com>
212 http://www.goof.com/pcg/marc/ 199 http://home.schmorp.de/
213 200
214=cut 201=cut
215 202

Diff Legend

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