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.154 by root, Tue Jan 9 15:36:19 2007 UTC vs.
Revision 1.158 by root, Wed Jan 10 19:52:43 2007 UTC

… …
24use YAML::Syck (); 24use YAML::Syck ();
25use Time::HiRes; 25use Time::HiRes;
26 26
27use 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
28 28
29sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
30
29# 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?
30$YAML::Syck::ImplicitUnicode = 1; 32$YAML::Syck::ImplicitUnicode = 1;
31 33
32$Coro::main->prio (Coro::PRIO_MAX); # 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
33
34sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
35 35
36our %COMMAND = (); 36our %COMMAND = ();
37our %COMMAND_TIME = (); 37our %COMMAND_TIME = ();
38our %EXTCMD = (); 38our %EXTCMD = ();
39 39
… …
54our %MAP; # all maps 54our %MAP; # all maps
55our $LINK_MAP; # the special {link} map 55our $LINK_MAP; # the special {link} map
56our $RANDOM_MAPS = cf::localdir . "/random"; 56our $RANDOM_MAPS = cf::localdir . "/random";
57our %EXT_CORO; # coroutines bound to extensions 57our %EXT_CORO; # coroutines bound to extensions
58 58
59our $WAIT_FOR_TICK; $WAIT_FOR_TICK ||= new Coro::Signal;
60our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal;
61
59binmode STDOUT; 62binmode STDOUT;
60binmode STDERR; 63binmode STDERR;
61 64
62# read virtual server time, if available 65# read virtual server time, if available
63unless ($RUNTIME || !-e cf::localdir . "/runtime") { 66unless ($RUNTIME || !-e cf::localdir . "/runtime") {
… …
106 109
107=item %cf::CFG 110=item %cf::CFG
108 111
109Configuration for the server, loaded from C</etc/crossfire/config>, or 112Configuration for the server, loaded from C</etc/crossfire/config>, or
110from wherever your confdir points to. 113from wherever your confdir points to.
114
115=item $cf::WAIT_FOR_TICK, $cf::WAIT_FOR_TICK_ONE
116
117These are Coro::Signal objects that are C<< ->broadcast >> (WAIT_FOR_TICK)
118or C<< ->send >> (WAIT_FOR_TICK_ONE) on after normal server tick
119processing has been done. Call C<< ->wait >> on them to maximise the
120window of cpu time available, or simply to synchronise to the server tick.
111 121
112=back 122=back
113 123
114=cut 124=cut
115 125
… …
357 367
358############################################################################# 368#############################################################################
359 369
360package cf::path; 370package cf::path;
361 371
372use overload
373 '""' => \&as_string;
374
362# used to convert map paths into valid unix filenames by repalcing / by ∕ 375# used to convert map paths into valid unix filenames by repalcing / by ∕
363our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons 376our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
364 377
365sub new { 378sub new {
366 my ($class, $path, $base) = @_; 379 my ($class, $path, $base) = @_;
… …
374 # ?random/... random maps 387 # ?random/... random maps
375 # /! non-realised random map exit 388 # /! non-realised random map exit
376 # /... normal maps 389 # /... normal maps
377 # ~/... per-player maps without a specific player (DO NOT USE) 390 # ~/... per-player maps without a specific player (DO NOT USE)
378 # ~user/... per-player map of a specific user 391 # ~user/... per-player map of a specific user
392
393 $path =~ s/$PATH_SEP/\//go;
379 394
380 if ($path =~ /^{/) { 395 if ($path =~ /^{/) {
381 # fine as it is 396 # fine as it is
382 } elsif ($path =~ s{^\?random/}{}) { 397 } elsif ($path =~ s{^\?random/}{}) {
383 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data; 398 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
… …
1069}; 1084};
1070 1085
1071cf::map->attach (prio => -10000, package => cf::mapsupport::); 1086cf::map->attach (prio => -10000, package => cf::mapsupport::);
1072 1087
1073############################################################################# 1088#############################################################################
1074# load/save perl data associated with player->ob objects
1075
1076sub all_objects(@) {
1077 @_, map all_objects ($_->inv), @_
1078}
1079
1080# TODO: compatibility cruft, remove when no longer needed
1081cf::player->attach (
1082 on_load => sub {
1083 my ($pl, $path) = @_;
1084
1085 for my $o (all_objects $pl->ob) {
1086 if (my $value = $o->get_ob_key_value ("_perl_data")) {
1087 $o->set_ob_key_value ("_perl_data");
1088
1089 %$o = %{ Storable::thaw pack "H*", $value };
1090 }
1091 }
1092 },
1093);
1094
1095#############################################################################
1096 1089
1097=head2 CORE EXTENSIONS 1090=head2 CORE EXTENSIONS
1098 1091
1099Functions and methods that extend core crossfire objects. 1092Functions and methods that extend core crossfire objects.
1100 1093
… …
1225 my @logins; 1218 my @logins;
1226 1219
1227 for my $login (@$dirs) { 1220 for my $login (@$dirs) {
1228 my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next; 1221 my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next;
1229 aio_read $fh, 0, 512, my $buf, 0 or next; 1222 aio_read $fh, 0, 512, my $buf, 0 or next;
1230 $buf !~ /^password -------------$/ or next; # official not-valid tag 1223 $buf !~ /^password -------------$/m or next; # official not-valid tag
1231 1224
1232 utf8::decode $login; 1225 utf8::decode $login;
1233 push @logins, $login; 1226 push @logins, $login;
1234 } 1227 }
1235 1228
… …
1252 my @paths; 1245 my @paths;
1253 1246
1254 for (@$files) { 1247 for (@$files) {
1255 utf8::decode $_; 1248 utf8::decode $_;
1256 next if /\.(?:pl|pst)$/; 1249 next if /\.(?:pl|pst)$/;
1257 next unless /^$PATH_SEP/; 1250 next unless /^$PATH_SEP/o;
1258 1251
1259 s/$PATH_SEP/\//g;
1260 push @paths, new cf::path "~" . $pl->ob->name . "/" . $_; 1252 push @paths, new cf::path "~" . $pl->ob->name . "/" . $_;
1261 } 1253 }
1262 1254
1263 \@paths 1255 \@paths
1264} 1256}
… …
1451 Coro::cede; 1443 Coro::cede;
1452 1444
1453 $self->in_memory (cf::MAP_IN_MEMORY); 1445 $self->in_memory (cf::MAP_IN_MEMORY);
1454} 1446}
1455 1447
1448# find and load all maps in the 3x3 area around a map
1449sub load_diag {
1450 my ($map) = @_;
1451
1452 my @diag; # diagonal neighbours
1453
1454 for (0 .. 3) {
1455 my $neigh = $map->tile_path ($_)
1456 or next;
1457 $neigh = find $neigh, $map
1458 or next;
1459 $neigh->load;
1460
1461 push @diag, [$neigh->tile_path (($_ + 3) % 4), $neigh],
1462 [$neigh->tile_path (($_ + 1) % 4), $neigh];
1463 }
1464
1465 for (@diag) {
1466 my $neigh = find @$_
1467 or next;
1468 $neigh->load;
1469 }
1470}
1471
1456sub find_sync { 1472sub find_sync {
1457 my ($path, $origin) = @_; 1473 my ($path, $origin) = @_;
1458 1474
1459 cf::sync_job { cf::map::find $path, $origin } 1475 cf::sync_job { find $path, $origin }
1460} 1476}
1461 1477
1462sub do_load_sync { 1478sub do_load_sync {
1463 my ($map) = @_; 1479 my ($map) = @_;
1464 1480
1465 cf::sync_job { $map->load }; 1481 cf::sync_job { $map->load };
1482}
1483
1484our %MAP_PREFETCH;
1485our $MAP_PREFETCHER = Coro::async {
1486 while () {
1487 while (%MAP_PREFETCH) {
1488 my $key = each %MAP_PREFETCH
1489 or next;
1490 my $path = delete $MAP_PREFETCH{$key};
1491
1492 my $map = find $path
1493 or next;
1494 $map->load;
1495 }
1496 Coro::schedule;
1497 }
1498};
1499
1500sub find_async {
1501 my ($path, $origin) = @_;
1502
1503 $path = new cf::path $path, $origin && $origin->path;
1504 my $key = $path->as_string;
1505
1506 if (my $map = $cf::MAP{$key}) {
1507 return $map if $map->in_memory == cf::MAP_IN_MEMORY;
1508 }
1509
1510 $MAP_PREFETCH{$key} = $path;
1511 $MAP_PREFETCHER->ready;
1512
1513 ()
1466} 1514}
1467 1515
1468sub save { 1516sub save {
1469 my ($self) = @_; 1517 my ($self) = @_;
1470 1518
… …
1588 } 1636 }
1589 1637
1590 $map 1638 $map
1591} 1639}
1592 1640
1593sub emergency_save { 1641=item cf::map::unique_maps
1594 my $freeze_guard = cf::freeze_mainloop;
1595 1642
1596 warn "enter emergency perl save\n"; 1643Returns an arrayref of cf::path's of all shared maps that have
1644instantiated unique items. May block.
1597 1645
1598 cf::sync_job { 1646=cut
1599 warn "begin emergency player save\n";
1600 $_->save for values %cf::PLAYER;
1601 warn "end emergency player save\n";
1602 1647
1603 warn "begin emergency map save\n"; 1648sub unique_maps() {
1604 $_->save for values %cf::MAP; 1649 my $files = aio_readdir cf::localdir . "/" . cf::uniquedir
1605 warn "end emergency map save\n"; 1650 or return;
1651
1652 my @paths;
1653
1654 for (@$files) {
1655 utf8::decode $_;
1656 next if /\.pst$/;
1657 next unless /^$PATH_SEP/o;
1658
1659 push @paths, new cf::path $_;
1606 }; 1660 }
1607 1661
1608 warn "leave emergency perl save\n"; 1662 \@paths
1609} 1663}
1610 1664
1611package cf; 1665package cf;
1612 1666
1613=back 1667=back
1614 1668
1669=head3 cf::object
1670
1671=cut
1672
1673package cf::object;
1674
1675=over 4
1676
1677=item $ob->inv_recursive
1678
1679Returns the inventory of the object _and_ their inventories, recursively.
1680
1681=cut
1682
1683sub inv_recursive_;
1684sub inv_recursive_ {
1685 map { $_, inv_recursive_ $_->inv } @_
1686}
1687
1688sub inv_recursive {
1689 inv_recursive_ inv $_[0]
1690}
1691
1692package cf;
1693
1694=back
1615 1695
1616=head3 cf::object::player 1696=head3 cf::object::player
1617 1697
1618=over 4 1698=over 4
1619 1699
… …
1711 # use -1 or undef as default coordinates, not 0, 0 1791 # use -1 or undef as default coordinates, not 0, 0
1712 ($x, $y) = ($map->enter_x, $map->enter_y) 1792 ($x, $y) = ($map->enter_x, $map->enter_y)
1713 if $x <=0 && $y <= 0; 1793 if $x <=0 && $y <= 0;
1714 1794
1715 $map->load; 1795 $map->load;
1796 $map->load_diag;
1716 1797
1717 return unless $self->contr->active; 1798 return unless $self->contr->active;
1718 $self->activate_recursive; 1799 $self->activate_recursive;
1719 $self->enter_map ($map, $x, $y); 1800 $self->enter_map ($map, $x, $y);
1720} 1801}
… …
1757 1838
1758sub cf::object::player::goto { 1839sub cf::object::player::goto {
1759 my ($self, $path, $x, $y) = @_; 1840 my ($self, $path, $x, $y) = @_;
1760 1841
1761 $path = new cf::path $path; 1842 $path = new cf::path $path;
1762 $path ne "/" or Carp::cluck ("oy");#d#
1763 1843
1764 $self->enter_link; 1844 $self->enter_link;
1765 1845
1766 (async { 1846 (async {
1767 my $map = cf::map::find $path->as_string; 1847 my $map = cf::map::find $path->as_string;
… …
1844 1924
1845 1; 1925 1;
1846 }) { 1926 }) {
1847 $self->message ("Something went wrong deep within the crossfire server. " 1927 $self->message ("Something went wrong deep within the crossfire server. "
1848 . "I'll try to bring you back to the map you were before. " 1928 . "I'll try to bring you back to the map you were before. "
1849 . "Please report this to the dungeon master", 1929 . "Please report this to the dungeon master!",
1850 cf::NDI_UNIQUE | cf::NDI_RED); 1930 cf::NDI_UNIQUE | cf::NDI_RED);
1851 1931
1852 warn "ERROR in enter_exit: $@"; 1932 warn "ERROR in enter_exit: $@";
1853 $self->leave_link; 1933 $self->leave_link;
1854 } 1934 }
… …
2207 load_extensions; 2287 load_extensions;
2208 Event::loop; 2288 Event::loop;
2209} 2289}
2210 2290
2211############################################################################# 2291#############################################################################
2212# initialisation 2292# initialisation and cleanup
2293
2294# install some emergency cleanup handlers
2295BEGIN {
2296 for my $signal (qw(INT HUP TERM)) {
2297 Event->signal (
2298 data => WF_AUTOCANCEL,
2299 signal => $signal,
2300 cb => sub {
2301 cf::cleanup "SIG$signal";
2302 },
2303 );
2304 }
2305}
2306
2307sub emergency_save() {
2308 my $freeze_guard = cf::freeze_mainloop;
2309
2310 warn "enter emergency perl save\n";
2311
2312 cf::sync_job {
2313 # use a peculiar iteration method to avoid tripping on perl
2314 # refcount bugs in for. also avoids problems with players
2315 # and maps saved/Destroyed asynchronously.
2316 warn "begin emergency player save\n";
2317 for my $login (keys %cf::PLAYER) {
2318 my $pl = $cf::PLAYER{$login} or next;
2319 $pl->valid or next;
2320 $pl->save;
2321 }
2322 warn "end emergency player save\n";
2323
2324 warn "begin emergency map save\n";
2325 for my $path (keys %cf::MAP) {
2326 my $map = $cf::MAP{$path} or next;
2327 $map->valid or next;
2328 $map->save;
2329 }
2330 warn "end emergency map save\n";
2331 };
2332
2333 warn "leave emergency perl save\n";
2334}
2213 2335
2214sub reload() { 2336sub reload() {
2215 # can/must only be called in main 2337 # can/must only be called in main
2216 if ($Coro::current != $Coro::main) { 2338 if ($Coro::current != $Coro::main) {
2217 warn "can only reload from main coroutine\n"; 2339 warn "can only reload from main coroutine\n";
… …
2368 data => WF_AUTOCANCEL, 2490 data => WF_AUTOCANCEL,
2369 cb => sub { 2491 cb => sub {
2370 cf::server_tick; # one server iteration 2492 cf::server_tick; # one server iteration
2371 $RUNTIME += $TICK; 2493 $RUNTIME += $TICK;
2372 $NEXT_TICK += $TICK; 2494 $NEXT_TICK += $TICK;
2495
2496 $WAIT_FOR_TICK->broadcast;
2497 $WAIT_FOR_TICK_ONE->send if $WAIT_FOR_TICK_ONE->awaited;
2373 2498
2374 # if we are delayed by four ticks or more, skip them all 2499 # if we are delayed by four ticks or more, skip them all
2375 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4; 2500 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
2376 2501
2377 $TICK_WATCHER->at ($NEXT_TICK); 2502 $TICK_WATCHER->at ($NEXT_TICK);

Diff Legend

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