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.97 by root, Fri Dec 22 06:03:20 2006 UTC vs.
Revision 1.105 by root, Sun Dec 31 17:17:23 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# main coro must never ever "block" except in Event
180# sync_job ensures this by running the job in a coroutine
181# and waiting in Event while the server is otherwise frozen
182sub sync_job(&) {
183 my ($job) = @_;
184
185 my $busy = 1;
186 my @res;
187
188 local $FREEZE = 1;
189
190 my $coro = Coro::async {
191 @res = eval { $job->() };
192 warn $@ if $@;
193 undef $busy;
194 };
195
196 if ($Coro::current == $Coro::main) {
197 $coro->prio (Coro::PRIO_MAX);
198 while ($busy) {
199 Coro::cede_notself;
200 Event::one_event unless Coro::nready;
201 }
202 } else {
203 $coro->join;
204 }
205
206 wantarray ? @res : $res[0]
207}
208
209=item $coro = cf::coro { BLOCK }
210
211Creates and returns a new coro. This coro is automcatially being canceled
212when the extension calling this is being unloaded.
213
214=cut
215
216sub coro(&) {
217 my $cb = shift;
218
219 my $coro; $coro = async {
220 eval {
221 $cb->();
222 };
223 warn $@ if $@;
224 };
225
226 $coro->on_destroy (sub {
227 delete $EXT_CORO{$coro+0};
228 });
229 $EXT_CORO{$coro+0} = $coro;
230
231 $coro
144} 232}
145 233
146=back 234=back
147 235
148=cut 236=cut
… …
269exception. 357exception.
270 358
271=cut 359=cut
272 360
273# the following variables are defined in .xs and must not be re-created 361# the following variables are defined in .xs and must not be re-created
274our @CB_GLOBAL = (); # registry for all global events 362our @CB_GLOBAL = (); # registry for all global events
363our @CB_ATTACHABLE = (); # registry for all attachables
275our @CB_OBJECT = (); # all objects (should not be used except in emergency) 364our @CB_OBJECT = (); # all objects (should not be used except in emergency)
276our @CB_PLAYER = (); 365our @CB_PLAYER = ();
277our @CB_CLIENT = (); 366our @CB_CLIENT = ();
278our @CB_TYPE = (); # registry for type (cf-object class) based events 367our @CB_TYPE = (); # registry for type (cf-object class) based events
279our @CB_MAP = (); 368our @CB_MAP = ();
280 369
281my %attachment; 370my %attachment;
282 371
283sub _attach_cb($$$$) { 372sub _attach_cb($$$$) {
284 my ($registry, $event, $prio, $cb) = @_; 373 my ($registry, $event, $prio, $cb) = @_;
… …
289 378
290 @{$registry->[$event]} = sort 379 @{$registry->[$event]} = sort
291 { $a->[0] cmp $b->[0] } 380 { $a->[0] cmp $b->[0] }
292 @{$registry->[$event] || []}, $cb; 381 @{$registry->[$event] || []}, $cb;
293} 382}
383
384# hack
385my %attachable_klass = map +($_ => 1), KLASS_OBJECT, KLASS_CLIENT, KLASS_PLAYER, KLASS_MAP;
294 386
295# attach handles attaching event callbacks 387# attach handles attaching event callbacks
296# the only thing the caller has to do is pass the correct 388# the only thing the caller has to do is pass the correct
297# registry (== where the callback attaches to). 389# registry (== where the callback attaches to).
298sub _attach { 390sub _attach {
… …
300 392
301 my $object_type; 393 my $object_type;
302 my $prio = 0; 394 my $prio = 0;
303 my %cb_id = map +("on_" . lc $EVENT[$_][0], $_) , grep $EVENT[$_][1] == $klass, 0 .. $#EVENT; 395 my %cb_id = map +("on_" . lc $EVENT[$_][0], $_) , grep $EVENT[$_][1] == $klass, 0 .. $#EVENT;
304 396
397 #TODO: get rid of this hack
398 if ($attachable_klass{$klass}) {
399 %cb_id = (%cb_id, map +("on_" . lc $EVENT[$_][0], $_) , grep $EVENT[$_][1] == KLASS_ATTACHABLE, 0 .. $#EVENT);
400 }
401
305 while (@arg) { 402 while (@arg) {
306 my $type = shift @arg; 403 my $type = shift @arg;
307 404
308 if ($type eq "prio") { 405 if ($type eq "prio") {
309 $prio = shift @arg; 406 $prio = shift @arg;
… …
384 my ($obj, $name) = @_; 481 my ($obj, $name) = @_;
385 482
386 exists $obj->{_attachment}{$name} 483 exists $obj->{_attachment}{$name}
387} 484}
388 485
389for my $klass (qw(GLOBAL OBJECT PLAYER CLIENT MAP)) { 486for my $klass (qw(ATTACHABLE GLOBAL OBJECT PLAYER CLIENT MAP)) {
390 eval "#line " . __LINE__ . " 'cf.pm' 487 eval "#line " . __LINE__ . " 'cf.pm'
391 sub cf::\L$klass\E::_attach_registry { 488 sub cf::\L$klass\E::_attach_registry {
392 (\\\@CB_$klass, KLASS_$klass) 489 (\\\@CB_$klass, KLASS_$klass)
393 } 490 }
394 491
… …
447=cut 544=cut
448 545
449############################################################################# 546#############################################################################
450# object support 547# object support
451 548
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 { 549sub reattach {
550 # basically do the same as instantiate, without calling instantiate
466 my ($obj) = @_; 551 my ($obj) = @_;
552
467 my $registry = $obj->registry; 553 my $registry = $obj->registry;
468 554
469 @$registry = (); 555 @$registry = ();
470 556
471 delete $obj->{_attachment} unless scalar keys %{ $obj->{_attachment} || {} }; 557 delete $obj->{_attachment} unless scalar keys %{ $obj->{_attachment} || {} };
… …
480 warn "object uses attachment '$name' that is not available, postponing.\n"; 566 warn "object uses attachment '$name' that is not available, postponing.\n";
481 } 567 }
482 } 568 }
483} 569}
484 570
485sub object_freezer_save { 571cf::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, 572 prio => -1000000,
573 on_instantiate => sub {
574 my ($obj, $data) = @_;
575
576 $data = from_json $data;
577
578 for (@$data) {
579 my ($name, $args) = @$_;
580
581 $obj->attach ($name, %{$args || {} });
582 }
583 },
584 on_reattach => \&reattach,
545 on_clone => sub { 585 on_clone => sub {
546 my ($src, $dst) = @_; 586 my ($src, $dst) = @_;
547 587
548 @{$dst->registry} = @{$src->registry}; 588 @{$dst->registry} = @{$src->registry};
549 589
… …
551 591
552 %{$dst->{_attachment}} = %{$src->{_attachment}} 592 %{$dst->{_attachment}} = %{$src->{_attachment}}
553 if exists $src->{_attachment}; 593 if exists $src->{_attachment};
554 }, 594 },
555); 595);
596
597sub object_freezer_save {
598 my ($filename, $rdata, $objs) = @_;
599
600 sync_job {
601 if (length $$rdata) {
602 warn sprintf "saving %s (%d,%d)\n",
603 $filename, length $$rdata, scalar @$objs;
604
605 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
606 chmod SAVE_MODE, $fh;
607 aio_write $fh, 0, (length $$rdata), $$rdata, 0;
608 aio_fsync $fh;
609 close $fh;
610
611 if (@$objs) {
612 if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) {
613 chmod SAVE_MODE, $fh;
614 my $data = Storable::nfreeze { version => 1, objs => $objs };
615 aio_write $fh, 0, (length $data), $data, 0;
616 aio_fsync $fh;
617 close $fh;
618 aio_rename "$filename.pst~", "$filename.pst";
619 }
620 } else {
621 aio_unlink "$filename.pst";
622 }
623
624 aio_rename "$filename~", $filename;
625 } else {
626 warn "FATAL: $filename~: $!\n";
627 }
628 } else {
629 aio_unlink $filename;
630 aio_unlink "$filename.pst";
631 }
632 }
633}
634
635sub object_freezer_as_string {
636 my ($rdata, $objs) = @_;
637
638 use Data::Dumper;
639
640 $$rdata . Dumper $objs
641}
642
643sub object_thawer_load {
644 my ($filename) = @_;
645
646 my ($data, $av);
647
648 (aio_load $filename, $data) >= 0
649 or return;
650
651 unless (aio_stat "$filename.pst") {
652 (aio_load "$filename.pst", $av) >= 0
653 or return;
654 $av = eval { (Storable::thaw <$av>)->{objs} };
655 }
656
657 return ($data, $av);
658}
556 659
557############################################################################# 660#############################################################################
558# command handling &c 661# command handling &c
559 662
560=item cf::register_command $name => \&callback($ob,$args); 663=item cf::register_command $name => \&callback($ob,$args);
… …
886 989
887 if (@{ $ns->{query_queue} } == @$queue) { 990 if (@{ $ns->{query_queue} } == @$queue) {
888 if (@$queue) { 991 if (@$queue) {
889 $ns->send_packet ($ns->{query_queue}[0][0]); 992 $ns->send_packet ($ns->{query_queue}[0][0]);
890 } else { 993 } else {
891 $ns->state (ST_PLAYING); 994 $ns->state (ST_PLAYING) if $ns->state == ST_CUSTOM;
892 } 995 }
893 } 996 }
894 }, 997 },
895); 998);
896 999
… …
908 my $coro; $coro = async { 1011 my $coro; $coro = async {
909 eval { 1012 eval {
910 $cb->(); 1013 $cb->();
911 }; 1014 };
912 warn $@ if $@; 1015 warn $@ if $@;
1016 };
1017
1018 $coro->on_destroy (sub {
913 delete $self->{_coro}{$coro+0}; 1019 delete $self->{_coro}{$coro+0};
914 }; 1020 });
915 1021
916 $self->{_coro}{$coro+0} = $coro; 1022 $self->{_coro}{$coro+0} = $coro;
1023
1024 $coro
917} 1025}
918 1026
919cf::client->attach ( 1027cf::client->attach (
920 on_destroy => sub { 1028 on_destroy => sub {
921 my ($ns) = @_; 1029 my ($ns) = @_;
… …
1162} 1270}
1163 1271
1164############################################################################# 1272#############################################################################
1165# initialisation 1273# initialisation
1166 1274
1167sub _perl_reload(&) { 1275sub _perl_reload() {
1168 my ($msg) = @_; 1276 warn "reloading...";
1169
1170 $msg->("reloading...");
1171 1277
1172 eval { 1278 eval {
1279 local $FREEZE = 1;
1280
1281 cf::emergency_save;
1282
1173 # cancel all watchers 1283 # cancel all watchers
1174 for (Event::all_watchers) { 1284 for (Event::all_watchers) {
1175 $_->cancel if $_->data & WF_AUTOCANCEL; 1285 $_->cancel if $_->data & WF_AUTOCANCEL;
1176 } 1286 }
1177 1287
1288 # cancel all extension coros
1289 $_->cancel for values %EXT_CORO;
1290 %EXT_CORO = ();
1291
1178 # unload all extensions 1292 # unload all extensions
1179 for (@exts) { 1293 for (@exts) {
1180 $msg->("unloading <$_>"); 1294 warn "unloading <$_>";
1181 unload_extension $_; 1295 unload_extension $_;
1182 } 1296 }
1183 1297
1184 # unload all modules loaded from $LIBDIR 1298 # unload all modules loaded from $LIBDIR
1185 while (my ($k, $v) = each %INC) { 1299 while (my ($k, $v) = each %INC) {
1186 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; 1300 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
1187 1301
1188 $msg->("removing <$k>"); 1302 warn "removing <$k>";
1189 delete $INC{$k}; 1303 delete $INC{$k};
1190 1304
1191 $k =~ s/\.pm$//; 1305 $k =~ s/\.pm$//;
1192 $k =~ s/\//::/g; 1306 $k =~ s/\//::/g;
1193 1307
… …
1198 Symbol::delete_package $k; 1312 Symbol::delete_package $k;
1199 } 1313 }
1200 1314
1201 # sync database to disk 1315 # sync database to disk
1202 cf::db_sync; 1316 cf::db_sync;
1317 IO::AIO::flush;
1203 1318
1204 # get rid of safe::, as good as possible 1319 # get rid of safe::, as good as possible
1205 Symbol::delete_package "safe::$_" 1320 Symbol::delete_package "safe::$_"
1206 for qw(cf::object cf::object::player cf::player cf::map cf::party cf::region); 1321 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
1207 1322
1208 # remove register_script_function callbacks 1323 # remove register_script_function callbacks
1209 # TODO 1324 # TODO
1210 1325
1211 # unload cf.pm "a bit" 1326 # unload cf.pm "a bit"
… …
1214 # don't, removes xs symbols, too, 1329 # don't, removes xs symbols, too,
1215 # and global variables created in xs 1330 # and global variables created in xs
1216 #Symbol::delete_package __PACKAGE__; 1331 #Symbol::delete_package __PACKAGE__;
1217 1332
1218 # reload cf.pm 1333 # reload cf.pm
1219 $msg->("reloading cf.pm"); 1334 warn "reloading cf.pm";
1220 require cf; 1335 require cf;
1336 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
1221 1337
1222 # load config and database again 1338 # load config and database again
1223 cf::cfg_load; 1339 cf::cfg_load;
1224 cf::db_load; 1340 cf::db_load;
1225 1341
1226 # load extensions 1342 # load extensions
1227 $msg->("load extensions"); 1343 warn "load extensions";
1228 cf::load_extensions; 1344 cf::load_extensions;
1229 1345
1230 # reattach attachments to objects 1346 # reattach attachments to objects
1231 $msg->("reattach"); 1347 warn "reattach";
1232 _global_reattach; 1348 _global_reattach;
1233 }; 1349 };
1234 $msg->($@) if $@; 1350 warn $@ if $@;
1235 1351
1236 $msg->("reloaded"); 1352 warn "reloaded";
1237}; 1353};
1238 1354
1239sub perl_reload() { 1355sub perl_reload() {
1240 _perl_reload { 1356 _perl_reload;
1241 warn $_[0];
1242 print "$_[0]\n";
1243 };
1244} 1357}
1245 1358
1246register "<global>", __PACKAGE__; 1359register "<global>", __PACKAGE__;
1247 1360
1248register_command "perl-reload" => sub { 1361register_command "perl-reload" => sub {
1249 my ($who, $arg) = @_; 1362 my ($who, $arg) = @_;
1250 1363
1251 if ($who->flag (FLAG_WIZ)) { 1364 if ($who->flag (FLAG_WIZ)) {
1365 $who->message ("reloading...");
1252 _perl_reload { 1366 _perl_reload;
1253 warn $_[0];
1254 $who->message ($_[0]);
1255 };
1256 } 1367 }
1257}; 1368};
1258 1369
1259unshift @INC, $LIBDIR; 1370unshift @INC, $LIBDIR;
1260 1371
1261$TICK_WATCHER = Event->timer ( 1372$TICK_WATCHER = Event->timer (
1373 reentrant => 0,
1262 prio => 0, 1374 prio => 0,
1263 at => $NEXT_TICK || 1, 1375 at => $NEXT_TICK || $TICK,
1264 data => WF_AUTOCANCEL, 1376 data => WF_AUTOCANCEL,
1265 cb => sub { 1377 cb => sub {
1378 unless ($FREEZE) {
1266 cf::server_tick; # one server iteration 1379 cf::server_tick; # one server iteration
1380 $RUNTIME += $TICK;
1381 }
1267 1382
1268 my $NOW = Event::time;
1269 $NEXT_TICK += $TICK; 1383 $NEXT_TICK += $TICK;
1270 1384
1271 # if we are delayed by four ticks or more, skip them all 1385 # if we are delayed by four ticks or more, skip them all
1272 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4; 1386 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
1273 1387
1274 $TICK_WATCHER->at ($NEXT_TICK); 1388 $TICK_WATCHER->at ($NEXT_TICK);
1275 $TICK_WATCHER->start; 1389 $TICK_WATCHER->start;
1276 }, 1390 },
1277); 1391);
… …
1282 poll => 'r', 1396 poll => 'r',
1283 prio => 5, 1397 prio => 5,
1284 data => WF_AUTOCANCEL, 1398 data => WF_AUTOCANCEL,
1285 cb => \&IO::AIO::poll_cb); 1399 cb => \&IO::AIO::poll_cb);
1286 1400
1401# we must not ever block the main coroutine
1402$Coro::idle = sub {
1403 #Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
1404 warn "FATAL: Coro::idle was called, major BUG\n";
1405 (Coro::unblock_sub {
1406 Event::one_event;
1407 })->();
1408};
1409
12871 14101
1288 1411

Diff Legend

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