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.100 by root, Mon Dec 25 11:25:49 2006 UTC vs.
Revision 1.108 by root, Sun Dec 31 21:02:05 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;
18use Coro::AIO;
18 19
20use Digest::MD5;
21use Fcntl;
19use IO::AIO 2.3; 22use IO::AIO 2.31 ();
20use YAML::Syck (); 23use YAML::Syck ();
21use Time::HiRes; 24use Time::HiRes;
22 25
23use Event; $Event::Eval = 1; # no idea why this is required, but it is 26use Event; $Event::Eval = 1; # no idea why this is required, but it is
24 27
25# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode? 28# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
26$YAML::Syck::ImplicitUnicode = 1; 29$YAML::Syck::ImplicitUnicode = 1;
27 30
28$Coro::main->prio (Coro::PRIO_MIN); 31$Coro::main->prio (2); # run main coroutine ("the server") with very high priority
29 32
30sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 33sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
31 34
32our %COMMAND = (); 35our %COMMAND = ();
33our %COMMAND_TIME = (); 36our %COMMAND_TIME = ();
… …
37our $LIBDIR = datadir . "/ext"; 40our $LIBDIR = datadir . "/ext";
38 41
39our $TICK = MAX_TIME * 1e-6; 42our $TICK = MAX_TIME * 1e-6;
40our $TICK_WATCHER; 43our $TICK_WATCHER;
41our $NEXT_TICK; 44our $NEXT_TICK;
45our $NOW;
42 46
43our %CFG; 47our %CFG;
44 48
45our $UPTIME; $UPTIME ||= time; 49our $UPTIME; $UPTIME ||= time;
50our $RUNTIME;
51
52our %MAP; # all maps
53our $LINK_MAP; # the special {link} map
54our $FREEZE;
55our $RANDOM_MAPS = cf::localdir . "/random";
56our %EXT_CORO;
57
58binmode STDOUT;
59binmode STDERR;
60
61# read virtual server time, if available
62unless ($RUNTIME || !-e cf::localdir . "/runtime") {
63 open my $fh, "<", cf::localdir . "/runtime"
64 or die "unable to read runtime file: $!";
65 $RUNTIME = <$fh> + 0.;
66}
67
68mkdir cf::localdir;
69mkdir cf::localdir . "/" . cf::playerdir;
70mkdir cf::localdir . "/" . cf::tmpdir;
71mkdir cf::localdir . "/" . cf::uniquedir;
72mkdir $RANDOM_MAPS;
73
74# a special map that is always available
75our $LINK_MAP;
46 76
47############################################################################# 77#############################################################################
48 78
49=head2 GLOBAL VARIABLES 79=head2 GLOBAL VARIABLES
50 80
51=over 4 81=over 4
52 82
53=item $cf::UPTIME 83=item $cf::UPTIME
54 84
55The timestamp of the server start (so not actually an uptime). 85The timestamp of the server start (so not actually an uptime).
86
87=item $cf::RUNTIME
88
89The time this server has run, starts at 0 and is increased by $cf::TICK on
90every server tick.
56 91
57=item $cf::LIBDIR 92=item $cf::LIBDIR
58 93
59The perl library directory, where extensions and cf-specific modules can 94The perl library directory, where extensions and cf-specific modules can
60be found. It will be added to C<@INC> automatically. 95be found. It will be added to C<@INC> automatically.
96
97=item $cf::NOW
98
99The time of the last (current) server tick.
61 100
62=item $cf::TICK 101=item $cf::TICK
63 102
64The interval between server ticks, in seconds. 103The interval between server ticks, in seconds.
65 104
… …
73=cut 112=cut
74 113
75BEGIN { 114BEGIN {
76 *CORE::GLOBAL::warn = sub { 115 *CORE::GLOBAL::warn = sub {
77 my $msg = join "", @_; 116 my $msg = join "", @_;
117 utf8::encode $msg;
118
78 $msg .= "\n" 119 $msg .= "\n"
79 unless $msg =~ /\n$/; 120 unless $msg =~ /\n$/;
80 121
81 print STDERR "cfperl: $msg";
82 LOG llevError, "cfperl: $msg"; 122 LOG llevError, "cfperl: $msg";
83 }; 123 };
84} 124}
85 125
86@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 126@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
… …
139sub to_json($) { 179sub to_json($) {
140 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 180 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
141 JSON::Syck::Dump $_[0] 181 JSON::Syck::Dump $_[0]
142} 182}
143 183
184=item cf::sync_job { BLOCK }
185
186The design of crossfire+ requires that the main coro ($Coro::main) is
187always able to handle events or runnable, as crossfire+ is only partly
188reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable.
189
190If it must be done, put the blocking parts into C<sync_job>. This will run
191the given BLOCK in another coroutine while waiting for the result. The
192server will be frozen during this time, so the block should either finish
193fast or be very important.
194
195=cut
196
197sub sync_job(&) {
198 my ($job) = @_;
199
200 my $busy = 1;
201 my @res;
202
203 # TODO: use suspend/resume instead
204 local $FREEZE = 1;
205
206 my $coro = Coro::async {
207 @res = eval { $job->() };
208 warn $@ if $@;
209 undef $busy;
210 };
211
212 if ($Coro::current == $Coro::main) {
213 $coro->prio (Coro::PRIO_MAX);
214 while ($busy) {
215 Coro::cede_notself;
216 Event::one_event unless Coro::nready;
217 }
218 } else {
219 $coro->join;
220 }
221
222 wantarray ? @res : $res[0]
223}
224
225=item $coro = cf::coro { BLOCK }
226
227Creates and returns a new coro. This coro is automcatially being canceled
228when the extension calling this is being unloaded.
229
230=cut
231
232sub coro(&) {
233 my $cb = shift;
234
235 my $coro; $coro = async {
236 eval {
237 $cb->();
238 };
239 warn $@ if $@;
240 };
241
242 $coro->on_destroy (sub {
243 delete $EXT_CORO{$coro+0};
244 });
245 $EXT_CORO{$coro+0} = $coro;
246
247 $coro
248}
249
250sub write_runtime {
251 my $runtime = cf::localdir . "/runtime";
252
253 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644
254 or return;
255
256 my $value = $cf::RUNTIME;
257 (aio_write $fh, 0, (length $value), $value, 0) <= 0
258 and return;
259
260 aio_fsync $fh
261 and return;
262
263 close $fh
264 or return;
265
266 aio_rename "$runtime~", $runtime
267 and return;
268
269 1
270}
271
144=back 272=back
145 273
146=cut 274=cut
275
276#############################################################################
277
278package cf::path;
279
280sub new {
281 my ($class, $path, $base) = @_;
282
283 my $self = bless { }, $class;
284
285 if ($path =~ s{^\?random/}{}) {
286 $self->{random} = cf::from_json $path;
287 } else {
288 if ($path =~ s{^~([^/]+)?}{}) {
289 $self->{user_rel} = 1;
290
291 if (defined $1) {
292 $self->{user} = $1;
293 } elsif ($base =~ m{^~([^/]+)/}) {
294 $self->{user} = $1;
295 } else {
296 warn "cannot resolve user-relative path without user <$path,$base>\n";
297 }
298 } elsif ($path =~ /^\//) {
299 # already absolute
300 } else {
301 $base =~ s{[^/]+/?$}{};
302 return $class->new ("$base/$path");
303 }
304
305 for ($path) {
306 redo if s{/\.?/}{/};
307 redo if s{/[^/]+/\.\./}{/};
308 }
309 }
310
311 $self->{path} = $path;
312
313 $self
314}
315
316# the name / primary key / in-game path
317sub as_string {
318 my ($self) = @_;
319
320 $self->{user_rel} ? "~$self->{user}$self->{path}"
321 : $self->{random} ? "?random/$self->{path}"
322 : $self->{path}
323}
324
325# the displayed name, this is a one way mapping
326sub visible_name {
327 my ($self) = @_;
328
329 $self->{random} ? "?random/$self->{random}{origin_map}+$self->{random}{origin_x}+$self->{random}{origin_y}/$self->{random}{dungeon_level}"
330 : $self->as_string
331}
332
333# escape the /'s in the path
334sub _escaped_path {
335 # ∕ is U+2215
336 (my $path = $_[0]{path}) =~ s/\//∕/g;
337 $path
338}
339
340# the original (read-only) location
341sub load_path {
342 my ($self) = @_;
343
344 sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
345}
346
347# the temporary/swap location
348sub save_path {
349 my ($self) = @_;
350
351 $self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
352 : $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, Digest::MD5::md5_hex $self->{path}
353 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
354}
355
356# the unique path, might be eq to save_path
357sub uniq_path {
358 my ($self) = @_;
359
360 $self->{user_rel} || $self->{random}
361 ? undef
362 : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
363}
364
365# return random map parameters, or undef
366sub random_map_params {
367 my ($self) = @_;
368
369 $self->{random}
370}
371
372# this is somewhat ugly, but style maps do need special treatment
373sub is_style_map {
374 $_[0]{path} =~ m{^/styles/}
375}
376
377package cf;
147 378
148############################################################################# 379#############################################################################
149 380
150=head2 ATTACHABLE OBJECTS 381=head2 ATTACHABLE OBJECTS
151 382
… …
454=cut 685=cut
455 686
456############################################################################# 687#############################################################################
457# object support 688# object support
458 689
690sub reattach {
691 # basically do the same as instantiate, without calling instantiate
692 my ($obj) = @_;
693
694 my $registry = $obj->registry;
695
696 @$registry = ();
697
698 delete $obj->{_attachment} unless scalar keys %{ $obj->{_attachment} || {} };
699
700 for my $name (keys %{ $obj->{_attachment} || {} }) {
701 if (my $attach = $attachment{$name}) {
702 for (@$attach) {
703 my ($klass, @attach) = @$_;
704 _attach $registry, $klass, @attach;
705 }
706 } else {
707 warn "object uses attachment '$name' that is not available, postponing.\n";
708 }
709 }
710}
711
459cf::attachable->attach ( 712cf::attachable->attach (
460 prio => -1000000, 713 prio => -1000000,
461 on_instantiate => sub { 714 on_instantiate => sub {
462 my ($obj, $data) = @_; 715 my ($obj, $data) = @_;
463 716
… …
467 my ($name, $args) = @$_; 720 my ($name, $args) = @$_;
468 721
469 $obj->attach ($name, %{$args || {} }); 722 $obj->attach ($name, %{$args || {} });
470 } 723 }
471 }, 724 },
472 on_reattach => sub { 725 on_reattach => \&reattach,
473 # basically do the same as instantiate, without calling instantiate
474 my ($obj) = @_;
475 my $registry = $obj->registry;
476
477 @$registry = ();
478
479 delete $obj->{_attachment} unless scalar keys %{ $obj->{_attachment} || {} };
480
481 for my $name (keys %{ $obj->{_attachment} || {} }) {
482 if (my $attach = $attachment{$name}) {
483 for (@$attach) {
484 my ($klass, @attach) = @$_;
485 _attach $registry, $klass, @attach;
486 }
487 } else {
488 warn "object uses attachment '$name' that is not available, postponing.\n";
489 }
490 }
491 },
492 on_clone => sub { 726 on_clone => sub {
493 my ($src, $dst) = @_; 727 my ($src, $dst) = @_;
494 728
495 @{$dst->registry} = @{$src->registry}; 729 @{$dst->registry} = @{$src->registry};
496 730
… …
502); 736);
503 737
504sub object_freezer_save { 738sub object_freezer_save {
505 my ($filename, $rdata, $objs) = @_; 739 my ($filename, $rdata, $objs) = @_;
506 740
741 sync_job {
507 if (length $$rdata) { 742 if (length $$rdata) {
508 warn sprintf "saving %s (%d,%d)\n", 743 warn sprintf "saving %s (%d,%d)\n",
509 $filename, length $$rdata, scalar @$objs; 744 $filename, length $$rdata, scalar @$objs;
510 745
511 if (open my $fh, ">:raw", "$filename~") { 746 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
512 chmod SAVE_MODE, $fh;
513 syswrite $fh, $$rdata;
514 close $fh;
515
516 if (@$objs && open my $fh, ">:raw", "$filename.pst~") {
517 chmod SAVE_MODE, $fh; 747 chmod SAVE_MODE, $fh;
518 syswrite $fh, Storable::nfreeze { version => 1, objs => $objs }; 748 aio_write $fh, 0, (length $$rdata), $$rdata, 0;
749 aio_fsync $fh;
519 close $fh; 750 close $fh;
751
752 if (@$objs) {
753 if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) {
754 chmod SAVE_MODE, $fh;
755 my $data = Storable::nfreeze { version => 1, objs => $objs };
756 aio_write $fh, 0, (length $data), $data, 0;
757 aio_fsync $fh;
758 close $fh;
520 rename "$filename.pst~", "$filename.pst"; 759 aio_rename "$filename.pst~", "$filename.pst";
760 }
761 } else {
762 aio_unlink "$filename.pst";
763 }
764
765 aio_rename "$filename~", $filename;
521 } else { 766 } else {
522 unlink "$filename.pst"; 767 warn "FATAL: $filename~: $!\n";
523 } 768 }
524
525 rename "$filename~", $filename;
526 } else { 769 } else {
527 warn "FATAL: $filename~: $!\n";
528 }
529 } else {
530 unlink $filename; 770 aio_unlink $filename;
531 unlink "$filename.pst"; 771 aio_unlink "$filename.pst";
772 }
532 } 773 }
533} 774}
534 775
535sub object_freezer_as_string { 776sub object_freezer_as_string {
536 my ($rdata, $objs) = @_; 777 my ($rdata, $objs) = @_;
… …
541} 782}
542 783
543sub object_thawer_load { 784sub object_thawer_load {
544 my ($filename) = @_; 785 my ($filename) = @_;
545 786
546 local $/; 787 my ($data, $av);
547 788
548 my $av; 789 (aio_load $filename, $data) >= 0
790 or return;
549 791
550 #TODO: use sysread etc. 792 unless (aio_stat "$filename.pst") {
551 if (open my $data, "<:raw:perlio", $filename) { 793 (aio_load "$filename.pst", $av) >= 0
552 $data = <$data>; 794 or return;
553 if (open my $pst, "<:raw:perlio", "$filename.pst") {
554 $av = eval { (Storable::thaw <$pst>)->{objs} }; 795 $av = eval { (Storable::thaw <$av>)->{objs} };
555 } 796 }
797
556 return ($data, $av); 798 return ($data, $av);
557 }
558
559 ()
560} 799}
561 800
562############################################################################# 801#############################################################################
563# command handling &c 802# command handling &c
564 803
… …
913 my $coro; $coro = async { 1152 my $coro; $coro = async {
914 eval { 1153 eval {
915 $cb->(); 1154 $cb->();
916 }; 1155 };
917 warn $@ if $@; 1156 warn $@ if $@;
1157 };
1158
1159 $coro->on_destroy (sub {
918 delete $self->{_coro}{$coro+0}; 1160 delete $self->{_coro}{$coro+0};
919 }; 1161 });
920 1162
921 $self->{_coro}{$coro+0} = $coro; 1163 $self->{_coro}{$coro+0} = $coro;
1164
1165 $coro
922} 1166}
923 1167
924cf::client->attach ( 1168cf::client->attach (
925 on_destroy => sub { 1169 on_destroy => sub {
926 my ($ns) = @_; 1170 my ($ns) = @_;
… …
1158 local $/; 1402 local $/;
1159 *CFG = YAML::Syck::Load <$fh>; 1403 *CFG = YAML::Syck::Load <$fh>;
1160} 1404}
1161 1405
1162sub main { 1406sub main {
1407 # we must not ever block the main coroutine
1408 local $Coro::idle = sub {
1409 Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
1410 (Coro::unblock_sub {
1411 Event::one_event;
1412 })->();
1413 };
1414
1163 cfg_load; 1415 cfg_load;
1164 db_load; 1416 db_load;
1165 load_extensions; 1417 load_extensions;
1166 Event::loop; 1418 Event::loop;
1167} 1419}
1168 1420
1169############################################################################# 1421#############################################################################
1170# initialisation 1422# initialisation
1171 1423
1172sub _perl_reload(&) { 1424sub perl_reload() {
1173 my ($msg) = @_; 1425 # can/must only be called in main
1426 if ($Coro::current != $Coro::main) {
1427 warn "can only reload from main coroutine\n";
1428 return;
1429 }
1174 1430
1175 $msg->("reloading..."); 1431 warn "reloading...";
1432
1433 local $FREEZE = 1;
1434 cf::emergency_save;
1176 1435
1177 eval { 1436 eval {
1437 # if anything goes wrong in here, we should simply crash as we already saved
1438
1178 # cancel all watchers 1439 # cancel all watchers
1179 for (Event::all_watchers) { 1440 for (Event::all_watchers) {
1180 $_->cancel if $_->data & WF_AUTOCANCEL; 1441 $_->cancel if $_->data & WF_AUTOCANCEL;
1181 } 1442 }
1182 1443
1444 # cancel all extension coros
1445 $_->cancel for values %EXT_CORO;
1446 %EXT_CORO = ();
1447
1183 # unload all extensions 1448 # unload all extensions
1184 for (@exts) { 1449 for (@exts) {
1185 $msg->("unloading <$_>"); 1450 warn "unloading <$_>";
1186 unload_extension $_; 1451 unload_extension $_;
1187 } 1452 }
1188 1453
1189 # unload all modules loaded from $LIBDIR 1454 # unload all modules loaded from $LIBDIR
1190 while (my ($k, $v) = each %INC) { 1455 while (my ($k, $v) = each %INC) {
1191 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; 1456 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
1192 1457
1193 $msg->("removing <$k>"); 1458 warn "removing <$k>";
1194 delete $INC{$k}; 1459 delete $INC{$k};
1195 1460
1196 $k =~ s/\.pm$//; 1461 $k =~ s/\.pm$//;
1197 $k =~ s/\//::/g; 1462 $k =~ s/\//::/g;
1198 1463
… …
1203 Symbol::delete_package $k; 1468 Symbol::delete_package $k;
1204 } 1469 }
1205 1470
1206 # sync database to disk 1471 # sync database to disk
1207 cf::db_sync; 1472 cf::db_sync;
1473 IO::AIO::flush;
1208 1474
1209 # get rid of safe::, as good as possible 1475 # get rid of safe::, as good as possible
1210 Symbol::delete_package "safe::$_" 1476 Symbol::delete_package "safe::$_"
1211 for qw(cf::object cf::object::player cf::player cf::map cf::party cf::region); 1477 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
1212 1478
1213 # remove register_script_function callbacks 1479 # remove register_script_function callbacks
1214 # TODO 1480 # TODO
1215 1481
1216 # unload cf.pm "a bit" 1482 # unload cf.pm "a bit"
… …
1219 # don't, removes xs symbols, too, 1485 # don't, removes xs symbols, too,
1220 # and global variables created in xs 1486 # and global variables created in xs
1221 #Symbol::delete_package __PACKAGE__; 1487 #Symbol::delete_package __PACKAGE__;
1222 1488
1223 # reload cf.pm 1489 # reload cf.pm
1224 $msg->("reloading cf.pm"); 1490 warn "reloading cf.pm";
1225 require cf; 1491 require cf;
1226 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 1492 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
1227
1228 1493
1229 # load config and database again 1494 # load config and database again
1230 cf::cfg_load; 1495 cf::cfg_load;
1231 cf::db_load; 1496 cf::db_load;
1232 1497
1233 # load extensions 1498 # load extensions
1234 $msg->("load extensions"); 1499 warn "load extensions";
1235 cf::load_extensions; 1500 cf::load_extensions;
1236 1501
1237 # reattach attachments to objects 1502 # reattach attachments to objects
1238 $msg->("reattach"); 1503 warn "reattach";
1239 _global_reattach; 1504 _global_reattach;
1240 }; 1505 };
1241 $msg->($@) if $@;
1242 1506
1243 $msg->("reloaded"); 1507 if ($@) {
1508 warn $@;
1509 warn "error while reloading, exiting.";
1510 exit 1;
1511 }
1512
1513 warn "reloaded successfully";
1244}; 1514};
1245 1515
1246sub perl_reload() { 1516#############################################################################
1247 _perl_reload { 1517
1248 warn $_[0]; 1518unless ($LINK_MAP) {
1249 print "$_[0]\n"; 1519 $LINK_MAP = cf::map::new;
1250 }; 1520
1521 $LINK_MAP->width (41);
1522 $LINK_MAP->height (41);
1523 $LINK_MAP->alloc;
1524 $LINK_MAP->path ("{link}");
1525 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
1526 $LINK_MAP->in_memory (MAP_IN_MEMORY);
1251} 1527}
1252 1528
1253register "<global>", __PACKAGE__; 1529register "<global>", __PACKAGE__;
1254 1530
1255register_command "perl-reload" => sub { 1531register_command "perl-reload" => sub {
1256 my ($who, $arg) = @_; 1532 my ($who, $arg) = @_;
1257 1533
1258 if ($who->flag (FLAG_WIZ)) { 1534 if ($who->flag (FLAG_WIZ)) {
1535 $who->message ("start of reload.");
1259 _perl_reload { 1536 perl_reload;
1260 warn $_[0]; 1537 $who->message ("end of reload.");
1261 $who->message ($_[0]);
1262 };
1263 } 1538 }
1264}; 1539};
1265 1540
1266unshift @INC, $LIBDIR; 1541unshift @INC, $LIBDIR;
1267 1542
1268$TICK_WATCHER = Event->timer ( 1543$TICK_WATCHER = Event->timer (
1544 reentrant => 0,
1269 prio => 0, 1545 prio => 0,
1270 at => $NEXT_TICK || 1, 1546 at => $NEXT_TICK || $TICK,
1271 data => WF_AUTOCANCEL, 1547 data => WF_AUTOCANCEL,
1272 cb => sub { 1548 cb => sub {
1549 unless ($FREEZE) {
1273 cf::server_tick; # one server iteration 1550 cf::server_tick; # one server iteration
1551 $RUNTIME += $TICK;
1552 }
1274 1553
1275 my $NOW = Event::time;
1276 $NEXT_TICK += $TICK; 1554 $NEXT_TICK += $TICK;
1277 1555
1278 # if we are delayed by four ticks or more, skip them all 1556 # if we are delayed by four ticks or more, skip them all
1279 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4; 1557 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
1280 1558
1281 $TICK_WATCHER->at ($NEXT_TICK); 1559 $TICK_WATCHER->at ($NEXT_TICK);
1282 $TICK_WATCHER->start; 1560 $TICK_WATCHER->start;
1283 }, 1561 },
1284); 1562);
1285 1563
1286IO::AIO::max_poll_time $TICK * 0.2; 1564IO::AIO::max_poll_time $TICK * 0.2;
1287 1565
1566Event->io (
1288Event->io (fd => IO::AIO::poll_fileno, 1567 fd => IO::AIO::poll_fileno,
1289 poll => 'r', 1568 poll => 'r',
1290 prio => 5, 1569 prio => 5,
1291 data => WF_AUTOCANCEL, 1570 data => WF_AUTOCANCEL,
1292 cb => \&IO::AIO::poll_cb); 1571 cb => \&IO::AIO::poll_cb,
1572);
1573
1574Event->timer (
1575 data => WF_AUTOCANCEL,
1576 after => 0,
1577 interval => 10,
1578 cb => sub {
1579 (Coro::unblock_sub {
1580 write_runtime
1581 or warn "ERROR: unable to write runtime file: $!";
1582 })->();
1583 },
1584);
1293 1585
12941 15861
1295 1587

Diff Legend

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