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.10 by root, Mon Feb 18 21:25:02 2002 UTC

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

Diff Legend

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