ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.98 by root, Fri Dec 22 16:34:00 2006 UTC vs.
Revision 1.106 by root, Sun Dec 31 17:29:22 2006 UTC

… …
8use Storable; 8use Storable;
9use Opcode; 9use Opcode;
10use Safe; 10use Safe;
11use Safe::Hole; 11use Safe::Hole;
12 12
13use Coro; 13use Coro 3.3;
14use Coro::Event; 14use Coro::Event;
15use Coro::Timer; 15use Coro::Timer;
16use Coro::Signal; 16use Coro::Signal;
17use Coro::Semaphore; 17use Coro::Semaphore;
18
19use IO::AIO; 18use Coro::AIO;
19
20use Fcntl;
21use IO::AIO 2.31 ();
20use YAML::Syck (); 22use YAML::Syck ();
21use Time::HiRes; 23use Time::HiRes;
22 24
23use Event; $Event::Eval = 1; # no idea why this is required, but it is 25use Event; $Event::Eval = 1; # no idea why this is required, but it is
24 26
25# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode? 27# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
26$YAML::Syck::ImplicitUnicode = 1; 28$YAML::Syck::ImplicitUnicode = 1;
27 29
28$Coro::main->prio (Coro::PRIO_MIN); 30$Coro::main->prio (2); # run main coroutine ("the server") with very high priority
29 31
30sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 32sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
31 33
32our %COMMAND = (); 34our %COMMAND = ();
33our %COMMAND_TIME = (); 35our %COMMAND_TIME = ();
34our %EXTCMD = (); 36our %EXTCMD = ();
35 37
36_init_vars;
37
38our @EVENT; 38our @EVENT;
39our $LIBDIR = datadir . "/ext"; 39our $LIBDIR = datadir . "/ext";
40 40
41our $TICK = MAX_TIME * 1e-6; 41our $TICK = MAX_TIME * 1e-6;
42our $TICK_WATCHER; 42our $TICK_WATCHER;
43our $NEXT_TICK; 43our $NEXT_TICK;
44our $NOW;
44 45
45our %CFG; 46our %CFG;
46 47
47our $UPTIME; $UPTIME ||= time; 48our $UPTIME; $UPTIME ||= time;
49our $RUNTIME;
50
51our %MAP; # all maps
52our $LINK_MAP; # the special {link} map
53our $FREEZE;
54
55binmode STDOUT;
56binmode STDERR;
57
58# read virtual server time, if available
59unless ($RUNTIME || !-e cf::localdir . "/runtime") {
60 open my $fh, "<", cf::localdir . "/runtime"
61 or die "unable to read runtime file: $!";
62 $RUNTIME = <$fh> + 0.;
63}
64
65mkdir cf::localdir;
66mkdir cf::localdir . "/" . cf::playerdir;
67mkdir cf::localdir . "/" . cf::tmpdir;
68mkdir cf::localdir . "/" . cf::uniquedir;
69
70our %EXT_CORO;
48 71
49############################################################################# 72#############################################################################
50 73
51=head2 GLOBAL VARIABLES 74=head2 GLOBAL VARIABLES
52 75
53=over 4 76=over 4
54 77
55=item $cf::UPTIME 78=item $cf::UPTIME
56 79
57The timestamp of the server start (so not actually an uptime). 80The timestamp of the server start (so not actually an uptime).
81
82=item $cf::RUNTIME
83
84The time this server has run, starts at 0 and is increased by $cf::TICK on
85every server tick.
58 86
59=item $cf::LIBDIR 87=item $cf::LIBDIR
60 88
61The perl library directory, where extensions and cf-specific modules can 89The perl library directory, where extensions and cf-specific modules can
62be found. It will be added to C<@INC> automatically. 90be found. It will be added to C<@INC> automatically.
91
92=item $cf::NOW
93
94The time of the last (current) server tick.
63 95
64=item $cf::TICK 96=item $cf::TICK
65 97
66The interval between server ticks, in seconds. 98The interval between server ticks, in seconds.
67 99
… …
75=cut 107=cut
76 108
77BEGIN { 109BEGIN {
78 *CORE::GLOBAL::warn = sub { 110 *CORE::GLOBAL::warn = sub {
79 my $msg = join "", @_; 111 my $msg = join "", @_;
112 utf8::encode $msg;
113
80 $msg .= "\n" 114 $msg .= "\n"
81 unless $msg =~ /\n$/; 115 unless $msg =~ /\n$/;
82 116
83 print STDERR "cfperl: $msg";
84 LOG llevError, "cfperl: $msg"; 117 LOG llevError, "cfperl: $msg";
85 }; 118 };
86} 119}
87 120
88@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 121@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
… …
93@safe::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object'; 126@safe::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object';
94 127
95# we bless all objects into (empty) derived classes to force a method lookup 128# we bless all objects into (empty) derived classes to force a method lookup
96# within the Safe compartment. 129# within the Safe compartment.
97for my $pkg (qw( 130for my $pkg (qw(
98 cf::global 131 cf::global cf::attachable
99 cf::object cf::object::player 132 cf::object cf::object::player
100 cf::client cf::player 133 cf::client cf::player
101 cf::arch cf::living 134 cf::arch cf::living
102 cf::map cf::party cf::region 135 cf::map cf::party cf::region
103)) { 136)) {
… …
139=cut 172=cut
140 173
141sub to_json($) { 174sub to_json($) {
142 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 175 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
143 JSON::Syck::Dump $_[0] 176 JSON::Syck::Dump $_[0]
177}
178
179=item cf::sync_job { BLOCK }
180
181The design of crossfire+ requires that the main coro ($Coro::main) is
182always able to handle events or runnable, as crossfire+ is only partly
183reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable.
184
185If it must be done, put the blocking parts into C<sync_job>. This will run
186the given BLOCK in another coroutine while waiting for the result. The
187server will be frozen during this time, so the block should either finish
188fast or be very important.
189
190=cut
191
192sub sync_job(&) {
193 my ($job) = @_;
194
195 my $busy = 1;
196 my @res;
197
198 # TODO: use suspend/resume instead
199 local $FREEZE = 1;
200
201 my $coro = Coro::async {
202 @res = eval { $job->() };
203 warn $@ if $@;
204 undef $busy;
205 };
206
207 if ($Coro::current == $Coro::main) {
208 $coro->prio (Coro::PRIO_MAX);
209 while ($busy) {
210 Coro::cede_notself;
211 Event::one_event unless Coro::nready;
212 }
213 } else {
214 $coro->join;
215 }
216
217 wantarray ? @res : $res[0]
218}
219
220=item $coro = cf::coro { BLOCK }
221
222Creates and returns a new coro. This coro is automcatially being canceled
223when the extension calling this is being unloaded.
224
225=cut
226
227sub coro(&) {
228 my $cb = shift;
229
230 my $coro; $coro = async {
231 eval {
232 $cb->();
233 };
234 warn $@ if $@;
235 };
236
237 $coro->on_destroy (sub {
238 delete $EXT_CORO{$coro+0};
239 });
240 $EXT_CORO{$coro+0} = $coro;
241
242 $coro
144} 243}
145 244
146=back 245=back
147 246
148=cut 247=cut
… …
269exception. 368exception.
270 369
271=cut 370=cut
272 371
273# the following variables are defined in .xs and must not be re-created 372# the following variables are defined in .xs and must not be re-created
274our @CB_GLOBAL = (); # registry for all global events 373our @CB_GLOBAL = (); # registry for all global events
374our @CB_ATTACHABLE = (); # registry for all attachables
275our @CB_OBJECT = (); # all objects (should not be used except in emergency) 375our @CB_OBJECT = (); # all objects (should not be used except in emergency)
276our @CB_PLAYER = (); 376our @CB_PLAYER = ();
277our @CB_CLIENT = (); 377our @CB_CLIENT = ();
278our @CB_TYPE = (); # registry for type (cf-object class) based events 378our @CB_TYPE = (); # registry for type (cf-object class) based events
279our @CB_MAP = (); 379our @CB_MAP = ();
280 380
281my %attachment; 381my %attachment;
282 382
283sub _attach_cb($$$$) { 383sub _attach_cb($$$$) {
284 my ($registry, $event, $prio, $cb) = @_; 384 my ($registry, $event, $prio, $cb) = @_;
… …
289 389
290 @{$registry->[$event]} = sort 390 @{$registry->[$event]} = sort
291 { $a->[0] cmp $b->[0] } 391 { $a->[0] cmp $b->[0] }
292 @{$registry->[$event] || []}, $cb; 392 @{$registry->[$event] || []}, $cb;
293} 393}
394
395# hack
396my %attachable_klass = map +($_ => 1), KLASS_OBJECT, KLASS_CLIENT, KLASS_PLAYER, KLASS_MAP;
294 397
295# attach handles attaching event callbacks 398# attach handles attaching event callbacks
296# the only thing the caller has to do is pass the correct 399# the only thing the caller has to do is pass the correct
297# registry (== where the callback attaches to). 400# registry (== where the callback attaches to).
298sub _attach { 401sub _attach {
… …
300 403
301 my $object_type; 404 my $object_type;
302 my $prio = 0; 405 my $prio = 0;
303 my %cb_id = map +("on_" . lc $EVENT[$_][0], $_) , grep $EVENT[$_][1] == $klass, 0 .. $#EVENT; 406 my %cb_id = map +("on_" . lc $EVENT[$_][0], $_) , grep $EVENT[$_][1] == $klass, 0 .. $#EVENT;
304 407
408 #TODO: get rid of this hack
409 if ($attachable_klass{$klass}) {
410 %cb_id = (%cb_id, map +("on_" . lc $EVENT[$_][0], $_) , grep $EVENT[$_][1] == KLASS_ATTACHABLE, 0 .. $#EVENT);
411 }
412
305 while (@arg) { 413 while (@arg) {
306 my $type = shift @arg; 414 my $type = shift @arg;
307 415
308 if ($type eq "prio") { 416 if ($type eq "prio") {
309 $prio = shift @arg; 417 $prio = shift @arg;
… …
384 my ($obj, $name) = @_; 492 my ($obj, $name) = @_;
385 493
386 exists $obj->{_attachment}{$name} 494 exists $obj->{_attachment}{$name}
387} 495}
388 496
389for my $klass (qw(GLOBAL OBJECT PLAYER CLIENT MAP)) { 497for my $klass (qw(ATTACHABLE GLOBAL OBJECT PLAYER CLIENT MAP)) {
390 eval "#line " . __LINE__ . " 'cf.pm' 498 eval "#line " . __LINE__ . " 'cf.pm'
391 sub cf::\L$klass\E::_attach_registry { 499 sub cf::\L$klass\E::_attach_registry {
392 (\\\@CB_$klass, KLASS_$klass) 500 (\\\@CB_$klass, KLASS_$klass)
393 } 501 }
394 502
… …
447=cut 555=cut
448 556
449############################################################################# 557#############################################################################
450# object support 558# object support
451 559
452sub instantiate {
453 my ($obj, $data) = @_;
454
455 $data = from_json $data;
456
457 for (@$data) {
458 my ($name, $args) = @$_;
459
460 $obj->attach ($name, %{$args || {} });
461 }
462}
463
464# basically do the same as instantiate, without calling instantiate
465sub reattach { 560sub reattach {
561 # basically do the same as instantiate, without calling instantiate
466 my ($obj) = @_; 562 my ($obj) = @_;
563
467 my $registry = $obj->registry; 564 my $registry = $obj->registry;
468 565
469 @$registry = (); 566 @$registry = ();
470 567
471 delete $obj->{_attachment} unless scalar keys %{ $obj->{_attachment} || {} }; 568 delete $obj->{_attachment} unless scalar keys %{ $obj->{_attachment} || {} };
… …
480 warn "object uses attachment '$name' that is not available, postponing.\n"; 577 warn "object uses attachment '$name' that is not available, postponing.\n";
481 } 578 }
482 } 579 }
483} 580}
484 581
485sub object_freezer_save { 582cf::attachable->attach (
486 my ($filename, $rdata, $objs) = @_;
487
488 if (length $$rdata) {
489 warn sprintf "saving %s (%d,%d)\n",
490 $filename, length $$rdata, scalar @$objs;
491
492 if (open my $fh, ">:raw", "$filename~") {
493 chmod SAVE_MODE, $fh;
494 syswrite $fh, $$rdata;
495 close $fh;
496
497 if (@$objs && open my $fh, ">:raw", "$filename.pst~") {
498 chmod SAVE_MODE, $fh;
499 syswrite $fh, Storable::nfreeze { version => 1, objs => $objs };
500 close $fh;
501 rename "$filename.pst~", "$filename.pst";
502 } else {
503 unlink "$filename.pst";
504 }
505
506 rename "$filename~", $filename;
507 } else {
508 warn "FATAL: $filename~: $!\n";
509 }
510 } else {
511 unlink $filename;
512 unlink "$filename.pst";
513 }
514}
515
516sub object_freezer_as_string {
517 my ($rdata, $objs) = @_;
518
519 use Data::Dumper;
520
521 $$rdata . Dumper $objs
522}
523
524sub object_thawer_load {
525 my ($filename) = @_;
526
527 local $/;
528
529 my $av;
530
531 #TODO: use sysread etc.
532 if (open my $data, "<:raw:perlio", $filename) {
533 $data = <$data>;
534 if (open my $pst, "<:raw:perlio", "$filename.pst") {
535 $av = eval { (Storable::thaw <$pst>)->{objs} };
536 }
537 return ($data, $av);
538 }
539
540 ()
541}
542
543cf::object->attach (
544 prio => -1000000, 583 prio => -1000000,
584 on_instantiate => sub {
585 my ($obj, $data) = @_;
586
587 $data = from_json $data;
588
589 for (@$data) {
590 my ($name, $args) = @$_;
591
592 $obj->attach ($name, %{$args || {} });
593 }
594 },
595 on_reattach => \&reattach,
545 on_clone => sub { 596 on_clone => sub {
546 my ($src, $dst) = @_; 597 my ($src, $dst) = @_;
547 598
548 @{$dst->registry} = @{$src->registry}; 599 @{$dst->registry} = @{$src->registry};
549 600
… …
551 602
552 %{$dst->{_attachment}} = %{$src->{_attachment}} 603 %{$dst->{_attachment}} = %{$src->{_attachment}}
553 if exists $src->{_attachment}; 604 if exists $src->{_attachment};
554 }, 605 },
555); 606);
607
608sub object_freezer_save {
609 my ($filename, $rdata, $objs) = @_;
610
611 sync_job {
612 if (length $$rdata) {
613 warn sprintf "saving %s (%d,%d)\n",
614 $filename, length $$rdata, scalar @$objs;
615
616 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
617 chmod SAVE_MODE, $fh;
618 aio_write $fh, 0, (length $$rdata), $$rdata, 0;
619 aio_fsync $fh;
620 close $fh;
621
622 if (@$objs) {
623 if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) {
624 chmod SAVE_MODE, $fh;
625 my $data = Storable::nfreeze { version => 1, objs => $objs };
626 aio_write $fh, 0, (length $data), $data, 0;
627 aio_fsync $fh;
628 close $fh;
629 aio_rename "$filename.pst~", "$filename.pst";
630 }
631 } else {
632 aio_unlink "$filename.pst";
633 }
634
635 aio_rename "$filename~", $filename;
636 } else {
637 warn "FATAL: $filename~: $!\n";
638 }
639 } else {
640 aio_unlink $filename;
641 aio_unlink "$filename.pst";
642 }
643 }
644}
645
646sub object_freezer_as_string {
647 my ($rdata, $objs) = @_;
648
649 use Data::Dumper;
650
651 $$rdata . Dumper $objs
652}
653
654sub object_thawer_load {
655 my ($filename) = @_;
656
657 my ($data, $av);
658
659 (aio_load $filename, $data) >= 0
660 or return;
661
662 unless (aio_stat "$filename.pst") {
663 (aio_load "$filename.pst", $av) >= 0
664 or return;
665 $av = eval { (Storable::thaw <$av>)->{objs} };
666 }
667
668 return ($data, $av);
669}
556 670
557############################################################################# 671#############################################################################
558# command handling &c 672# command handling &c
559 673
560=item cf::register_command $name => \&callback($ob,$args); 674=item cf::register_command $name => \&callback($ob,$args);
… …
908 my $coro; $coro = async { 1022 my $coro; $coro = async {
909 eval { 1023 eval {
910 $cb->(); 1024 $cb->();
911 }; 1025 };
912 warn $@ if $@; 1026 warn $@ if $@;
1027 };
1028
1029 $coro->on_destroy (sub {
913 delete $self->{_coro}{$coro+0}; 1030 delete $self->{_coro}{$coro+0};
914 }; 1031 });
915 1032
916 $self->{_coro}{$coro+0} = $coro; 1033 $self->{_coro}{$coro+0} = $coro;
1034
1035 $coro
917} 1036}
918 1037
919cf::client->attach ( 1038cf::client->attach (
920 on_destroy => sub { 1039 on_destroy => sub {
921 my ($ns) = @_; 1040 my ($ns) = @_;
… …
1162} 1281}
1163 1282
1164############################################################################# 1283#############################################################################
1165# initialisation 1284# initialisation
1166 1285
1167sub _perl_reload(&) { 1286sub _perl_reload() {
1168 my ($msg) = @_; 1287 # can/must only be called in main
1288 if ($Coro::current != $Coro::main) {
1289 warn "can only reload from main coroutine\n";
1290 return;
1291 }
1169 1292
1170 $msg->("reloading..."); 1293 warn "reloading...";
1294
1295 local $FREEZE = 1;
1296 cf::emergency_save;
1171 1297
1172 eval { 1298 eval {
1299 # if anything goes wrong in here, we should simply crash as we already saved
1300
1173 # cancel all watchers 1301 # cancel all watchers
1174 for (Event::all_watchers) { 1302 for (Event::all_watchers) {
1175 $_->cancel if $_->data & WF_AUTOCANCEL; 1303 $_->cancel if $_->data & WF_AUTOCANCEL;
1176 } 1304 }
1177 1305
1306 # cancel all extension coros
1307 $_->cancel for values %EXT_CORO;
1308 %EXT_CORO = ();
1309
1178 # unload all extensions 1310 # unload all extensions
1179 for (@exts) { 1311 for (@exts) {
1180 $msg->("unloading <$_>"); 1312 warn "unloading <$_>";
1181 unload_extension $_; 1313 unload_extension $_;
1182 } 1314 }
1183 1315
1184 # unload all modules loaded from $LIBDIR 1316 # unload all modules loaded from $LIBDIR
1185 while (my ($k, $v) = each %INC) { 1317 while (my ($k, $v) = each %INC) {
1186 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; 1318 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
1187 1319
1188 $msg->("removing <$k>"); 1320 warn "removing <$k>";
1189 delete $INC{$k}; 1321 delete $INC{$k};
1190 1322
1191 $k =~ s/\.pm$//; 1323 $k =~ s/\.pm$//;
1192 $k =~ s/\//::/g; 1324 $k =~ s/\//::/g;
1193 1325
… …
1198 Symbol::delete_package $k; 1330 Symbol::delete_package $k;
1199 } 1331 }
1200 1332
1201 # sync database to disk 1333 # sync database to disk
1202 cf::db_sync; 1334 cf::db_sync;
1335 IO::AIO::flush;
1203 1336
1204 # get rid of safe::, as good as possible 1337 # get rid of safe::, as good as possible
1205 Symbol::delete_package "safe::$_" 1338 Symbol::delete_package "safe::$_"
1206 for qw(cf::object cf::object::player cf::player cf::map cf::party cf::region); 1339 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
1207 1340
1208 # remove register_script_function callbacks 1341 # remove register_script_function callbacks
1209 # TODO 1342 # TODO
1210 1343
1211 # unload cf.pm "a bit" 1344 # unload cf.pm "a bit"
… …
1214 # don't, removes xs symbols, too, 1347 # don't, removes xs symbols, too,
1215 # and global variables created in xs 1348 # and global variables created in xs
1216 #Symbol::delete_package __PACKAGE__; 1349 #Symbol::delete_package __PACKAGE__;
1217 1350
1218 # reload cf.pm 1351 # reload cf.pm
1219 $msg->("reloading cf.pm"); 1352 warn "reloading cf.pm";
1220 require cf; 1353 require cf;
1354 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
1221 1355
1222 # load config and database again 1356 # load config and database again
1223 cf::cfg_load; 1357 cf::cfg_load;
1224 cf::db_load; 1358 cf::db_load;
1225 1359
1226 # load extensions 1360 # load extensions
1227 $msg->("load extensions"); 1361 warn "load extensions";
1228 cf::load_extensions; 1362 cf::load_extensions;
1229 1363
1230 # reattach attachments to objects 1364 # reattach attachments to objects
1231 $msg->("reattach"); 1365 warn "reattach";
1232 _global_reattach; 1366 _global_reattach;
1233 }; 1367 };
1234 $msg->($@) if $@;
1235 1368
1236 $msg->("reloaded"); 1369 if ($@) {
1370 warn $@;
1371 warn "error while reloading, exiting.";
1372 exit 1;
1373 }
1374
1375 warn "reloaded successfully";
1237}; 1376};
1238 1377
1239sub perl_reload() { 1378sub perl_reload() {
1240 _perl_reload { 1379 _perl_reload;
1241 warn $_[0];
1242 print "$_[0]\n";
1243 };
1244} 1380}
1245 1381
1246register "<global>", __PACKAGE__; 1382register "<global>", __PACKAGE__;
1247 1383
1248register_command "perl-reload" => sub { 1384register_command "perl-reload" => sub {
1249 my ($who, $arg) = @_; 1385 my ($who, $arg) = @_;
1250 1386
1251 if ($who->flag (FLAG_WIZ)) { 1387 if ($who->flag (FLAG_WIZ)) {
1388 $who->message ("reloading...");
1252 _perl_reload { 1389 _perl_reload;
1253 warn $_[0];
1254 $who->message ($_[0]);
1255 };
1256 } 1390 }
1257}; 1391};
1258 1392
1259unshift @INC, $LIBDIR; 1393unshift @INC, $LIBDIR;
1260 1394
1261$TICK_WATCHER = Event->timer ( 1395$TICK_WATCHER = Event->timer (
1396 reentrant => 0,
1262 prio => 0, 1397 prio => 0,
1263 at => $NEXT_TICK || 1, 1398 at => $NEXT_TICK || $TICK,
1264 data => WF_AUTOCANCEL, 1399 data => WF_AUTOCANCEL,
1265 cb => sub { 1400 cb => sub {
1401 unless ($FREEZE) {
1266 cf::server_tick; # one server iteration 1402 cf::server_tick; # one server iteration
1403 $RUNTIME += $TICK;
1404 }
1267 1405
1268 my $NOW = Event::time;
1269 $NEXT_TICK += $TICK; 1406 $NEXT_TICK += $TICK;
1270 1407
1271 # if we are delayed by four ticks or more, skip them all 1408 # if we are delayed by four ticks or more, skip them all
1272 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4; 1409 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
1273 1410
1274 $TICK_WATCHER->at ($NEXT_TICK); 1411 $TICK_WATCHER->at ($NEXT_TICK);
1275 $TICK_WATCHER->start; 1412 $TICK_WATCHER->start;
1276 }, 1413 },
1277); 1414);
… …
1282 poll => 'r', 1419 poll => 'r',
1283 prio => 5, 1420 prio => 5,
1284 data => WF_AUTOCANCEL, 1421 data => WF_AUTOCANCEL,
1285 cb => \&IO::AIO::poll_cb); 1422 cb => \&IO::AIO::poll_cb);
1286 1423
1424# we must not ever block the main coroutine
1425$Coro::idle = sub {
1426 #Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
1427 warn "FATAL: Coro::idle was called, major BUG\n";
1428 (Coro::unblock_sub {
1429 Event::one_event;
1430 })->();
1431};
1432
12871 14331
1288 1434

Diff Legend

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