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.23 by pcg, Fri May 14 13:25:09 2004 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 {
54$VERSION = 0.45; 55 $VERSION = 0.97;
56
57 local $^W = 0; # avoid redefine warning for Coro::ready;
58
59 require DynaLoader;
60 push @ISA, 'DynaLoader';
61 bootstrap Coro::Event $VERSION;
62}
55 63
56=item $w = Coro::Event->flavour(args...) 64=item $w = Coro::Event->flavour(args...)
57 65
58Create and return a watcher of the given type. 66Create and return a watcher of the given type.
59 67
… …
75Create 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
76method. This is less efficient then calling the constructor once and the 84method. This is less efficient then calling the constructor once and the
77next method often, but it does save typing sometimes. 85next method often, but it does save typing sometimes.
78 86
79=cut 87=cut
80
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 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";
93 my $type = $flavour eq "io" ? 1 : 0;
102 @{"${class}::ISA"} = (Coro::Event::, "Event::$flavour"); 94 @{"${class}::ISA"} = (Coro::Event::, "Event::$flavour");
103 my $coronew = sub { 95 my $coronew = sub {
104 # how does one do method-call-by-name? 96 # how does one do method-call-by-name?
105 # my $w = $class->SUPER::$flavour(@_); 97 # my $w = $class->SUPER::$flavour(@_);
106 98
107 $_[0] eq Coro::Event:: 99 shift eq Coro::Event::
108 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";
109 101
110 my $q = []; # [$coro, $event]
111 my $w = $new->( 102 my $w = $new->($class,
112 desc => $flavour, 103 desc => $flavour,
113 @_, 104 @_,
114 cb => \&std_cb, 105 parked => 1,
115 ); 106 );
116 $w->private($q); # using private as attribute is pretty useless... 107 _install_std_cb($w, $type);
117 bless $w, $class; # reblessing due to broken Event 108 bless $w, $class; # reblessing due to broken Event
118 }; 109 };
119 *{ $flavour } = $coronew; 110 *{ $flavour } = $coronew;
120 *{"do_$flavour"} = sub { 111 *{"do_$flavour"} = sub {
121 unshift @_, Coro::Event::; 112 unshift @_, Coro::Event::;
122 my $e = (&$coronew)->next; 113 my $e = (&$coronew)->next;
123 $e->w->cancel; 114 $e->cancel; # $e === $e->w
124 $e; 115 $e;
125 }; 116 };
126} 117}
127 118
119# double calls to avoid stack-cloning ;()
120# is about 10% slower, though.
128sub next { 121sub next($) {
129 my $w = $_[0]; 122 &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} 123}
124
125sub Coro::Event::w { $_[0] }
126sub Coro::Event::prio { $_[0]{Coro::Event}[3] }
127sub Coro::Event::hits { $_[0]{Coro::Event}[4] }
128sub Coro::Event::got { $_[0]{Coro::Event}[5] }
141 129
142=item sweep 130=item sweep
143 131
144Similar 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
145(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
… …
151into the Event dispatcher. 139into the Event dispatcher.
152 140
153=cut 141=cut
154 142
155sub sweep { 143sub sweep {
156 one_event(0); # for now 144 Event::one_event(0); # for now
157} 145}
158 146
159=item $result = loop([$timeout]) 147=item $result = loop([$timeout])
160 148
161This 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>
… …
169 157
170=end comment 158=end comment
171 159
172=cut 160=cut
173 161
162# no longer do something special - it's done internally now
163
174sub loop(;$) { 164#sub loop(;$) {
175 local $Coro::idle = $Coro::current; 165# #local $Coro::idle = $Coro::current;
176 Coro::schedule; # become idle task, which is implicitly ready 166# #Coro::schedule; # become idle task, which is implicitly ready
177 &Event::loop; 167# &Event::loop;
178} 168#}
179 169
180=item unloop([$result]) 170=item unloop([$result])
181 171
182Same as Event::unloop (provided here for your convinience only). 172Same as Event::unloop (provided here for your convinience only).
183 173
… …
188 Event::one_event; # inefficient 178 Event::one_event; # inefficient
189 Coro::schedule; 179 Coro::schedule;
190 } 180 }
191}; 181};
192 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
1931; 1941;
194 195
195=head1 AUTHOR 196=head1 AUTHOR
196 197
197 Marc Lehmann <pcg@goof.com> 198 Marc Lehmann <pcg@goof.com>

Diff Legend

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