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.8 by root, Sun Oct 28 17:00:09 2001 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 {
54$VERSION = 0.45; 55 $VERSION = 0.45;
56
57 local $^W = 0; # avoid redefine warning for Coro::ready
58 require XSLoader;
59 XSLoader::load Coro::Event, $VERSION;
60}
55 61
56=item $w = Coro::Event->flavour(args...) 62=item $w = Coro::Event->flavour(args...)
57 63
58Create and return a watcher of the given type. 64Create and return a watcher of the given type.
59 65
… …
76method. This is less efficient then calling the constructor once and the 82method. This is less efficient then calling the constructor once and the
77next method often, but it does save typing sometimes. 83next method often, but it does save typing sometimes.
78 84
79=cut 85=cut
80 86
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)) { 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";
91 my $type = $flavour eq "io" ? 1 : 0;
102 @{"${class}::ISA"} = (Coro::Event::, "Event::$flavour"); 92 @{"${class}::ISA"} = (Coro::Event::, "Event::$flavour");
103 my $coronew = sub { 93 my $coronew = sub {
104 # how does one do method-call-by-name? 94 # how does one do method-call-by-name?
105 # my $w = $class->SUPER::$flavour(@_); 95 # my $w = $class->SUPER::$flavour(@_);
106 96
… …
109 99
110 my $q = []; # [$coro, $event] 100 my $q = []; # [$coro, $event]
111 my $w = $new->( 101 my $w = $new->(
112 desc => $flavour, 102 desc => $flavour,
113 @_, 103 @_,
114 cb => \&std_cb, 104 parked => 1,
115 ); 105 );
116 $w->private($q); # using private as attribute is pretty useless... 106 _install_std_cb($w, $type);
117 bless $w, $class; # reblessing due to broken Event 107 bless $w, $class; # reblessing due to broken Event
118 }; 108 };
119 *{ $flavour } = $coronew; 109 *{ $flavour } = $coronew;
120 *{"do_$flavour"} = sub { 110 *{"do_$flavour"} = sub {
121 unshift @_, Coro::Event::; 111 unshift @_, Coro::Event::;
122 my $e = (&$coronew)->next; 112 my $e = (&$coronew)->next;
123 $e->w->cancel; 113 $e->cancel; # $e = $e->w->cancel ($e == $e->w!)
124 $e; 114 $e;
125 }; 115 };
126} 116}
127 117
118# double calls to avoid stack-cloning ;()
119# is about 10% slower, though.
128sub next { 120sub next($) {
129 my $w = $_[0]; 121 &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} 122}
123
124sub Coro::Event::w { $_[0] }
125sub Coro::Event::prio { $_[0]{Coro::Event}[3] }
126sub Coro::Event::hits { $_[0]{Coro::Event}[4] }
127sub Coro::Event::got { $_[0]{Coro::Event}[5] }
141 128
142=item sweep 129=item sweep
143 130
144Similar to Event::one_event and Event::sweep: The idle task is called once 131Similar 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 132(this has the effect of jumping back into the Event loop once to serve new
… …
151into the Event dispatcher. 138into the Event dispatcher.
152 139
153=cut 140=cut
154 141
155sub sweep { 142sub sweep {
156 one_event(0); # for now 143 Event::one_event(0); # for now
157} 144}
158 145
159=item $result = loop([$timeout]) 146=item $result = loop([$timeout])
160 147
161This is the version of C<loop> you should use instead of C<Event::loop> 148This is the version of C<loop> you should use instead of C<Event::loop>
… …
169 156
170=end comment 157=end comment
171 158
172=cut 159=cut
173 160
161# no longer do something special - it's done internally now
162
174sub loop(;$) { 163#sub loop(;$) {
175 local $Coro::idle = $Coro::current; 164# #local $Coro::idle = $Coro::current;
176 Coro::schedule; # become idle task, which is implicitly ready 165# #Coro::schedule; # become idle task, which is implicitly ready
177 &Event::loop; 166# &Event::loop;
178} 167#}
179 168
180=item unloop([$result]) 169=item unloop([$result])
181 170
182Same as Event::unloop (provided here for your convinience only). 171Same as Event::unloop (provided here for your convinience only).
183 172

Diff Legend

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