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.155 by root, Tue Jan 9 21:32:42 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
… …
1588 } 1576 }
1589 1577
1590 $map 1578 $map
1591} 1579}
1592 1580
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; 1581package cf;
1612 1582
1613=back 1583=back
1614 1584
1585=head3 cf::object
1586
1587=cut
1588
1589package cf::object;
1590
1591=over 4
1592
1593=item $ob->inv_recursive
1594
1595Returns the inventory of the object _and_ their inventories, recursively.
1596
1597=cut
1598
1599sub inv_recursive_;
1600sub inv_recursive_ {
1601 map { $_, inv_recursive_ $_->inv } @_
1602}
1603
1604sub inv_recursive {
1605 inv_recursive_ inv $_[0]
1606}
1607
1608package cf;
1609
1610=back
1615 1611
1616=head3 cf::object::player 1612=head3 cf::object::player
1617 1613
1618=over 4 1614=over 4
1619 1615
… …
2207 load_extensions; 2203 load_extensions;
2208 Event::loop; 2204 Event::loop;
2209} 2205}
2210 2206
2211############################################################################# 2207#############################################################################
2212# initialisation 2208# initialisation and cleanup
2209
2210# install some emergency cleanup handlers
2211BEGIN {
2212 for my $signal (qw(INT HUP TERM)) {
2213 Event->signal (
2214 data => WF_AUTOCANCEL,
2215 signal => $signal,
2216 cb => sub {
2217 cf::cleanup "SIG$signal";
2218 },
2219 );
2220 }
2221}
2222
2223sub emergency_save {
2224 my $freeze_guard = cf::freeze_mainloop;
2225
2226 warn "enter emergency perl save\n";
2227
2228 cf::sync_job {
2229 # use a peculiar iteration method to avoid tripping on perl
2230 # refcount bugs in for. also avoids problems with players
2231 # and maps saved/Destroyed asynchronously.
2232 warn "begin emergency player save\n";
2233 for my $login (keys %cf::PLAYER) {
2234 my $pl = $cf::PLAYER{$login} or next;
2235 $pl->valid or next;
2236 $pl->save;
2237 }
2238 warn "end emergency player save\n";
2239
2240 warn "begin emergency map save\n";
2241 for my $path (keys %cf::MAP) {
2242 my $map = $cf::MAP{$path} or next;
2243 $map->valid or next;
2244 $map->save;
2245 }
2246 warn "end emergency map save\n";
2247 };
2248
2249 warn "leave emergency perl save\n";
2250}
2213 2251
2214sub reload() { 2252sub reload() {
2215 # can/must only be called in main 2253 # can/must only be called in main
2216 if ($Coro::current != $Coro::main) { 2254 if ($Coro::current != $Coro::main) {
2217 warn "can only reload from main coroutine\n"; 2255 warn "can only reload from main coroutine\n";
… …
2368 data => WF_AUTOCANCEL, 2406 data => WF_AUTOCANCEL,
2369 cb => sub { 2407 cb => sub {
2370 cf::server_tick; # one server iteration 2408 cf::server_tick; # one server iteration
2371 $RUNTIME += $TICK; 2409 $RUNTIME += $TICK;
2372 $NEXT_TICK += $TICK; 2410 $NEXT_TICK += $TICK;
2411
2412 $WAIT_FOR_TICK->broadcast;
2413 $WAIT_FOR_TICK_ONE->send if $WAIT_FOR_TICK_ONE->awaited;
2373 2414
2374 # if we are delayed by four ticks or more, skip them all 2415 # if we are delayed by four ticks or more, skip them all
2375 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4; 2416 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
2376 2417
2377 $TICK_WATCHER->at ($NEXT_TICK); 2418 $TICK_WATCHER->at ($NEXT_TICK);

Diff Legend

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