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.137 by root, Fri Jan 5 10:23:05 2007 UTC vs.
Revision 1.175 by root, Sun Jan 14 21:20:51 2007 UTC

… …
8use Storable; 8use Storable;
9use Opcode; 9use Opcode;
10use Safe; 10use Safe;
11use Safe::Hole; 11use Safe::Hole;
12 12
13use Coro 3.3 (); 13use Coro 3.4 ();
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; 18use Coro::AIO;
19 19
20use Data::Dumper;
20use Digest::MD5; 21use Digest::MD5;
21use Fcntl; 22use Fcntl;
22use IO::AIO 2.31 (); 23use IO::AIO 2.32 ();
23use YAML::Syck (); 24use YAML::Syck ();
24use Time::HiRes; 25use Time::HiRes;
25 26
26use Event; $Event::Eval = 1; # no idea why this is required, but it is 27use Event; $Event::Eval = 1; # no idea why this is required, but it is
27 28
29sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
30
28# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode? 31# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
29$YAML::Syck::ImplicitUnicode = 1; 32$YAML::Syck::ImplicitUnicode = 1;
30 33
31$Coro::main->prio (2); # run main coroutine ("the server") with very high priority 34$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
32
33sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
34 35
35our %COMMAND = (); 36our %COMMAND = ();
36our %COMMAND_TIME = (); 37our %COMMAND_TIME = ();
38
39our @EXTS = (); # list of extension package names
37our %EXTCMD = (); 40our %EXTCMD = ();
41our %EXT_CORO = (); # coroutines bound to extensions
42our %EXT_MAP = (); # pluggable maps
38 43
39our @EVENT; 44our @EVENT;
40our $LIBDIR = datadir . "/ext"; 45our $LIBDIR = datadir . "/ext";
41 46
42our $TICK = MAX_TIME * 1e-6; 47our $TICK = MAX_TIME * 1e-6;
43our $TICK_WATCHER; 48our $TICK_WATCHER;
49our $AIO_POLL_WATCHER;
50our $WRITE_RUNTIME_WATCHER;
44our $NEXT_TICK; 51our $NEXT_TICK;
45our $NOW; 52our $NOW;
46 53
47our %CFG; 54our %CFG;
48 55
49our $UPTIME; $UPTIME ||= time; 56our $UPTIME; $UPTIME ||= time;
50our $RUNTIME; 57our $RUNTIME;
51 58
59our %PLAYER; # all users
52our %MAP; # all maps 60our %MAP; # all maps
53our $LINK_MAP; # the special {link} map 61our $LINK_MAP; # the special {link} map, which is always available
54our $RANDOM_MAPS = cf::localdir . "/random"; 62our $RANDOM_MAPS = cf::localdir . "/random";
55our %EXT_CORO; 63
64our $WAIT_FOR_TICK; $WAIT_FOR_TICK ||= new Coro::Signal;
65our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal;
66
67# used to convert map paths into valid unix filenames by replacing / by ∕
68our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
56 69
57binmode STDOUT; 70binmode STDOUT;
58binmode STDERR; 71binmode STDERR;
59 72
60# read virtual server time, if available 73# read virtual server time, if available
… …
68mkdir cf::localdir . "/" . cf::playerdir; 81mkdir cf::localdir . "/" . cf::playerdir;
69mkdir cf::localdir . "/" . cf::tmpdir; 82mkdir cf::localdir . "/" . cf::tmpdir;
70mkdir cf::localdir . "/" . cf::uniquedir; 83mkdir cf::localdir . "/" . cf::uniquedir;
71mkdir $RANDOM_MAPS; 84mkdir $RANDOM_MAPS;
72 85
73# a special map that is always available
74our $LINK_MAP;
75our $EMERGENCY_POSITION; 86our $EMERGENCY_POSITION;
76 87
77############################################################################# 88#############################################################################
78 89
79=head2 GLOBAL VARIABLES 90=head2 GLOBAL VARIABLES
… …
104 115
105=item %cf::CFG 116=item %cf::CFG
106 117
107Configuration for the server, loaded from C</etc/crossfire/config>, or 118Configuration for the server, loaded from C</etc/crossfire/config>, or
108from wherever your confdir points to. 119from wherever your confdir points to.
120
121=item $cf::WAIT_FOR_TICK, $cf::WAIT_FOR_TICK_ONE
122
123These are Coro::Signal objects that are C<< ->broadcast >> (WAIT_FOR_TICK)
124or C<< ->send >> (WAIT_FOR_TICK_ONE) on after normal server tick
125processing has been done. Call C<< ->wait >> on them to maximise the
126window of cpu time available, or simply to synchronise to the server tick.
109 127
110=back 128=back
111 129
112=cut 130=cut
113 131
… …
117 utf8::encode $msg; 135 utf8::encode $msg;
118 136
119 $msg .= "\n" 137 $msg .= "\n"
120 unless $msg =~ /\n$/; 138 unless $msg =~ /\n$/;
121 139
122 LOG llevError, "cfperl: $msg"; 140 LOG llevError, $msg;
123 }; 141 };
124} 142}
125 143
126@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 144@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
127@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 145@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
… …
145 163
146$Event::DIED = sub { 164$Event::DIED = sub {
147 warn "error in event callback: @_"; 165 warn "error in event callback: @_";
148}; 166};
149 167
150my %ext_pkg;
151my @exts;
152my @hook;
153
154=head2 UTILITY FUNCTIONS 168=head2 UTILITY FUNCTIONS
155 169
156=over 4 170=over 4
157 171
172=item dumpval $ref
173
158=cut 174=cut
175
176sub dumpval {
177 eval {
178 local $SIG{__DIE__};
179 my $d;
180 if (1) {
181 $d = new Data::Dumper([$_[0]], ["*var"]);
182 $d->Terse(1);
183 $d->Indent(2);
184 $d->Quotekeys(0);
185 $d->Useqq(1);
186 #$d->Bless(...);
187 $d->Seen($_[1]) if @_ > 1;
188 $d = $d->Dump();
189 }
190 $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
191 $d
192 } || "[unable to dump $_[0]: '$@']";
193}
159 194
160use JSON::Syck (); # TODO# replace by JSON::PC once working 195use JSON::Syck (); # TODO# replace by JSON::PC once working
161 196
162=item $ref = cf::from_json $json 197=item $ref = cf::from_json $json
163 198
… …
221 # wake up all waiters, to be on the safe side 256 # wake up all waiters, to be on the safe side
222 $_->ready for @{ delete $LOCK{$key} }; 257 $_->ready for @{ delete $LOCK{$key} };
223 } 258 }
224} 259}
225 260
226=item cf::async { BLOCK }
227
228Like C<Coro::async>, but runs the given BLOCK in an eval and only logs the
229error instead of exiting the server in case of a problem.
230
231=cut
232
233sub async(&) {
234 my ($cb) = @_;
235
236 Coro::async {
237 eval { $cb->() };
238 warn $@ if $@;
239 }
240}
241
242sub freeze_mainloop { 261sub freeze_mainloop {
243 return unless $TICK_WATCHER->is_active; 262 return unless $TICK_WATCHER->is_active;
244 263
245 my $guard = Coro::guard { $TICK_WATCHER->start }; 264 my $guard = Coro::guard {
265 $TICK_WATCHER->start;
266 $WRITE_RUNTIME_WATCHER->start;
267 };
268 $WRITE_RUNTIME_WATCHER->stop;
246 $TICK_WATCHER->stop; 269 $TICK_WATCHER->stop;
247 $guard 270 $guard
248} 271}
272
273=item cf::async { BLOCK }
274
275Currently the same as Coro::async_pool, meaning you cannot use
276C<on_destroy>, C<join> or other gimmicks on these coroutines. The only
277thing you are allowed to do is call C<prio> on it.
278
279=cut
280
281BEGIN { *async = \&Coro::async_pool }
249 282
250=item cf::sync_job { BLOCK } 283=item cf::sync_job { BLOCK }
251 284
252The design of crossfire+ requires that the main coro ($Coro::main) is 285The design of crossfire+ requires that the main coro ($Coro::main) is
253always able to handle events or runnable, as crossfire+ is only partly 286always able to handle events or runnable, as crossfire+ is only partly
… …
272 my $freeze_guard = freeze_mainloop; 305 my $freeze_guard = freeze_mainloop;
273 306
274 my $busy = 1; 307 my $busy = 1;
275 my @res; 308 my @res;
276 309
277 (Coro::async { 310 (async {
278 @res = eval { $job->() }; 311 @res = eval { $job->() };
279 warn $@ if $@; 312 warn $@ if $@;
280 undef $busy; 313 undef $busy;
281 })->prio (Coro::PRIO_MAX); 314 })->prio (Coro::PRIO_MAX);
282 315
283 while ($busy) { 316 while ($busy) {
284 Coro::cede_notself; 317 Coro::cede or Event::one_event;
285 Event::one_event unless Coro::nready;
286 } 318 }
287 319
288 wantarray ? @res : $res[0] 320 wantarray ? @res : $res[0]
289 } else { 321 } else {
290 # we are in another coroutine, how wonderful, everything just works 322 # we are in another coroutine, how wonderful, everything just works
291 323
292 $job->() 324 $job->()
293 } 325 }
294} 326}
295 327
296=item $coro = cf::coro { BLOCK } 328=item $coro = cf::async_ext { BLOCK }
297 329
298Creates and returns a new coro. This coro is automcatially being canceled 330Like async, but this coro is automatically being canceled when the
299when the extension calling this is being unloaded. 331extension calling this is being unloaded.
300 332
301=cut 333=cut
302 334
303sub coro(&) { 335sub async_ext(&) {
304 my $cb = shift; 336 my $cb = shift;
305 337
306 my $coro = &cf::async ($cb); 338 my $coro = &Coro::async ($cb);
307 339
308 $coro->on_destroy (sub { 340 $coro->on_destroy (sub {
309 delete $EXT_CORO{$coro+0}; 341 delete $EXT_CORO{$coro+0};
310 }); 342 });
311 $EXT_CORO{$coro+0} = $coro; 343 $EXT_CORO{$coro+0} = $coro;
… …
336} 368}
337 369
338=back 370=back
339 371
340=cut 372=cut
341
342#############################################################################
343
344package cf::path;
345
346sub new {
347 my ($class, $path, $base) = @_;
348
349 $path = $path->as_string if ref $path;
350
351 my $self = bless { }, $class;
352
353 # {... are special paths that are not touched
354 # ?xxx/... are special absolute paths
355 # ?random/... random maps
356 # /! non-realised random map exit
357 # /... normal maps
358 # ~/... per-player maps without a specific player (DO NOT USE)
359 # ~user/... per-player map of a specific user
360
361 if ($path =~ /^{/) {
362 # fine as it is
363 } elsif ($path =~ s{^\?random/}{}) {
364 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
365 $self->{random} = cf::from_json $data;
366 } else {
367 if ($path =~ s{^~([^/]+)?}{}) {
368 $self->{user_rel} = 1;
369
370 if (defined $1) {
371 $self->{user} = $1;
372 } elsif ($base =~ m{^~([^/]+)/}) {
373 $self->{user} = $1;
374 } else {
375 warn "cannot resolve user-relative path without user <$path,$base>\n";
376 }
377 } elsif ($path =~ /^\//) {
378 # already absolute
379 } else {
380 $base =~ s{[^/]+/?$}{};
381 return $class->new ("$base/$path");
382 }
383
384 for ($path) {
385 redo if s{/\.?/}{/};
386 redo if s{/[^/]+/\.\./}{/};
387 }
388 }
389
390 $self->{path} = $path;
391
392 $self
393}
394
395# the name / primary key / in-game path
396sub as_string {
397 my ($self) = @_;
398
399 $self->{user_rel} ? "~$self->{user}$self->{path}"
400 : $self->{random} ? "?random/$self->{path}"
401 : $self->{path}
402}
403
404# the displayed name, this is a one way mapping
405sub visible_name {
406 my ($self) = @_;
407
408# if (my $rmp = $self->{random}) {
409# # todo: be more intelligent about this
410# "?random/$rmp->{origin_map}+$rmp->{origin_x}+$rmp->{origin_y}/$rmp->{dungeon_level}"
411# } else {
412 $self->as_string
413# }
414}
415
416# escape the /'s in the path
417sub _escaped_path {
418 # ∕ is U+2215
419 (my $path = $_[0]{path}) =~ s/\//∕/g;
420 $path
421}
422
423# the original (read-only) location
424sub load_path {
425 my ($self) = @_;
426
427 sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
428}
429
430# the temporary/swap location
431sub save_path {
432 my ($self) = @_;
433
434 $self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
435 : $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, $self->{path}
436 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
437}
438
439# the unique path, might be eq to save_path
440sub uniq_path {
441 my ($self) = @_;
442
443 $self->{user_rel} || $self->{random}
444 ? undef
445 : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
446}
447
448# return random map parameters, or undef
449sub random_map_params {
450 my ($self) = @_;
451
452 $self->{random}
453}
454
455# this is somewhat ugly, but style maps do need special treatment
456sub is_style_map {
457 $_[0]{path} =~ m{^/styles/}
458}
459
460package cf;
461 373
462############################################################################# 374#############################################################################
463 375
464=head2 ATTACHABLE OBJECTS 376=head2 ATTACHABLE OBJECTS
465 377
… …
591our @CB_TYPE = (); # registry for type (cf-object class) based events 503our @CB_TYPE = (); # registry for type (cf-object class) based events
592our @CB_MAP = (); 504our @CB_MAP = ();
593 505
594my %attachment; 506my %attachment;
595 507
508sub cf::attachable::thawer_merge {
509 # simply override everything except _meta
510 local $_[0]{_meta};
511 %{$_[0]} = %{$_[1]};
512}
513
596sub _attach_cb($$$$) { 514sub _attach_cb($$$$) {
597 my ($registry, $event, $prio, $cb) = @_; 515 my ($registry, $event, $prio, $cb) = @_;
598 516
599 use sort 'stable'; 517 use sort 'stable';
600 518
… …
771# object support 689# object support
772 690
773sub reattach { 691sub reattach {
774 # basically do the same as instantiate, without calling instantiate 692 # basically do the same as instantiate, without calling instantiate
775 my ($obj) = @_; 693 my ($obj) = @_;
694
695 bless $obj, ref $obj; # re-bless in case extensions have been reloaded
776 696
777 my $registry = $obj->registry; 697 my $registry = $obj->registry;
778 698
779 @$registry = (); 699 @$registry = ();
780 700
… …
912=cut 832=cut
913 833
914sub register_extcmd { 834sub register_extcmd {
915 my ($name, $cb) = @_; 835 my ($name, $cb) = @_;
916 836
917 my $caller = caller;
918 #warn "registering extcmd '$name' to '$caller'";
919
920 $EXTCMD{$name} = [$cb, $caller]; 837 $EXTCMD{$name} = $cb;
921} 838}
922 839
923cf::player->attach ( 840cf::player->attach (
924 on_command => sub { 841 on_command => sub {
925 my ($pl, $name, $params) = @_; 842 my ($pl, $name, $params) = @_;
… …
938 855
939 my $msg = eval { from_json $buf }; 856 my $msg = eval { from_json $buf };
940 857
941 if (ref $msg) { 858 if (ref $msg) {
942 if (my $cb = $EXTCMD{$msg->{msgtype}}) { 859 if (my $cb = $EXTCMD{$msg->{msgtype}}) {
943 if (my %reply = $cb->[0]->($pl, $msg)) { 860 if (my %reply = $cb->($pl, $msg)) {
944 $pl->ext_reply ($msg->{msgid}, %reply); 861 $pl->ext_reply ($msg->{msgid}, %reply);
945 } 862 }
946 } 863 }
947 } else { 864 } else {
948 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; 865 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
… …
950 867
951 cf::override; 868 cf::override;
952 }, 869 },
953); 870);
954 871
955sub register {
956 my ($base, $pkg) = @_;
957
958 #TODO
959}
960
961sub load_extension { 872sub load_extension {
962 my ($path) = @_; 873 my ($path) = @_;
963 874
964 $path =~ /([^\/\\]+)\.ext$/ or die "$path"; 875 $path =~ /([^\/\\]+)\.ext$/ or die "$path";
965 my $base = $1; 876 my $base = $1;
966 my $pkg = $1; 877 my $pkg = $1;
967 $pkg =~ s/[^[:word:]]/_/g; 878 $pkg =~ s/[^[:word:]]/_/g;
968 $pkg = "ext::$pkg"; 879 $pkg = "ext::$pkg";
969 880
970 warn "loading '$path' into '$pkg'\n"; 881 warn "... loading '$path' into '$pkg'\n";
971 882
972 open my $fh, "<:utf8", $path 883 open my $fh, "<:utf8", $path
973 or die "$path: $!"; 884 or die "$path: $!";
974 885
975 my $source = 886 my $source =
976 "package $pkg; use strict; use utf8;\n" 887 "package $pkg; use strict; use utf8;\n"
977 . "#line 1 \"$path\"\n{\n" 888 . "#line 1 \"$path\"\n{\n"
978 . (do { local $/; <$fh> }) 889 . (do { local $/; <$fh> })
979 . "\n};\n1"; 890 . "\n};\n1";
980 891
981 eval $source 892 unless (eval $source) {
982 or die $@ ? "$path: $@\n" 893 my $msg = $@ ? "$path: $@\n"
983 : "extension disabled.\n"; 894 : "extension disabled.\n";
984 895 if ($source =~ /^#!.*perl.*#.*MANDATORY/m) { # ugly match
985 push @exts, $pkg; 896 warn $@;
986 $ext_pkg{$base} = $pkg; 897 warn "mandatory extension failed to load, exiting.\n";
987 898 exit 1;
988# no strict 'refs'; 899 }
989# @{"$pkg\::ISA"} = ext::; 900 die $@;
990
991 register $base, $pkg;
992}
993
994sub unload_extension {
995 my ($pkg) = @_;
996
997 warn "removing extension $pkg\n";
998
999 # remove hooks
1000 #TODO
1001# for my $idx (0 .. $#PLUGIN_EVENT) {
1002# delete $hook[$idx]{$pkg};
1003# } 901 }
1004 902
1005 # remove commands 903 push @EXTS, $pkg;
1006 for my $name (keys %COMMAND) {
1007 my @cb = grep $_->[0] ne $pkg, @{ $COMMAND{$name} };
1008
1009 if (@cb) {
1010 $COMMAND{$name} = \@cb;
1011 } else {
1012 delete $COMMAND{$name};
1013 }
1014 }
1015
1016 # remove extcmds
1017 for my $name (grep $EXTCMD{$_}[1] eq $pkg, keys %EXTCMD) {
1018 delete $EXTCMD{$name};
1019 }
1020
1021 if (my $cb = $pkg->can ("unload")) {
1022 eval {
1023 $cb->($pkg);
1024 1
1025 } or warn "$pkg unloaded, but with errors: $@";
1026 }
1027
1028 Symbol::delete_package $pkg;
1029} 904}
1030 905
1031sub load_extensions { 906sub load_extensions {
1032 for my $ext (<$LIBDIR/*.ext>) { 907 for my $ext (<$LIBDIR/*.ext>) {
1033 next unless -r $ext; 908 next unless -r $ext;
… …
1037 } or warn "$ext not loaded: $@"; 912 } or warn "$ext not loaded: $@";
1038 } 913 }
1039} 914}
1040 915
1041############################################################################# 916#############################################################################
1042# load/save/clean perl data associated with a map
1043
1044*cf::mapsupport::on_clean = sub {
1045 my ($map) = @_;
1046
1047 my $path = $map->tmpname;
1048 defined $path or return;
1049
1050 unlink "$path.pst";
1051};
1052
1053cf::map->attach (prio => -10000, package => cf::mapsupport::);
1054
1055#############################################################################
1056# load/save perl data associated with player->ob objects
1057
1058sub all_objects(@) {
1059 @_, map all_objects ($_->inv), @_
1060}
1061
1062# TODO: compatibility cruft, remove when no longer needed
1063cf::player->attach (
1064 on_load => sub {
1065 my ($pl, $path) = @_;
1066
1067 for my $o (all_objects $pl->ob) {
1068 if (my $value = $o->get_ob_key_value ("_perl_data")) {
1069 $o->set_ob_key_value ("_perl_data");
1070
1071 %$o = %{ Storable::thaw pack "H*", $value };
1072 }
1073 }
1074 },
1075);
1076
1077#############################################################################
1078 917
1079=head2 CORE EXTENSIONS 918=head2 CORE EXTENSIONS
1080 919
1081Functions and methods that extend core crossfire objects. 920Functions and methods that extend core crossfire objects.
1082 921
922=cut
923
924package cf::player;
925
926use Coro::AIO;
927
1083=head3 cf::player 928=head3 cf::player
1084 929
1085=over 4 930=over 4
1086 931
1087=item cf::player::exists $login 932=item cf::player::find $login
1088 933
1089Returns true when the given account exists. 934Returns the given player object, loading it if necessary (might block).
1090 935
1091=cut 936=cut
1092 937
1093sub cf::player::exists($) { 938sub playerdir($) {
1094 cf::player::find $_[0] 939 cf::localdir
1095 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2; 940 . "/"
941 . cf::playerdir
942 . "/"
943 . (ref $_[0] ? $_[0]->ob->name : $_[0])
944}
945
946sub path($) {
947 my $login = ref $_[0] ? $_[0]->ob->name : $_[0];
948
949 (playerdir $login) . "/$login.pl"
950}
951
952sub find_active($) {
953 $cf::PLAYER{$_[0]}
954 and $cf::PLAYER{$_[0]}->active
955 and $cf::PLAYER{$_[0]}
956}
957
958sub exists($) {
959 my ($login) = @_;
960
961 $cf::PLAYER{$login}
962 or cf::sync_job { !aio_stat $login }
963}
964
965sub find($) {
966 return $cf::PLAYER{$_[0]} || do {
967 my $login = $_[0];
968
969 my $guard = cf::lock_acquire "user_find:$login";
970
971 $cf::PLAYER{$_[0]} || do {
972 my $pl = load_pl path $login
973 or return;
974 $cf::PLAYER{$login} = $pl
975 }
976 }
977}
978
979sub save($) {
980 my ($pl) = @_;
981
982 return if $pl->{deny_save};
983
984 my $path = path $pl;
985 my $guard = cf::lock_acquire "user_save:$path";
986
987 return if $pl->{deny_save};
988
989 aio_mkdir playerdir $pl, 0770;
990 $pl->{last_save} = $cf::RUNTIME;
991
992 $pl->save_pl ($path);
993 Coro::cede;
994}
995
996sub new($) {
997 my ($login) = @_;
998
999 my $self = create;
1000
1001 $self->ob->name ($login);
1002 $self->{deny_save} = 1;
1003
1004 $cf::PLAYER{$login} = $self;
1005
1006 $self
1007}
1008
1009=item $pl->quit_character
1010
1011Nukes the player without looking back. If logged in, the connection will
1012be destroyed. May block for a long time.
1013
1014=cut
1015
1016sub quit_character {
1017 my ($pl) = @_;
1018
1019 $pl->{deny_save} = 1;
1020 $pl->password ("*"); # this should lock out the player until we nuked the dir
1021
1022 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
1023 $pl->deactivate;
1024 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1025 $pl->ns->destroy if $pl->ns;
1026
1027 my $path = playerdir $pl;
1028 my $temp = "$path~$cf::RUNTIME~deleting~";
1029 aio_rename $path, $temp;
1030 delete $cf::PLAYER{$pl->ob->name};
1031 $pl->destroy;
1032 IO::AIO::aio_rmtree $temp;
1033}
1034
1035=item cf::player::list_logins
1036
1037Returns am arrayref of all valid playernames in the system, can take a
1038while and may block, so not sync_job-capable, ever.
1039
1040=cut
1041
1042sub list_logins {
1043 my $dirs = aio_readdir cf::localdir . "/" . cf::playerdir
1044 or return [];
1045
1046 my @logins;
1047
1048 for my $login (@$dirs) {
1049 my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next;
1050 aio_read $fh, 0, 512, my $buf, 0 or next;
1051 $buf !~ /^password -------------$/m or next; # official not-valid tag
1052
1053 utf8::decode $login;
1054 push @logins, $login;
1055 }
1056
1057 \@logins
1058}
1059
1060=item $player->maps
1061
1062Returns an arrayref of map paths that are private for this
1063player. May block.
1064
1065=cut
1066
1067sub maps($) {
1068 my ($pl) = @_;
1069
1070 my $files = aio_readdir playerdir $pl
1071 or return;
1072
1073 my @paths;
1074
1075 for (@$files) {
1076 utf8::decode $_;
1077 next if /\.(?:pl|pst)$/;
1078 next unless /^$PATH_SEP/o;
1079
1080 s/\.map$//;
1081 push @paths, "~" . $pl->ob->name . "/" . $_;
1082 }
1083
1084 \@paths
1096} 1085}
1097 1086
1098=item $player->ext_reply ($msgid, $msgtype, %msg) 1087=item $player->ext_reply ($msgid, $msgtype, %msg)
1099 1088
1100Sends an ext reply to the player. 1089Sends an ext reply to the player.
1101 1090
1102=cut 1091=cut
1103 1092
1104sub cf::player::ext_reply($$$%) { 1093sub ext_reply($$$%) {
1105 my ($self, $id, %msg) = @_; 1094 my ($self, $id, %msg) = @_;
1106 1095
1107 $msg{msgid} = $id; 1096 $msg{msgid} = $id;
1108 1097
1109 $self->send ("ext " . to_json \%msg); 1098 $self->send ("ext " . cf::to_json \%msg);
1110} 1099}
1100
1101package cf;
1111 1102
1112=back 1103=back
1113 1104
1114 1105
1115=head3 cf::map 1106=head3 cf::map
… …
1121package cf::map; 1112package cf::map;
1122 1113
1123use Fcntl; 1114use Fcntl;
1124use Coro::AIO; 1115use Coro::AIO;
1125 1116
1117use overload
1118 '""' => \&as_string,
1119 fallback => 1;
1120
1126our $MAX_RESET = 3600; 1121our $MAX_RESET = 3600;
1127our $DEFAULT_RESET = 3000; 1122our $DEFAULT_RESET = 3000;
1128 1123
1129sub generate_random_map { 1124sub generate_random_map {
1130 my ($path, $rmp) = @_; 1125 my ($self, $rmp) = @_;
1131 1126
1132 # mit "rum" bekleckern, nicht 1127 # mit "rum" bekleckern, nicht
1133 cf::map::_create_random_map 1128 $self->_create_random_map (
1134 $path,
1135 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle}, 1129 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1136 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle}, 1130 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1137 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map}, 1131 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1138 $rmp->{exit_on_final_map}, 1132 $rmp->{exit_on_final_map},
1139 $rmp->{xsize}, $rmp->{ysize}, 1133 $rmp->{xsize}, $rmp->{ysize},
1140 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3}, 1134 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1141 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase}, 1135 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
1142 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation}, 1136 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
1143 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp}, 1137 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
1144 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used}, 1138 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
1145 (cf::region::find $rmp->{region}) 1139 (cf::region::find $rmp->{region}), $rmp->{custom}
1140 )
1141}
1142
1143sub register {
1144 my (undef, $regex) = @_;
1145 my $pkg = caller;
1146
1147 no strict;
1148 push @{"$pkg\::ISA"}, __PACKAGE__;
1149
1150 $EXT_MAP{$pkg} = qr<$regex>;
1151}
1152
1153# also paths starting with '/'
1154$EXT_MAP{"cf::map"} = qr{^(?=/)};
1155
1156sub thawer_merge {
1157 my ($self, $merge) = @_;
1158
1159 # we have to keep some variables in memory intact
1160 local $self->{path};
1161 local $self->{load_path};
1162 local $self->{deny_save};
1163 local $self->{deny_reset};
1164
1165 $self->SUPER::thawer_merge ($merge);
1166}
1167
1168sub normalise {
1169 my ($path, $base) = @_;
1170
1171 # map plan:
1172 #
1173 # /! non-realised random map exit (special hack!)
1174 # {... are special paths that are not being touched
1175 # ?xxx/... are special absolute paths
1176 # ?random/... random maps
1177 # /... normal maps
1178 # ~user/... per-player map of a specific user
1179
1180 $path =~ s/$PATH_SEP/\//go;
1181
1182 # treat it as relative path if it starts with
1183 # something that looks reasonable
1184 if ($path =~ m{^(?:\./|\.\./|\w)}) {
1185 $base or Carp::carp "normalise called with relative path and no base: '$path'";
1186
1187 $base =~ s{[^/]+/?$}{};
1188 $path = "$base/$path";
1189 }
1190
1191 for ($path) {
1192 redo if s{//}{/};
1193 redo if s{/\.?/}{/};
1194 redo if s{/[^/]+/\.\./}{/};
1195 }
1196
1197 $path
1198}
1199
1200sub new_from_path {
1201 my (undef, $path, $base) = @_;
1202
1203 return $path if UNIVERSAL::isa $path, "cf::map"; # already a map object
1204
1205 $path = normalise $path, $base;
1206
1207 for my $pkg (keys %EXT_MAP) {
1208 if ($path =~ $EXT_MAP{$pkg}) {
1209 my $self = bless cf::map::new, $pkg;
1210 $self->{path} = $path; $self->path ($path);
1211 $self->init; # pass $1 etc.
1212 return $self;
1213 }
1214 }
1215
1216 Carp::carp "unable to resolve path '$path'.";
1217 ()
1218}
1219
1220sub init {
1221 my ($self) = @_;
1222
1223 $self
1224}
1225
1226sub as_string {
1227 my ($self) = @_;
1228
1229 "$self->{path}"
1230}
1231
1232# the displayed name, this is a one way mapping
1233sub visible_name {
1234 &as_string
1235}
1236
1237# the original (read-only) location
1238sub load_path {
1239 my ($self) = @_;
1240
1241 sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
1242}
1243
1244# the temporary/swap location
1245sub save_path {
1246 my ($self) = @_;
1247
1248 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
1249 sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $path
1250}
1251
1252# the unique path, undef == no special unique path
1253sub uniq_path {
1254 my ($self) = @_;
1255
1256 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
1257 sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $path
1146} 1258}
1147 1259
1148# and all this just because we cannot iterate over 1260# and all this just because we cannot iterate over
1149# all maps in C++... 1261# all maps in C++...
1150sub change_all_map_light { 1262sub change_all_map_light {
… …
1152 1264
1153 $_->change_map_light ($change) 1265 $_->change_map_light ($change)
1154 for grep $_->outdoor, values %cf::MAP; 1266 for grep $_->outdoor, values %cf::MAP;
1155} 1267}
1156 1268
1269sub unlink_save {
1270 my ($self) = @_;
1271
1272 utf8::encode (my $save = $self->save_path);
1273 IO::AIO::aioreq_pri 4; Coro::AIO::aio_unlink $save;
1274 IO::AIO::aioreq_pri 4; Coro::AIO::aio_unlink "$save.pst";
1275}
1276
1157sub try_load_header($) { 1277sub load_header_from($) {
1158 my ($path) = @_; 1278 my ($self, $path) = @_;
1159 1279
1160 utf8::encode $path; 1280 utf8::encode $path;
1161 aio_open $path, O_RDONLY, 0 1281 aio_open $path, O_RDONLY, 0
1162 or return; 1282 or return;
1163 1283
1164 my $map = cf::map::new 1284 $self->_load_header ($path)
1165 or return; 1285 or return;
1166 1286
1167 # for better error messages only, will be overwritten 1287 $self->{load_path} = $path;
1168 $map->path ($path);
1169 1288
1170 $map->load_header ($path) 1289 1
1290}
1291
1292sub load_orig {
1293 my ($self) = @_;
1294
1295 $self->load_header_from ($self->load_path)
1296}
1297
1298sub load_temp {
1299 my ($self) = @_;
1300
1301 $self->load_header_from ($self->save_path)
1302}
1303
1304sub load_header {
1305 my ($self) = @_;
1306
1307 if ($self->load_temp) {
1308 $self->last_access ((delete $self->{last_access})
1309 || $cf::RUNTIME); #d#
1310 # safety
1311 $self->{instantiate_time} = $cf::RUNTIME
1312 if $self->{instantiate_time} > $cf::RUNTIME;
1313 } else {
1314 $self->load_orig
1171 or return; 1315 or return;
1172 1316
1173 $map->{load_path} = $path; 1317 $self->{load_original} = 1;
1318 $self->{instantiate_time} = $cf::RUNTIME;
1319 $self->last_access ($cf::RUNTIME);
1320 $self->instantiate;
1321 }
1174 1322
1175 $map 1323 1
1176} 1324}
1177 1325
1178sub find; 1326sub find;
1179sub find { 1327sub find {
1180 my ($path, $origin) = @_; 1328 my ($path, $origin) = @_;
1181 1329
1182 #warn "find<$path,$origin>\n";#d#
1183
1184 $path = new cf::path $path, $origin && $origin->path; 1330 $path = normalise $path, $origin && $origin->path;
1185 my $key = $path->as_string;
1186 1331
1187 cf::lock_wait "map_find:$key"; 1332 cf::lock_wait "map_find:$path";
1188 1333
1189 $cf::MAP{$key} || do { 1334 $cf::MAP{$path} || do {
1190 my $guard = cf::lock_acquire "map_find:$key"; 1335 my $guard = cf::lock_acquire "map_find:$path";
1191 1336 my $map = new_from_path cf::map $path
1192 # do it the slow way
1193 my $map = try_load_header $path->save_path;
1194
1195 Coro::cede;
1196
1197 if ($map) {
1198 $map->last_access ((delete $map->{last_access})
1199 || $cf::RUNTIME); #d#
1200 # safety
1201 $map->{instantiate_time} = $cf::RUNTIME
1202 if $map->{instantiate_time} > $cf::RUNTIME;
1203 } else {
1204 if (my $rmp = $path->random_map_params) {
1205 $map = generate_random_map $key, $rmp;
1206 } else {
1207 $map = try_load_header $path->load_path;
1208 }
1209
1210 $map or return; 1337 or return;
1211 1338
1212 $map->{load_original} = 1;
1213 $map->{instantiate_time} = $cf::RUNTIME;
1214 $map->last_access ($cf::RUNTIME);
1215 $map->instantiate;
1216
1217 # per-player maps become, after loading, normal maps
1218 $map->per_player (0) if $path->{user_rel};
1219 }
1220
1221 $map->path ($key);
1222 $map->{path} = $path;
1223 $map->{last_save} = $cf::RUNTIME; 1339 $map->{last_save} = $cf::RUNTIME;
1224 1340
1225 Coro::cede; 1341 $map->load_header
1342 or return;
1226 1343
1227 if ($map->should_reset) { 1344 if ($map->should_reset) {
1345 $cf::WAIT_FOR_TICK->wait;
1228 $map->reset; 1346 $map->reset;
1229 undef $guard; 1347 undef $guard;
1230 $map = find $path 1348 $map = find $path
1231 or return; 1349 or return;
1232 } 1350 }
1233 1351
1234 $cf::MAP{$key} = $map 1352 $cf::MAP{$path} = $map
1235 } 1353 }
1236} 1354}
1237 1355
1238sub load { 1356sub load {
1239 my ($self) = @_; 1357 my ($self) = @_;
1240 1358
1241 my $path = $self->{path}; 1359 my $path = $self->{path};
1242 my $guard = cf::lock_acquire "map_load:" . $path->as_string; 1360 my $guard = cf::lock_acquire "map_load:$path";
1243 1361
1244 return if $self->in_memory != cf::MAP_SWAPPED; 1362 return if $self->in_memory != cf::MAP_SWAPPED;
1245 1363
1246 $self->in_memory (cf::MAP_LOADING); 1364 $self->in_memory (cf::MAP_LOADING);
1247 1365
1248 $self->alloc; 1366 $self->alloc;
1249 $self->load_objects ($self->{load_path}, 1) 1367 $self->_load_objects ($self->{load_path}, 1)
1250 or return; 1368 or return;
1251 1369
1252 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1) 1370 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1253 if delete $self->{load_original}; 1371 if delete $self->{load_original};
1254 1372
1255 if (my $uniq = $path->uniq_path) { 1373 if (my $uniq = $self->uniq_path) {
1256 utf8::encode $uniq; 1374 utf8::encode $uniq;
1257 if (aio_open $uniq, O_RDONLY, 0) { 1375 if (aio_open $uniq, O_RDONLY, 0) {
1258 $self->clear_unique_items; 1376 $self->clear_unique_items;
1259 $self->load_objects ($uniq, 0); 1377 $self->_load_objects ($uniq, 0);
1260 } 1378 }
1261 } 1379 }
1262 1380
1263 Coro::cede; 1381 Coro::cede;
1264 1382
1265 # now do the right thing for maps 1383 # now do the right thing for maps
1266 $self->link_multipart_objects; 1384 $self->link_multipart_objects;
1267 1385
1268 if ($self->{path}->is_style_map) { 1386 unless ($self->{deny_activate}) {
1269 $self->{deny_save} = 1; 1387 $self->decay_objects;
1270 $self->{deny_reset} = 1;
1271 } else {
1272 $self->fix_auto_apply; 1388 $self->fix_auto_apply;
1273 $self->decay_objects;
1274 $self->update_buttons; 1389 $self->update_buttons;
1390 Coro::cede;
1275 $self->set_darkness_map; 1391 $self->set_darkness_map;
1276 $self->difficulty ($self->estimate_difficulty) 1392 $self->difficulty ($self->estimate_difficulty)
1277 unless $self->difficulty; 1393 unless $self->difficulty;
1394 Coro::cede;
1278 $self->activate; 1395 $self->activate;
1279 } 1396 }
1280 1397
1281 Coro::cede;
1282
1283 $self->in_memory (cf::MAP_IN_MEMORY); 1398 $self->in_memory (cf::MAP_IN_MEMORY);
1399}
1400
1401sub customise_for {
1402 my ($self, $ob) = @_;
1403
1404 return find "~" . $ob->name . "/" . $self->{path}
1405 if $self->per_player;
1406
1407 $self
1408}
1409
1410# find and load all maps in the 3x3 area around a map
1411sub load_diag {
1412 my ($map) = @_;
1413
1414 my @diag; # diagonal neighbours
1415
1416 for (0 .. 3) {
1417 my $neigh = $map->tile_path ($_)
1418 or next;
1419 $neigh = find $neigh, $map
1420 or next;
1421 $neigh->load;
1422
1423 push @diag, [$neigh->tile_path (($_ + 3) % 4), $neigh],
1424 [$neigh->tile_path (($_ + 1) % 4), $neigh];
1425 }
1426
1427 for (@diag) {
1428 my $neigh = find @$_
1429 or next;
1430 $neigh->load;
1431 }
1284} 1432}
1285 1433
1286sub find_sync { 1434sub find_sync {
1287 my ($path, $origin) = @_; 1435 my ($path, $origin) = @_;
1288 1436
1289 cf::sync_job { cf::map::find $path, $origin } 1437 cf::sync_job { find $path, $origin }
1290} 1438}
1291 1439
1292sub do_load_sync { 1440sub do_load_sync {
1293 my ($map) = @_; 1441 my ($map) = @_;
1294 1442
1295 cf::sync_job { $map->load }; 1443 cf::sync_job { $map->load };
1296} 1444}
1297 1445
1446our %MAP_PREFETCH;
1447our $MAP_PREFETCHER = Coro::async {
1448 while () {
1449 for my $path (keys %MAP_PREFETCH) {
1450 my $map = find $path
1451 or next;
1452 $map->load;
1453
1454 delete $MAP_PREFETCH{$path};
1455 }
1456 Coro::schedule;
1457 }
1458};
1459
1460sub find_async {
1461 my ($path, $origin) = @_;
1462
1463 $path = normalise $path, $origin && $origin->{path};
1464
1465 if (my $map = $cf::MAP{$path}) {
1466 return $map if $map->in_memory == cf::MAP_IN_MEMORY;
1467 }
1468
1469 $MAP_PREFETCH{$path} = 0;
1470 $MAP_PREFETCHER->ready;
1471
1472 ()
1473}
1474
1298sub save { 1475sub save {
1299 my ($self) = @_; 1476 my ($self) = @_;
1300 1477
1301 my $lock = cf::lock_acquire "map_data:" . $self->path; 1478 my $lock = cf::lock_acquire "map_data:" . $self->path;
1302 1479
1303 $self->{last_save} = $cf::RUNTIME; 1480 $self->{last_save} = $cf::RUNTIME;
1304 1481
1305 return unless $self->dirty; 1482 return unless $self->dirty;
1306 1483
1307 my $save = $self->{path}->save_path; utf8::encode $save; 1484 my $save = $self->save_path; utf8::encode $save;
1308 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq; 1485 my $uniq = $self->uniq_path; utf8::encode $uniq;
1309 1486
1310 $self->{load_path} = $save; 1487 $self->{load_path} = $save;
1311 1488
1312 return if $self->{deny_save}; 1489 return if $self->{deny_save};
1313 1490
1314 local $self->{last_access} = $self->last_access;#d# 1491 local $self->{last_access} = $self->last_access;#d#
1315 1492
1493 cf::async {
1494 $_->contr->save for $self->players;
1495 };
1496
1316 if ($uniq) { 1497 if ($uniq) {
1317 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1498 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1318 $self->save_objects ($uniq, cf::IO_UNIQUES); 1499 $self->_save_objects ($uniq, cf::IO_UNIQUES);
1319 } else { 1500 } else {
1320 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES); 1501 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
1321 } 1502 }
1322} 1503}
1323 1504
1324sub swap_out { 1505sub swap_out {
1325 my ($self) = @_; 1506 my ($self) = @_;
… …
1339 1520
1340sub reset_at { 1521sub reset_at {
1341 my ($self) = @_; 1522 my ($self) = @_;
1342 1523
1343 # TODO: safety, remove and allow resettable per-player maps 1524 # TODO: safety, remove and allow resettable per-player maps
1344 return 1e99 if $self->{path}{user_rel}; 1525 return 1e99 if $self->isa ("ext::map_per_player");#d#
1345 return 1e99 if $self->{deny_reset}; 1526 return 1e99 if $self->{deny_reset};
1346 1527
1347 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access; 1528 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
1348 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET; 1529 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
1349 1530
… …
1354 my ($self) = @_; 1535 my ($self) = @_;
1355 1536
1356 $self->reset_at <= $cf::RUNTIME 1537 $self->reset_at <= $cf::RUNTIME
1357} 1538}
1358 1539
1359sub unlink_save {
1360 my ($self) = @_;
1361
1362 utf8::encode (my $save = $self->{path}->save_path);
1363 aioreq_pri 3; IO::AIO::aio_unlink $save;
1364 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
1365}
1366
1367sub rename {
1368 my ($self, $new_path) = @_;
1369
1370 $self->unlink_save;
1371
1372 delete $cf::MAP{$self->path};
1373 $self->{path} = new cf::path $new_path;
1374 $self->path ($self->{path}->as_string);
1375 $cf::MAP{$self->path} = $self;
1376
1377 $self->save;
1378}
1379
1380sub reset { 1540sub reset {
1381 my ($self) = @_; 1541 my ($self) = @_;
1382 1542
1383 my $lock = cf::lock_acquire "map_data:" . $self->path; 1543 my $lock = cf::lock_acquire "map_data:$self->{path}";
1384 1544
1385 return if $self->players; 1545 return if $self->players;
1386 return if $self->{path}{user_rel};#d# 1546 return if $self->isa ("ext::map_per_player");#d#
1387 1547
1388 warn "resetting map ", $self->path;#d# 1548 warn "resetting map ", $self->path;#d#
1389 1549
1390 delete $cf::MAP{$self->path}; 1550 delete $cf::MAP{$self->path};
1551
1552 $self->in_memory (cf::MAP_SWAPPED);
1553 $self->clear;
1391 1554
1392 $_->clear_links_to ($self) for values %cf::MAP; 1555 $_->clear_links_to ($self) for values %cf::MAP;
1393 1556
1394 $self->unlink_save; 1557 $self->unlink_save;
1395 $self->destroy; 1558 $self->destroy;
… …
1398my $nuke_counter = "aaaa"; 1561my $nuke_counter = "aaaa";
1399 1562
1400sub nuke { 1563sub nuke {
1401 my ($self) = @_; 1564 my ($self) = @_;
1402 1565
1566 delete $cf::MAP{$self->path};
1567
1568 $self->unlink_save;
1569
1570 bless $self, "cf::map";
1571 delete $self->{deny_reset};
1403 $self->{deny_save} = 1; 1572 $self->{deny_save} = 1;
1404 $self->reset_timeout (1); 1573 $self->reset_timeout (1);
1405 $self->rename ("{nuke}/" . ($nuke_counter++)); 1574 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++));
1575
1576 $cf::MAP{$self->path} = $self;
1577
1406 $self->reset; # polite request, might not happen 1578 $self->reset; # polite request, might not happen
1407} 1579}
1408 1580
1409sub customise_for { 1581=item cf::map::unique_maps
1410 my ($map, $ob) = @_;
1411 1582
1412 if ($map->per_player) { 1583Returns an arrayref of paths of all shared maps that have
1413 return cf::map::find "~" . $ob->name . "/" . $map->{path}{path}; 1584instantiated unique items. May block.
1414 }
1415 1585
1416 $map 1586=cut
1417}
1418 1587
1419sub emergency_save { 1588sub unique_maps() {
1420 my $freeze_guard = cf::freeze_mainloop; 1589 my $files = aio_readdir cf::localdir . "/" . cf::uniquedir
1590 or return;
1421 1591
1422 warn "enter emergency map save\n"; 1592 my @paths;
1423 1593
1424 cf::sync_job { 1594 for (@$files) {
1425 warn "begin emergency map save\n"; 1595 utf8::decode $_;
1426 $_->save for values %cf::MAP; 1596 next if /\.pst$/;
1597 next unless /^$PATH_SEP/o;
1598
1599 s/\.map$//;
1600 push @paths, $_;
1427 }; 1601 }
1428 1602
1429 warn "end emergency map save\n"; 1603 \@paths
1430} 1604}
1431 1605
1432package cf; 1606package cf;
1433 1607
1434=back 1608=back
1435 1609
1610=head3 cf::object
1611
1612=cut
1613
1614package cf::object;
1615
1616=over 4
1617
1618=item $ob->inv_recursive
1619
1620Returns the inventory of the object _and_ their inventories, recursively.
1621
1622=cut
1623
1624sub inv_recursive_;
1625sub inv_recursive_ {
1626 map { $_, inv_recursive_ $_->inv } @_
1627}
1628
1629sub inv_recursive {
1630 inv_recursive_ inv $_[0]
1631}
1632
1633package cf;
1634
1635=back
1436 1636
1437=head3 cf::object::player 1637=head3 cf::object::player
1438 1638
1439=over 4 1639=over 4
1440 1640
… …
1480 1680
1481=item $player_object->enter_link 1681=item $player_object->enter_link
1482 1682
1483Freezes the player and moves him/her to a special map (C<{link}>). 1683Freezes the player and moves him/her to a special map (C<{link}>).
1484 1684
1485The player should be reaosnably safe there for short amounts of time. You 1685The player should be reasonably safe there for short amounts of time. You
1486I<MUST> call C<leave_link> as soon as possible, though. 1686I<MUST> call C<leave_link> as soon as possible, though.
1487 1687
1688Will never block.
1689
1488=item $player_object->leave_link ($map, $x, $y) 1690=item $player_object->leave_link ($map, $x, $y)
1489 1691
1490Moves the player out of the specila link map onto the given map. If the 1692Moves the player out of the special C<{link}> map onto the specified
1491map is not valid (or omitted), the player will be moved back to the 1693map. If the map is not valid (or omitted), the player will be moved back
1492location he/she was before the call to C<enter_link>, or, if that fails, 1694to the location he/she was before the call to C<enter_link>, or, if that
1493to the emergency map position. 1695fails, to the emergency map position.
1494 1696
1495Might block. 1697Might block.
1496 1698
1497=cut 1699=cut
1700
1701sub link_map {
1702 unless ($LINK_MAP) {
1703 $LINK_MAP = cf::map::find "{link}"
1704 or do { warn "FATAL: unable to provide {link} map, exiting."; exit 1 };
1705 $LINK_MAP->load;
1706 }
1707
1708 $LINK_MAP
1709}
1498 1710
1499sub cf::object::player::enter_link { 1711sub cf::object::player::enter_link {
1500 my ($self) = @_; 1712 my ($self) = @_;
1501 1713
1502 $self->deactivate_recursive; 1714 $self->deactivate_recursive;
1503 1715
1504 return if $self->map == $LINK_MAP; 1716 return if UNIVERSAL::isa $self->map, "ext::map_link";
1505 1717
1506 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y] 1718 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y]
1507 if $self->map; 1719 if $self->map;
1508 1720
1509 $self->enter_map ($LINK_MAP, 20, 20); 1721 $self->enter_map ($LINK_MAP || link_map, 20, 20);
1510} 1722}
1511 1723
1512sub cf::object::player::leave_link { 1724sub cf::object::player::leave_link {
1513 my ($self, $map, $x, $y) = @_; 1725 my ($self, $map, $x, $y) = @_;
1514 1726
… …
1532 # use -1 or undef as default coordinates, not 0, 0 1744 # use -1 or undef as default coordinates, not 0, 0
1533 ($x, $y) = ($map->enter_x, $map->enter_y) 1745 ($x, $y) = ($map->enter_x, $map->enter_y)
1534 if $x <=0 && $y <= 0; 1746 if $x <=0 && $y <= 0;
1535 1747
1536 $map->load; 1748 $map->load;
1749 $map->load_diag;
1537 1750
1751 return unless $self->contr->active;
1538 $self->activate_recursive; 1752 $self->activate_recursive;
1539 $self->enter_map ($map, $x, $y); 1753 $self->enter_map ($map, $x, $y);
1540} 1754}
1541 1755
1542cf::player->attach ( 1756cf::player->attach (
… …
1555 1769
1556 # try to abort aborted map switching on player login :) 1770 # try to abort aborted map switching on player login :)
1557 # should happen only on crashes 1771 # should happen only on crashes
1558 if ($pl->ob->{_link_pos}) { 1772 if ($pl->ob->{_link_pos}) {
1559 $pl->ob->enter_link; 1773 $pl->ob->enter_link;
1560 cf::async { 1774 (async {
1561 # we need this sleep as the login has a concurrent enter_exit running 1775 # we need this sleep as the login has a concurrent enter_exit running
1562 # and this sleep increases chances of the player not ending up in scorn 1776 # and this sleep increases chances of the player not ending up in scorn
1777 $pl->ob->reply (undef,
1778 "There was an internal problem at your last logout, "
1779 . "the server will try to bring you to your intended destination in a second.",
1780 cf::NDI_RED);
1563 Coro::Timer::sleep 1; 1781 Coro::Timer::sleep 1;
1564 $pl->ob->leave_link; 1782 $pl->ob->leave_link;
1565 }; 1783 })->prio (2);
1566 } 1784 }
1567 }, 1785 },
1568); 1786);
1569 1787
1570=item $player_object->goto ($path, $x, $y) 1788=item $player_object->goto ($path, $x, $y)
… …
1574sub cf::object::player::goto { 1792sub cf::object::player::goto {
1575 my ($self, $path, $x, $y) = @_; 1793 my ($self, $path, $x, $y) = @_;
1576 1794
1577 $self->enter_link; 1795 $self->enter_link;
1578 1796
1579 (cf::async { 1797 (async {
1580 $path = new cf::path $path;
1581
1582 my $map = cf::map::find $path->as_string; 1798 my $map = cf::map::find $path;
1583 $map = $map->customise_for ($self) if $map; 1799 $map = $map->customise_for ($self) if $map;
1584 1800
1585# warn "entering ", $map->path, " at ($x, $y)\n" 1801# warn "entering ", $map->path, " at ($x, $y)\n"
1586# if $map; 1802# if $map;
1587 1803
1588 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED); 1804 $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1589 1805
1590 $self->leave_link ($map, $x, $y); 1806 $self->leave_link ($map, $x, $y);
1591 })->prio (1); 1807 })->prio (1);
1592} 1808}
1593 1809
… …
1646 1862
1647 return unless $self->type == cf::PLAYER; 1863 return unless $self->type == cf::PLAYER;
1648 1864
1649 $self->enter_link; 1865 $self->enter_link;
1650 1866
1651 (cf::async { 1867 (async {
1652 $self->deactivate_recursive; # just to be sure 1868 $self->deactivate_recursive; # just to be sure
1653 unless (eval { 1869 unless (eval {
1654 prepare_random_map $exit 1870 prepare_random_map $exit
1655 if $exit->slaying eq "/!"; 1871 if $exit->slaying eq "/!";
1656 1872
1657 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path; 1873 my $path = new_from_path cf::map $exit->slaying, $exit->map && $exit->map->path;
1658 $self->goto ($path, $exit->stats->hp, $exit->stats->sp); 1874 $self->goto ($path, $exit->stats->hp, $exit->stats->sp);
1659 1875
1660 1; 1876 1;
1661 }) { 1877 }) {
1662 $self->message ("Something went wrong deep within the crossfire server. " 1878 $self->message ("Something went wrong deep within the crossfire server. "
1663 . "I'll try to bring you back to the map you were before. " 1879 . "I'll try to bring you back to the map you were before. "
1664 . "Please report this to the dungeon master", 1880 . "Please report this to the dungeon master!",
1665 cf::NDI_UNIQUE | cf::NDI_RED); 1881 cf::NDI_UNIQUE | cf::NDI_RED);
1666 1882
1667 warn "ERROR in enter_exit: $@"; 1883 warn "ERROR in enter_exit: $@";
1668 $self->leave_link; 1884 $self->leave_link;
1669 } 1885 }
… …
1737 } 1953 }
1738 } 1954 }
1739 }, 1955 },
1740); 1956);
1741 1957
1742=item $client->coro (\&cb) 1958=item $client->async (\&cb)
1743 1959
1744Create a new coroutine, running the specified callback. The coroutine will 1960Create a new coroutine, running the specified callback. The coroutine will
1745be automatically cancelled when the client gets destroyed (e.g. on logout, 1961be automatically cancelled when the client gets destroyed (e.g. on logout,
1746or loss of connection). 1962or loss of connection).
1747 1963
1748=cut 1964=cut
1749 1965
1750sub cf::client::coro { 1966sub cf::client::async {
1751 my ($self, $cb) = @_; 1967 my ($self, $cb) = @_;
1752 1968
1753 my $coro = &cf::async ($cb); 1969 my $coro = &Coro::async ($cb);
1754 1970
1755 $coro->on_destroy (sub { 1971 $coro->on_destroy (sub {
1756 delete $self->{_coro}{$coro+0}; 1972 delete $self->{_coro}{$coro+0};
1757 }); 1973 });
1758 1974
… …
1996 local $/; 2212 local $/;
1997 *CFG = YAML::Syck::Load <$fh>; 2213 *CFG = YAML::Syck::Load <$fh>;
1998 2214
1999 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 2215 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
2000 2216
2217 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
2218 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
2219
2001 if (exists $CFG{mlockall}) { 2220 if (exists $CFG{mlockall}) {
2002 eval { 2221 eval {
2003 $CFG{mlockall} ? &mlockall : &munlockall 2222 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
2004 and die "WARNING: m(un)lockall failed: $!\n"; 2223 and die "WARNING: m(un)lockall failed: $!\n";
2005 }; 2224 };
2006 warn $@ if $@; 2225 warn $@ if $@;
2007 } 2226 }
2008} 2227}
2009 2228
2010sub main { 2229sub main {
2011 # we must not ever block the main coroutine 2230 # we must not ever block the main coroutine
2012 local $Coro::idle = sub { 2231 local $Coro::idle = sub {
2013 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 2232 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
2014 (Coro::unblock_sub { 2233 (async {
2234 warn "BP1\n";#d#
2015 Event::one_event; 2235 Event::one_event;
2016 })->(); 2236 warn "BP2\n";#d#
2237 })->prio (Coro::PRIO_MAX);
2017 }; 2238 };
2018 2239
2019 cfg_load; 2240 cfg_load;
2020 db_load; 2241 db_load;
2021 load_extensions; 2242 load_extensions;
2022 Event::loop; 2243 Event::loop;
2023} 2244}
2024 2245
2025############################################################################# 2246#############################################################################
2026# initialisation 2247# initialisation and cleanup
2248
2249# install some emergency cleanup handlers
2250BEGIN {
2251 for my $signal (qw(INT HUP TERM)) {
2252 Event->signal (
2253 data => WF_AUTOCANCEL,
2254 signal => $signal,
2255 cb => sub {
2256 cf::cleanup "SIG$signal";
2257 },
2258 );
2259 }
2260}
2261
2262sub emergency_save() {
2263 my $freeze_guard = cf::freeze_mainloop;
2264
2265 warn "enter emergency perl save\n";
2266
2267 cf::sync_job {
2268 # use a peculiar iteration method to avoid tripping on perl
2269 # refcount bugs in for. also avoids problems with players
2270 # and maps saved/destroyed asynchronously.
2271 warn "begin emergency player save\n";
2272 for my $login (keys %cf::PLAYER) {
2273 my $pl = $cf::PLAYER{$login} or next;
2274 $pl->valid or next;
2275 $pl->save;
2276 }
2277 warn "end emergency player save\n";
2278
2279 warn "begin emergency map save\n";
2280 for my $path (keys %cf::MAP) {
2281 my $map = $cf::MAP{$path} or next;
2282 $map->valid or next;
2283 $map->save;
2284 }
2285 warn "end emergency map save\n";
2286 };
2287
2288 warn "leave emergency perl save\n";
2289}
2027 2290
2028sub reload() { 2291sub reload() {
2029 # can/must only be called in main 2292 # can/must only be called in main
2030 if ($Coro::current != $Coro::main) { 2293 if ($Coro::current != $Coro::main) {
2031 warn "can only reload from main coroutine\n"; 2294 warn "can only reload from main coroutine\n";
2032 return; 2295 return;
2033 } 2296 }
2034 2297
2035 warn "reloading..."; 2298 warn "reloading...";
2036 2299
2300 warn "freezing server";
2037 my $guard = freeze_mainloop; 2301 my $guard = freeze_mainloop;
2038 cf::emergency_save; 2302 cf::emergency_save;
2039 2303
2304 warn "sync database to disk";
2305 cf::db_sync;
2306 IO::AIO::flush;
2307
2040 eval { 2308 eval {
2041 # if anything goes wrong in here, we should simply crash as we already saved 2309 # if anything goes wrong in here, we should simply crash as we already saved
2042 2310
2043 # cancel all watchers 2311 warn "cancel all watchers";
2044 for (Event::all_watchers) { 2312 for (Event::all_watchers) {
2045 $_->cancel if $_->data & WF_AUTOCANCEL; 2313 $_->cancel if $_->data & WF_AUTOCANCEL;
2046 } 2314 }
2047 2315
2048 # cancel all extension coros 2316 warn "cancel all extension coros";
2049 $_->cancel for values %EXT_CORO; 2317 $_->cancel for values %EXT_CORO;
2050 %EXT_CORO = (); 2318 %EXT_CORO = ();
2051 2319
2320 warn "remove commands";
2321 %COMMAND = ();
2322
2323 warn "remove ext commands";
2324 %EXTCMD = ();
2325
2052 # unload all extensions 2326 warn "unload/nuke all extensions";
2053 for (@exts) { 2327 for my $pkg (@EXTS) {
2054 warn "unloading <$_>"; 2328 warn "... unloading $pkg";
2055 unload_extension $_; 2329
2330 if (my $cb = $pkg->can ("unload")) {
2331 eval {
2332 $cb->($pkg);
2333 1
2334 } or warn "$pkg unloaded, but with errors: $@";
2056 } 2335 }
2057 2336
2337 warn "... nuking $pkg";
2338 Symbol::delete_package $pkg;
2339 }
2340
2058 # unload all modules loaded from $LIBDIR 2341 warn "unload all perl modules loaded from $LIBDIR";
2059 while (my ($k, $v) = each %INC) { 2342 while (my ($k, $v) = each %INC) {
2060 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; 2343 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
2061 2344
2062 warn "removing <$k>"; 2345 warn "removing <$k>";
2063 delete $INC{$k}; 2346 delete $INC{$k};
… …
2070 } 2353 }
2071 2354
2072 Symbol::delete_package $k; 2355 Symbol::delete_package $k;
2073 } 2356 }
2074 2357
2075 # sync database to disk
2076 cf::db_sync;
2077 IO::AIO::flush;
2078
2079 # get rid of safe::, as good as possible 2358 warn "get rid of safe::, as good as possible";
2080 Symbol::delete_package "safe::$_" 2359 Symbol::delete_package "safe::$_"
2081 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region); 2360 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
2082 2361
2083 # remove register_script_function callbacks
2084 # TODO
2085
2086 # unload cf.pm "a bit" 2362 warn "unload cf.pm \"a bit\"";
2087 delete $INC{"cf.pm"}; 2363 delete $INC{"cf.pm"};
2088 2364
2089 # don't, removes xs symbols, too, 2365 # don't, removes xs symbols, too,
2090 # and global variables created in xs 2366 # and global variables created in xs
2091 #Symbol::delete_package __PACKAGE__; 2367 #Symbol::delete_package __PACKAGE__;
2092 2368
2093 # reload cf.pm
2094 warn "reloading cf.pm"; 2369 warn "reloading cf.pm";
2095 require cf; 2370 require cf;
2096 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 2371 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
2097 2372
2098 # load config and database again 2373 warn "load config and database again";
2099 cf::cfg_load; 2374 cf::cfg_load;
2100 cf::db_load; 2375 cf::db_load;
2101 2376
2102 # load extensions
2103 warn "load extensions"; 2377 warn "load extensions";
2104 cf::load_extensions; 2378 cf::load_extensions;
2105 2379
2106 # reattach attachments to objects 2380 warn "reattach attachments to objects/players";
2107 warn "reattach";
2108 _global_reattach; 2381 _global_reattach;
2382 warn "reattach attachments to maps";
2383 reattach $_ for values %MAP;
2109 }; 2384 };
2110 2385
2111 if ($@) { 2386 if ($@) {
2112 warn $@; 2387 warn $@;
2113 warn "error while reloading, exiting."; 2388 warn "error while reloading, exiting.";
2114 exit 1; 2389 exit 1;
2115 } 2390 }
2116 2391
2117 warn "reloaded successfully"; 2392 warn "reloaded";
2118}; 2393};
2119 2394
2120############################################################################# 2395our $RELOAD_WATCHER; # used only during reload
2121
2122unless ($LINK_MAP) {
2123 $LINK_MAP = cf::map::new;
2124
2125 $LINK_MAP->width (41);
2126 $LINK_MAP->height (41);
2127 $LINK_MAP->alloc;
2128 $LINK_MAP->path ("{link}");
2129 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
2130 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2131
2132 # dirty hack because... archetypes are not yet loaded
2133 Event->timer (
2134 after => 2,
2135 cb => sub {
2136 $_[0]->w->cancel;
2137
2138 # provide some exits "home"
2139 my $exit = cf::object::new "exit";
2140
2141 $exit->slaying ($EMERGENCY_POSITION->[0]);
2142 $exit->stats->hp ($EMERGENCY_POSITION->[1]);
2143 $exit->stats->sp ($EMERGENCY_POSITION->[2]);
2144
2145 $LINK_MAP->insert ($exit->clone, 19, 19);
2146 $LINK_MAP->insert ($exit->clone, 19, 20);
2147 $LINK_MAP->insert ($exit->clone, 19, 21);
2148 $LINK_MAP->insert ($exit->clone, 20, 19);
2149 $LINK_MAP->insert ($exit->clone, 20, 21);
2150 $LINK_MAP->insert ($exit->clone, 21, 19);
2151 $LINK_MAP->insert ($exit->clone, 21, 20);
2152 $LINK_MAP->insert ($exit->clone, 21, 21);
2153
2154 $exit->destroy;
2155 });
2156
2157 $LINK_MAP->{deny_save} = 1;
2158 $LINK_MAP->{deny_reset} = 1;
2159
2160 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
2161}
2162
2163register "<global>", __PACKAGE__;
2164 2396
2165register_command "reload" => sub { 2397register_command "reload" => sub {
2166 my ($who, $arg) = @_; 2398 my ($who, $arg) = @_;
2167 2399
2168 if ($who->flag (FLAG_WIZ)) { 2400 if ($who->flag (FLAG_WIZ)) {
2169 $who->message ("start of reload."); 2401 $who->message ("reloading server.");
2402
2403 # doing reload synchronously and two reloads happen back-to-back,
2404 # coro crashes during coro_state_free->destroy here.
2405
2406 $RELOAD_WATCHER ||= Event->timer (after => 0, data => WF_AUTOCANCEL, cb => sub {
2170 reload; 2407 reload;
2171 $who->message ("end of reload."); 2408 undef $RELOAD_WATCHER;
2409 });
2172 } 2410 }
2173}; 2411};
2174 2412
2175unshift @INC, $LIBDIR; 2413unshift @INC, $LIBDIR;
2176 2414
… …
2178 reentrant => 0, 2416 reentrant => 0,
2179 prio => 0, 2417 prio => 0,
2180 at => $NEXT_TICK || $TICK, 2418 at => $NEXT_TICK || $TICK,
2181 data => WF_AUTOCANCEL, 2419 data => WF_AUTOCANCEL,
2182 cb => sub { 2420 cb => sub {
2421 $NOW = Event::time;
2422
2183 cf::server_tick; # one server iteration 2423 cf::server_tick; # one server iteration
2184 $RUNTIME += $TICK; 2424 $RUNTIME += $TICK;
2185 $NEXT_TICK += $TICK; 2425 $NEXT_TICK += $TICK;
2426
2427 $WAIT_FOR_TICK->broadcast;
2428 $WAIT_FOR_TICK_ONE->send if $WAIT_FOR_TICK_ONE->awaited;
2186 2429
2187 # if we are delayed by four ticks or more, skip them all 2430 # if we are delayed by four ticks or more, skip them all
2188 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4; 2431 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
2189 2432
2190 $TICK_WATCHER->at ($NEXT_TICK); 2433 $TICK_WATCHER->at ($NEXT_TICK);
… …
2192 }, 2435 },
2193); 2436);
2194 2437
2195IO::AIO::max_poll_time $TICK * 0.2; 2438IO::AIO::max_poll_time $TICK * 0.2;
2196 2439
2197Event->io ( 2440$AIO_POLL_WATCHER = Event->io (
2198 fd => IO::AIO::poll_fileno, 2441 fd => IO::AIO::poll_fileno,
2199 poll => 'r', 2442 poll => 'r',
2200 prio => 5, 2443 prio => 5,
2201 data => WF_AUTOCANCEL, 2444 data => WF_AUTOCANCEL,
2202 cb => \&IO::AIO::poll_cb, 2445 cb => \&IO::AIO::poll_cb,
2203); 2446);
2204 2447
2205Event->timer ( 2448$WRITE_RUNTIME_WATCHER = Event->timer (
2206 data => WF_AUTOCANCEL, 2449 data => WF_AUTOCANCEL,
2207 after => 0, 2450 after => 0,
2208 interval => 10, 2451 interval => 10,
2209 cb => sub { 2452 cb => sub {
2210 (Coro::unblock_sub { 2453 (Coro::unblock_sub {

Diff Legend

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