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.101 by root, Mon Dec 25 14:43:23 2006 UTC vs.
Revision 1.109 by root, Sun Dec 31 22:23:12 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 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
287 $self->{random} = cf::from_json $data;
288 } else {
289 if ($path =~ s{^~([^/]+)?}{}) {
290 $self->{user_rel} = 1;
291
292 if (defined $1) {
293 $self->{user} = $1;
294 } elsif ($base =~ m{^~([^/]+)/}) {
295 $self->{user} = $1;
296 } else {
297 warn "cannot resolve user-relative path without user <$path,$base>\n";
298 }
299 } elsif ($path =~ /^\//) {
300 # already absolute
301 } else {
302 $base =~ s{[^/]+/?$}{};
303 return $class->new ("$base/$path");
304 }
305
306 for ($path) {
307 redo if s{/\.?/}{/};
308 redo if s{/[^/]+/\.\./}{/};
309 }
310 }
311
312 $self->{path} = $path;
313
314 $self
315}
316
317# the name / primary key / in-game path
318sub as_string {
319 my ($self) = @_;
320
321 $self->{user_rel} ? "~$self->{user}$self->{path}"
322 : $self->{random} ? "?random/$self->{path}"
323 : $self->{path}
324}
325
326# the displayed name, this is a one way mapping
327sub visible_name {
328 my ($self) = @_;
329
330# if (my $rmp = $self->{random}) {
331# # todo: be more intelligent about this
332# "?random/$rmp->{origin_map}+$rmp->{origin_x}+$rmp->{origin_y}/$rmp->{dungeon_level}"
333# } else {
334 $self->as_string
335# }
336}
337
338# escape the /'s in the path
339sub _escaped_path {
340 # ∕ is U+2215
341 (my $path = $_[0]{path}) =~ s/\//∕/g;
342 $path
343}
344
345# the original (read-only) location
346sub load_path {
347 my ($self) = @_;
348
349 sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
350}
351
352# the temporary/swap location
353sub save_path {
354 my ($self) = @_;
355
356 $self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
357 : $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, $self->{path}
358 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
359}
360
361# the unique path, might be eq to save_path
362sub uniq_path {
363 my ($self) = @_;
364
365 $self->{user_rel} || $self->{random}
366 ? undef
367 : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
368}
369
370# return random map parameters, or undef
371sub random_map_params {
372 my ($self) = @_;
373
374 $self->{random}
375}
376
377# this is somewhat ugly, but style maps do need special treatment
378sub is_style_map {
379 $_[0]{path} =~ m{^/styles/}
380}
381
382package cf;
147 383
148############################################################################# 384#############################################################################
149 385
150=head2 ATTACHABLE OBJECTS 386=head2 ATTACHABLE OBJECTS
151 387
… …
454=cut 690=cut
455 691
456############################################################################# 692#############################################################################
457# object support 693# object support
458 694
695sub reattach {
696 # basically do the same as instantiate, without calling instantiate
697 my ($obj) = @_;
698
699 my $registry = $obj->registry;
700
701 @$registry = ();
702
703 delete $obj->{_attachment} unless scalar keys %{ $obj->{_attachment} || {} };
704
705 for my $name (keys %{ $obj->{_attachment} || {} }) {
706 if (my $attach = $attachment{$name}) {
707 for (@$attach) {
708 my ($klass, @attach) = @$_;
709 _attach $registry, $klass, @attach;
710 }
711 } else {
712 warn "object uses attachment '$name' that is not available, postponing.\n";
713 }
714 }
715}
716
459cf::attachable->attach ( 717cf::attachable->attach (
460 prio => -1000000, 718 prio => -1000000,
461 on_instantiate => sub { 719 on_instantiate => sub {
462 my ($obj, $data) = @_; 720 my ($obj, $data) = @_;
463 721
… …
467 my ($name, $args) = @$_; 725 my ($name, $args) = @$_;
468 726
469 $obj->attach ($name, %{$args || {} }); 727 $obj->attach ($name, %{$args || {} });
470 } 728 }
471 }, 729 },
472 on_reattach => sub { 730 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 { 731 on_clone => sub {
493 my ($src, $dst) = @_; 732 my ($src, $dst) = @_;
494 733
495 @{$dst->registry} = @{$src->registry}; 734 @{$dst->registry} = @{$src->registry};
496 735
… …
502); 741);
503 742
504sub object_freezer_save { 743sub object_freezer_save {
505 my ($filename, $rdata, $objs) = @_; 744 my ($filename, $rdata, $objs) = @_;
506 745
746 sync_job {
507 if (length $$rdata) { 747 if (length $$rdata) {
508 warn sprintf "saving %s (%d,%d)\n", 748 warn sprintf "saving %s (%d,%d)\n",
509 $filename, length $$rdata, scalar @$objs; 749 $filename, length $$rdata, scalar @$objs;
510 750
511 if (open my $fh, ">:raw", "$filename~") { 751 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; 752 chmod SAVE_MODE, $fh;
518 syswrite $fh, Storable::nfreeze { version => 1, objs => $objs }; 753 aio_write $fh, 0, (length $$rdata), $$rdata, 0;
754 aio_fsync $fh;
519 close $fh; 755 close $fh;
756
757 if (@$objs) {
758 if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) {
759 chmod SAVE_MODE, $fh;
760 my $data = Storable::nfreeze { version => 1, objs => $objs };
761 aio_write $fh, 0, (length $data), $data, 0;
762 aio_fsync $fh;
763 close $fh;
520 rename "$filename.pst~", "$filename.pst"; 764 aio_rename "$filename.pst~", "$filename.pst";
765 }
766 } else {
767 aio_unlink "$filename.pst";
768 }
769
770 aio_rename "$filename~", $filename;
521 } else { 771 } else {
522 unlink "$filename.pst"; 772 warn "FATAL: $filename~: $!\n";
523 } 773 }
524
525 rename "$filename~", $filename;
526 } else { 774 } else {
527 warn "FATAL: $filename~: $!\n";
528 }
529 } else {
530 unlink $filename; 775 aio_unlink $filename;
531 unlink "$filename.pst"; 776 aio_unlink "$filename.pst";
777 }
532 } 778 }
533} 779}
534 780
535sub object_freezer_as_string { 781sub object_freezer_as_string {
536 my ($rdata, $objs) = @_; 782 my ($rdata, $objs) = @_;
… …
541} 787}
542 788
543sub object_thawer_load { 789sub object_thawer_load {
544 my ($filename) = @_; 790 my ($filename) = @_;
545 791
546 local $/; 792 my ($data, $av);
547 793
548 my $av; 794 (aio_load $filename, $data) >= 0
795 or return;
549 796
550 #TODO: use sysread etc. 797 unless (aio_stat "$filename.pst") {
551 if (open my $data, "<:raw:perlio", $filename) { 798 (aio_load "$filename.pst", $av) >= 0
552 $data = <$data>; 799 or return;
553 if (open my $pst, "<:raw:perlio", "$filename.pst") {
554 $av = eval { (Storable::thaw <$pst>)->{objs} }; 800 $av = eval { (Storable::thaw <$av>)->{objs} };
555 } 801 }
802
556 return ($data, $av); 803 return ($data, $av);
557 }
558
559 ()
560} 804}
561 805
562############################################################################# 806#############################################################################
563# command handling &c 807# command handling &c
564 808
… …
913 my $coro; $coro = async { 1157 my $coro; $coro = async {
914 eval { 1158 eval {
915 $cb->(); 1159 $cb->();
916 }; 1160 };
917 warn $@ if $@; 1161 warn $@ if $@;
1162 };
1163
1164 $coro->on_destroy (sub {
918 delete $self->{_coro}{$coro+0}; 1165 delete $self->{_coro}{$coro+0};
919 }; 1166 });
920 1167
921 $self->{_coro}{$coro+0} = $coro; 1168 $self->{_coro}{$coro+0} = $coro;
1169
1170 $coro
922} 1171}
923 1172
924cf::client->attach ( 1173cf::client->attach (
925 on_destroy => sub { 1174 on_destroy => sub {
926 my ($ns) = @_; 1175 my ($ns) = @_;
… …
1158 local $/; 1407 local $/;
1159 *CFG = YAML::Syck::Load <$fh>; 1408 *CFG = YAML::Syck::Load <$fh>;
1160} 1409}
1161 1410
1162sub main { 1411sub main {
1412 # we must not ever block the main coroutine
1413 local $Coro::idle = sub {
1414 Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
1415 (Coro::unblock_sub {
1416 Event::one_event;
1417 })->();
1418 };
1419
1163 cfg_load; 1420 cfg_load;
1164 db_load; 1421 db_load;
1165 load_extensions; 1422 load_extensions;
1166 Event::loop; 1423 Event::loop;
1167} 1424}
1168 1425
1169############################################################################# 1426#############################################################################
1170# initialisation 1427# initialisation
1171 1428
1172sub _perl_reload(&) { 1429sub perl_reload() {
1173 my ($msg) = @_; 1430 # can/must only be called in main
1431 if ($Coro::current != $Coro::main) {
1432 warn "can only reload from main coroutine\n";
1433 return;
1434 }
1174 1435
1175 $msg->("reloading..."); 1436 warn "reloading...";
1437
1438 local $FREEZE = 1;
1439 cf::emergency_save;
1176 1440
1177 eval { 1441 eval {
1442 # if anything goes wrong in here, we should simply crash as we already saved
1443
1178 # cancel all watchers 1444 # cancel all watchers
1179 for (Event::all_watchers) { 1445 for (Event::all_watchers) {
1180 $_->cancel if $_->data & WF_AUTOCANCEL; 1446 $_->cancel if $_->data & WF_AUTOCANCEL;
1181 } 1447 }
1182 1448
1449 # cancel all extension coros
1450 $_->cancel for values %EXT_CORO;
1451 %EXT_CORO = ();
1452
1183 # unload all extensions 1453 # unload all extensions
1184 for (@exts) { 1454 for (@exts) {
1185 $msg->("unloading <$_>"); 1455 warn "unloading <$_>";
1186 unload_extension $_; 1456 unload_extension $_;
1187 } 1457 }
1188 1458
1189 # unload all modules loaded from $LIBDIR 1459 # unload all modules loaded from $LIBDIR
1190 while (my ($k, $v) = each %INC) { 1460 while (my ($k, $v) = each %INC) {
1191 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; 1461 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
1192 1462
1193 $msg->("removing <$k>"); 1463 warn "removing <$k>";
1194 delete $INC{$k}; 1464 delete $INC{$k};
1195 1465
1196 $k =~ s/\.pm$//; 1466 $k =~ s/\.pm$//;
1197 $k =~ s/\//::/g; 1467 $k =~ s/\//::/g;
1198 1468
… …
1203 Symbol::delete_package $k; 1473 Symbol::delete_package $k;
1204 } 1474 }
1205 1475
1206 # sync database to disk 1476 # sync database to disk
1207 cf::db_sync; 1477 cf::db_sync;
1478 IO::AIO::flush;
1208 1479
1209 # get rid of safe::, as good as possible 1480 # get rid of safe::, as good as possible
1210 Symbol::delete_package "safe::$_" 1481 Symbol::delete_package "safe::$_"
1211 for qw(cf::object cf::object::player cf::player cf::map cf::party cf::region); 1482 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
1212 1483
1213 # remove register_script_function callbacks 1484 # remove register_script_function callbacks
1214 # TODO 1485 # TODO
1215 1486
1216 # unload cf.pm "a bit" 1487 # unload cf.pm "a bit"
… …
1219 # don't, removes xs symbols, too, 1490 # don't, removes xs symbols, too,
1220 # and global variables created in xs 1491 # and global variables created in xs
1221 #Symbol::delete_package __PACKAGE__; 1492 #Symbol::delete_package __PACKAGE__;
1222 1493
1223 # reload cf.pm 1494 # reload cf.pm
1224 $msg->("reloading cf.pm"); 1495 warn "reloading cf.pm";
1225 require cf; 1496 require cf;
1226 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 1497 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
1227 1498
1228 # load config and database again 1499 # load config and database again
1229 cf::cfg_load; 1500 cf::cfg_load;
1230 cf::db_load; 1501 cf::db_load;
1231 1502
1232 # load extensions 1503 # load extensions
1233 $msg->("load extensions"); 1504 warn "load extensions";
1234 cf::load_extensions; 1505 cf::load_extensions;
1235 1506
1236 # reattach attachments to objects 1507 # reattach attachments to objects
1237 $msg->("reattach"); 1508 warn "reattach";
1238 _global_reattach; 1509 _global_reattach;
1239 }; 1510 };
1240 $msg->($@) if $@;
1241 1511
1242 $msg->("reloaded"); 1512 if ($@) {
1513 warn $@;
1514 warn "error while reloading, exiting.";
1515 exit 1;
1516 }
1517
1518 warn "reloaded successfully";
1243}; 1519};
1244 1520
1245sub perl_reload() { 1521#############################################################################
1246 _perl_reload { 1522
1247 warn $_[0]; 1523unless ($LINK_MAP) {
1248 print "$_[0]\n"; 1524 $LINK_MAP = cf::map::new;
1249 }; 1525
1526 $LINK_MAP->width (41);
1527 $LINK_MAP->height (41);
1528 $LINK_MAP->alloc;
1529 $LINK_MAP->path ("{link}");
1530 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
1531 $LINK_MAP->in_memory (MAP_IN_MEMORY);
1250} 1532}
1251 1533
1252register "<global>", __PACKAGE__; 1534register "<global>", __PACKAGE__;
1253 1535
1254register_command "perl-reload" => sub { 1536register_command "perl-reload" => sub {
1255 my ($who, $arg) = @_; 1537 my ($who, $arg) = @_;
1256 1538
1257 if ($who->flag (FLAG_WIZ)) { 1539 if ($who->flag (FLAG_WIZ)) {
1540 $who->message ("start of reload.");
1258 _perl_reload { 1541 perl_reload;
1259 warn $_[0]; 1542 $who->message ("end of reload.");
1260 $who->message ($_[0]);
1261 };
1262 } 1543 }
1263}; 1544};
1264 1545
1265unshift @INC, $LIBDIR; 1546unshift @INC, $LIBDIR;
1266 1547
1267$TICK_WATCHER = Event->timer ( 1548$TICK_WATCHER = Event->timer (
1549 reentrant => 0,
1268 prio => 0, 1550 prio => 0,
1269 at => $NEXT_TICK || 1, 1551 at => $NEXT_TICK || $TICK,
1270 data => WF_AUTOCANCEL, 1552 data => WF_AUTOCANCEL,
1271 cb => sub { 1553 cb => sub {
1554 unless ($FREEZE) {
1272 cf::server_tick; # one server iteration 1555 cf::server_tick; # one server iteration
1556 $RUNTIME += $TICK;
1557 }
1273 1558
1274 my $NOW = Event::time;
1275 $NEXT_TICK += $TICK; 1559 $NEXT_TICK += $TICK;
1276 1560
1277 # if we are delayed by four ticks or more, skip them all 1561 # if we are delayed by four ticks or more, skip them all
1278 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4; 1562 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
1279 1563
1280 $TICK_WATCHER->at ($NEXT_TICK); 1564 $TICK_WATCHER->at ($NEXT_TICK);
1281 $TICK_WATCHER->start; 1565 $TICK_WATCHER->start;
1282 }, 1566 },
1283); 1567);
1284 1568
1285IO::AIO::max_poll_time $TICK * 0.2; 1569IO::AIO::max_poll_time $TICK * 0.2;
1286 1570
1571Event->io (
1287Event->io (fd => IO::AIO::poll_fileno, 1572 fd => IO::AIO::poll_fileno,
1288 poll => 'r', 1573 poll => 'r',
1289 prio => 5, 1574 prio => 5,
1290 data => WF_AUTOCANCEL, 1575 data => WF_AUTOCANCEL,
1291 cb => \&IO::AIO::poll_cb); 1576 cb => \&IO::AIO::poll_cb,
1577);
1578
1579Event->timer (
1580 data => WF_AUTOCANCEL,
1581 after => 0,
1582 interval => 10,
1583 cb => sub {
1584 (Coro::unblock_sub {
1585 write_runtime
1586 or warn "ERROR: unable to write runtime file: $!";
1587 })->();
1588 },
1589);
1292 1590
12931 15911
1294 1592

Diff Legend

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