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.157 by root, Wed Jan 10 01:16:54 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
… …
1069}; 1079};
1070 1080
1071cf::map->attach (prio => -10000, package => cf::mapsupport::); 1081cf::map->attach (prio => -10000, package => cf::mapsupport::);
1072 1082
1073############################################################################# 1083#############################################################################
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 1084
1097=head2 CORE EXTENSIONS 1085=head2 CORE EXTENSIONS
1098 1086
1099Functions and methods that extend core crossfire objects. 1087Functions and methods that extend core crossfire objects.
1100 1088
… …
1225 my @logins; 1213 my @logins;
1226 1214
1227 for my $login (@$dirs) { 1215 for my $login (@$dirs) {
1228 my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next; 1216 my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next;
1229 aio_read $fh, 0, 512, my $buf, 0 or next; 1217 aio_read $fh, 0, 512, my $buf, 0 or next;
1230 $buf !~ /^password -------------$/ or next; # official not-valid tag 1218 $buf !~ /^password -------------$/m or next; # official not-valid tag
1231 1219
1232 utf8::decode $login; 1220 utf8::decode $login;
1233 push @logins, $login; 1221 push @logins, $login;
1234 } 1222 }
1235 1223
… …
1451 Coro::cede; 1439 Coro::cede;
1452 1440
1453 $self->in_memory (cf::MAP_IN_MEMORY); 1441 $self->in_memory (cf::MAP_IN_MEMORY);
1454} 1442}
1455 1443
1444# find and load all maps in the 3x3 area around a map
1445sub load_diag {
1446 my ($map) = @_;
1447
1448 my @diag; # diagonal neighbours
1449
1450 for (0 .. 3) {
1451 my $neigh = $map->tile_path ($_)
1452 or next;
1453 $neigh = find $neigh, $map
1454 or next;
1455 $neigh->load;
1456
1457 push @diag, [$neigh->tile_path (($_ + 3) % 4), $neigh],
1458 [$neigh->tile_path (($_ + 1) % 4), $neigh];
1459 }
1460
1461 for (@diag) {
1462 my $neigh = find @$_
1463 or next;
1464 $neigh->load;
1465 }
1466}
1467
1456sub find_sync { 1468sub find_sync {
1457 my ($path, $origin) = @_; 1469 my ($path, $origin) = @_;
1458 1470
1459 cf::sync_job { cf::map::find $path, $origin } 1471 cf::sync_job { find $path, $origin }
1460} 1472}
1461 1473
1462sub do_load_sync { 1474sub do_load_sync {
1463 my ($map) = @_; 1475 my ($map) = @_;
1464 1476
1465 cf::sync_job { $map->load }; 1477 cf::sync_job { $map->load };
1478}
1479
1480our %MAP_PREFETCH;
1481our $MAP_PREFETCHER = Coro::async {
1482 while () {
1483 while (%MAP_PREFETCH) {
1484 my $key = each %MAP_PREFETCH
1485 or next;
1486 my $path = delete $MAP_PREFETCH{$key};
1487
1488 my $map = find $path
1489 or next;
1490 $map->load;
1491 }
1492 Coro::schedule;
1493 }
1494};
1495
1496sub find_async {
1497 my ($path, $origin) = @_;
1498
1499 $path = new cf::path $path, $origin && $origin->path;
1500 my $key = $path->as_string;
1501
1502 if (my $map = $cf::MAP{$key}) {
1503 return $map if $map->in_memory == cf::MAP_IN_MEMORY;
1504 }
1505
1506 $MAP_PREFETCH{$key} = $path;
1507 $MAP_PREFETCHER->ready;
1508
1509 ()
1466} 1510}
1467 1511
1468sub save { 1512sub save {
1469 my ($self) = @_; 1513 my ($self) = @_;
1470 1514
… …
1588 } 1632 }
1589 1633
1590 $map 1634 $map
1591} 1635}
1592 1636
1593sub emergency_save {
1594 my $freeze_guard = cf::freeze_mainloop;
1595
1596 warn "enter emergency perl save\n";
1597
1598 cf::sync_job {
1599 warn "begin emergency player save\n";
1600 $_->save for values %cf::PLAYER;
1601 warn "end emergency player save\n";
1602
1603 warn "begin emergency map save\n";
1604 $_->save for values %cf::MAP;
1605 warn "end emergency map save\n";
1606 };
1607
1608 warn "leave emergency perl save\n";
1609}
1610
1611package cf; 1637package cf;
1612 1638
1613=back 1639=back
1614 1640
1641=head3 cf::object
1642
1643=cut
1644
1645package cf::object;
1646
1647=over 4
1648
1649=item $ob->inv_recursive
1650
1651Returns the inventory of the object _and_ their inventories, recursively.
1652
1653=cut
1654
1655sub inv_recursive_;
1656sub inv_recursive_ {
1657 map { $_, inv_recursive_ $_->inv } @_
1658}
1659
1660sub inv_recursive {
1661 inv_recursive_ inv $_[0]
1662}
1663
1664package cf;
1665
1666=back
1615 1667
1616=head3 cf::object::player 1668=head3 cf::object::player
1617 1669
1618=over 4 1670=over 4
1619 1671
… …
1711 # use -1 or undef as default coordinates, not 0, 0 1763 # use -1 or undef as default coordinates, not 0, 0
1712 ($x, $y) = ($map->enter_x, $map->enter_y) 1764 ($x, $y) = ($map->enter_x, $map->enter_y)
1713 if $x <=0 && $y <= 0; 1765 if $x <=0 && $y <= 0;
1714 1766
1715 $map->load; 1767 $map->load;
1768 $map->load_diag;
1716 1769
1717 return unless $self->contr->active; 1770 return unless $self->contr->active;
1718 $self->activate_recursive; 1771 $self->activate_recursive;
1719 $self->enter_map ($map, $x, $y); 1772 $self->enter_map ($map, $x, $y);
1720} 1773}
… …
2207 load_extensions; 2260 load_extensions;
2208 Event::loop; 2261 Event::loop;
2209} 2262}
2210 2263
2211############################################################################# 2264#############################################################################
2212# initialisation 2265# initialisation and cleanup
2266
2267# install some emergency cleanup handlers
2268BEGIN {
2269 for my $signal (qw(INT HUP TERM)) {
2270 Event->signal (
2271 data => WF_AUTOCANCEL,
2272 signal => $signal,
2273 cb => sub {
2274 cf::cleanup "SIG$signal";
2275 },
2276 );
2277 }
2278}
2279
2280sub emergency_save() {
2281 my $freeze_guard = cf::freeze_mainloop;
2282
2283 warn "enter emergency perl save\n";
2284
2285 cf::sync_job {
2286 # use a peculiar iteration method to avoid tripping on perl
2287 # refcount bugs in for. also avoids problems with players
2288 # and maps saved/Destroyed asynchronously.
2289 warn "begin emergency player save\n";
2290 for my $login (keys %cf::PLAYER) {
2291 my $pl = $cf::PLAYER{$login} or next;
2292 $pl->valid or next;
2293 $pl->save;
2294 }
2295 warn "end emergency player save\n";
2296
2297 warn "begin emergency map save\n";
2298 for my $path (keys %cf::MAP) {
2299 my $map = $cf::MAP{$path} or next;
2300 $map->valid or next;
2301 $map->save;
2302 }
2303 warn "end emergency map save\n";
2304 };
2305
2306 warn "leave emergency perl save\n";
2307}
2213 2308
2214sub reload() { 2309sub reload() {
2215 # can/must only be called in main 2310 # can/must only be called in main
2216 if ($Coro::current != $Coro::main) { 2311 if ($Coro::current != $Coro::main) {
2217 warn "can only reload from main coroutine\n"; 2312 warn "can only reload from main coroutine\n";
… …
2368 data => WF_AUTOCANCEL, 2463 data => WF_AUTOCANCEL,
2369 cb => sub { 2464 cb => sub {
2370 cf::server_tick; # one server iteration 2465 cf::server_tick; # one server iteration
2371 $RUNTIME += $TICK; 2466 $RUNTIME += $TICK;
2372 $NEXT_TICK += $TICK; 2467 $NEXT_TICK += $TICK;
2468
2469 $WAIT_FOR_TICK->broadcast;
2470 $WAIT_FOR_TICK_ONE->send if $WAIT_FOR_TICK_ONE->awaited;
2373 2471
2374 # if we are delayed by four ticks or more, skip them all 2472 # if we are delayed by four ticks or more, skip them all
2375 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4; 2473 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
2376 2474
2377 $TICK_WATCHER->at ($NEXT_TICK); 2475 $TICK_WATCHER->at ($NEXT_TICK);

Diff Legend

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