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.458 by root, Sat Dec 13 20:34:37 2008 UTC vs.
Revision 1.496 by root, Sun Nov 15 18:03:59 2009 UTC

1# 1#
2# This file is part of Deliantra, the Roguelike Realtime MMORPG. 2# This file is part of Deliantra, the Roguelike Realtime MMORPG.
3# 3#
4# Copyright (©) 2006,2007,2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team 4# Copyright (©) 2006,2007,2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
5# 5#
6# Deliantra is free software: you can redistribute it and/or modify 6# Deliantra is free software: you can redistribute it and/or modify it under
7# it under the terms of the GNU General Public License as published by 7# the terms of the Affero GNU General Public License as published by the
8# the Free Software Foundation, either version 3 of the License, or 8# Free Software Foundation, either version 3 of the License, or (at your
9# (at your option) any later version. 9# option) any later version.
10# 10#
11# This program is distributed in the hope that it will be useful, 11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14# GNU General Public License for more details. 14# GNU General Public License for more details.
15# 15#
16# You should have received a copy of the GNU General Public License 16# You should have received a copy of the Affero GNU General Public License
17# along with this program. If not, see <http://www.gnu.org/licenses/>. 17# and the GNU General Public License along with this program. If not, see
18# <http://www.gnu.org/licenses/>.
18# 19#
19# The authors can be reached via e-mail to <support@deliantra.net> 20# The authors can be reached via e-mail to <support@deliantra.net>
20# 21#
21 22
22package cf; 23package cf;
23 24
24use 5.10.0; 25use 5.10.0;
25use utf8; 26use utf8;
26use strict "vars", "subs"; 27use strict qw(vars subs);
27 28
28use Symbol; 29use Symbol;
29use List::Util; 30use List::Util;
30use Socket; 31use Socket;
31use EV; 32use EV;
32use Opcode; 33use Opcode;
33use Safe; 34use Safe;
34use Safe::Hole; 35use Safe::Hole;
35use Storable (); 36use Storable ();
37use Carp ();
36 38
37use Guard (); 39use Guard ();
38use Coro (); 40use Coro ();
39use Coro::State; 41use Coro::State;
40use Coro::Handle; 42use Coro::Handle;
41use Coro::EV; 43use Coro::EV;
42use Coro::AnyEvent; 44use Coro::AnyEvent;
43use Coro::Timer; 45use Coro::Timer;
44use Coro::Signal; 46use Coro::Signal;
45use Coro::Semaphore; 47use Coro::Semaphore;
48use Coro::SemaphoreSet;
46use Coro::AnyEvent; 49use Coro::AnyEvent;
47use Coro::AIO; 50use Coro::AIO;
48use Coro::BDB 1.6; 51use Coro::BDB 1.6;
49use Coro::Storable; 52use Coro::Storable;
50use Coro::Util (); 53use Coro::Util ();
51 54
52use JSON::XS 2.01 (); 55use JSON::XS 2.01 ();
53use BDB (); 56use BDB ();
54use Data::Dumper; 57use Data::Dumper;
55use Digest::MD5;
56use Fcntl; 58use Fcntl;
57use YAML (); 59use YAML::XS ();
58use IO::AIO (); 60use IO::AIO ();
59use Time::HiRes; 61use Time::HiRes;
60use Compress::LZF; 62use Compress::LZF;
61use Digest::MD5 (); 63use Digest::MD5 ();
62 64
… …
70$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority 72$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
71 73
72# make sure c-lzf reinitialises itself 74# make sure c-lzf reinitialises itself
73Compress::LZF::set_serializer "Storable", "Storable::net_mstore", "Storable::mretrieve"; 75Compress::LZF::set_serializer "Storable", "Storable::net_mstore", "Storable::mretrieve";
74Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later 76Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later
77
78# strictly for debugging
79$SIG{QUIT} = sub { Carp::cluck "SIGQUIT" };
75 80
76sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 81sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
77 82
78our %COMMAND = (); 83our %COMMAND = ();
79our %COMMAND_TIME = (); 84our %COMMAND_TIME = ();
… …
84our %EXT_CORO = (); # coroutines bound to extensions 89our %EXT_CORO = (); # coroutines bound to extensions
85our %EXT_MAP = (); # pluggable maps 90our %EXT_MAP = (); # pluggable maps
86 91
87our $RELOAD; # number of reloads so far, non-zero while in reload 92our $RELOAD; # number of reloads so far, non-zero while in reload
88our @EVENT; 93our @EVENT;
94our @REFLECT; # set by XS
95our %REFLECT; # set by us
89 96
90our $CONFDIR = confdir; 97our $CONFDIR = confdir;
91our $DATADIR = datadir; 98our $DATADIR = datadir;
92our $LIBDIR = "$DATADIR/ext"; 99our $LIBDIR = "$DATADIR/ext";
93our $PODDIR = "$DATADIR/pod"; 100our $PODDIR = "$DATADIR/pod";
… …
104our %RESOURCE; 111our %RESOURCE;
105 112
106our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) 113our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
107our $NEXT_RUNTIME_WRITE; # when should the runtime file be written 114our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
108our $NEXT_TICK; 115our $NEXT_TICK;
109our $USE_FSYNC = 1; # use fsync to write maps - default off 116our $USE_FSYNC = 1; # use fsync to write maps - default on
110 117
111our $BDB_DEADLOCK_WATCHER; 118our $BDB_DEADLOCK_WATCHER;
112our $BDB_CHECKPOINT_WATCHER; 119our $BDB_CHECKPOINT_WATCHER;
113our $BDB_TRICKLE_WATCHER; 120our $BDB_TRICKLE_WATCHER;
114our $DB_ENV; 121our $DB_ENV;
115 122
123our @EXTRA_MODULES = qw(pod match mapscript);
124
116our %CFG; 125our %CFG;
117 126
118our $UPTIME; $UPTIME ||= time; 127our $UPTIME; $UPTIME ||= time;
119our $RUNTIME; 128our $RUNTIME;
120our $NOW; 129our $NOW;
… …
131our $JITTER; # average jitter 140our $JITTER; # average jitter
132our $TICK_START; # for load detecting purposes 141our $TICK_START; # for load detecting purposes
133 142
134our @POST_INIT; 143our @POST_INIT;
135 144
136our $REATTACH_ON_RELOAD; # ste to true to force object reattach on reload (slow) 145our $REATTACH_ON_RELOAD; # set to true to force object reattach on reload (slow)
146our $REALLY_UNLOOP; # never set to true, please :)
137 147
138binmode STDOUT; 148binmode STDOUT;
139binmode STDERR; 149binmode STDERR;
140 150
141# read virtual server time, if available 151# read virtual server time, if available
… …
143 open my $fh, "<", $RUNTIMEFILE 153 open my $fh, "<", $RUNTIMEFILE
144 or die "unable to read $RUNTIMEFILE file: $!"; 154 or die "unable to read $RUNTIMEFILE file: $!";
145 $RUNTIME = <$fh> + 0.; 155 $RUNTIME = <$fh> + 0.;
146} 156}
147 157
158eval "sub TICK() { $TICK } 1" or die;
159
148mkdir $_ 160mkdir $_
149 for $LOCALDIR, $TMPDIR, $UNIQUEDIR, $PLAYERDIR, $RANDOMDIR, $BDBDIR; 161 for $LOCALDIR, $TMPDIR, $UNIQUEDIR, $PLAYERDIR, $RANDOMDIR, $BDBDIR;
150 162
151our $EMERGENCY_POSITION; 163our $EMERGENCY_POSITION;
152 164
153sub cf::map::normalise; 165sub cf::map::normalise;
166
167#############################################################################
168
169%REFLECT = ();
170for (@REFLECT) {
171 my $reflect = JSON::XS::decode_json $_;
172 $REFLECT{$reflect->{class}} = $reflect;
173}
174
175# this is decidedly evil
176$REFLECT{object}{flags} = { map +($_ => undef), grep $_, map /^FLAG_([A-Z0-9_]+)$/ && lc $1, keys %{"cf::"} };
154 177
155############################################################################# 178#############################################################################
156 179
157=head2 GLOBAL VARIABLES 180=head2 GLOBAL VARIABLES
158 181
… …
205returns directly I<after> the tick processing (and consequently, can only wake one process 228returns directly I<after> the tick processing (and consequently, can only wake one process
206per tick), while cf::wait_for_tick wakes up all waiters after tick processing. 229per tick), while cf::wait_for_tick wakes up all waiters after tick processing.
207 230
208=item @cf::INVOKE_RESULTS 231=item @cf::INVOKE_RESULTS
209 232
210This array contains the results of the last C<invoke ()> call. When 233This array contains the results of the last C<invoke ()> call. When
211C<cf::override> is called C<@cf::INVOKE_RESULTS> is set to the parameters of 234C<cf::override> is called C<@cf::INVOKE_RESULTS> is set to the parameters of
212that call. 235that call.
213 236
237=item %cf::REFLECT
238
239Contains, for each (C++) class name, a hash reference with information
240about object members (methods, scalars, arrays and flags) and other
241metadata, which is useful for introspection.
242
214=back 243=back
215 244
216=cut 245=cut
217 246
218BEGIN { 247$Coro::State::WARNHOOK = sub {
219 *CORE::GLOBAL::warn = sub {
220 my $msg = join "", @_; 248 my $msg = join "", @_;
221 249
222 $msg .= "\n" 250 $msg .= "\n"
223 unless $msg =~ /\n$/; 251 unless $msg =~ /\n$/;
224 252
225 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge; 253 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge;
226 254
227 LOG llevError, $msg; 255 LOG llevError, $msg;
228 }; 256};
229}
230 257
231$Coro::State::DIEHOOK = sub { 258$Coro::State::DIEHOOK = sub {
232 return unless $^S eq 0; # "eq", not "==" 259 return unless $^S eq 0; # "eq", not "=="
260
261 warn Carp::longmess $_[0];
233 262
234 if ($Coro::current == $Coro::main) {#d# 263 if ($Coro::current == $Coro::main) {#d#
235 warn "DIEHOOK called in main context, Coro bug?\n";#d# 264 warn "DIEHOOK called in main context, Coro bug?\n";#d#
236 return;#d# 265 return;#d#
237 }#d# 266 }#d#
238 267
239 # kill coroutine otherwise 268 # kill coroutine otherwise
240 warn Carp::longmess $_[0];
241 Coro::terminate 269 Coro::terminate
242}; 270};
243
244$SIG{__DIE__} = sub { }; #d#?
245 271
246@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 272@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
247@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 273@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
248@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable'; 274@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable';
249@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable'; 275@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable';
… …
263)) { 289)) {
264 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; 290 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg;
265} 291}
266 292
267$EV::DIED = sub { 293$EV::DIED = sub {
268 warn "error in event callback: @_"; 294 Carp::cluck "error in event callback: @_";
269}; 295};
270 296
271############################################################################# 297#############################################################################
272 298
273=head2 UTILITY FUNCTIONS 299=head2 UTILITY FUNCTIONS
… …
347 373
348Return true if the lock is currently active, i.e. somebody has locked it. 374Return true if the lock is currently active, i.e. somebody has locked it.
349 375
350=cut 376=cut
351 377
352our %LOCK; 378our $LOCKS = new Coro::SemaphoreSet;
353our %LOCKER;#d#
354 379
355sub lock_wait($) { 380sub lock_wait($) {
356 my ($key) = @_; 381 $LOCKS->wait ($_[0]);
357
358 if ($LOCKER{$key} == $Coro::current) {#d#
359 Carp::cluck "lock_wait($key) for already-acquired lock";#d#
360 return;#d#
361 }#d#
362
363 # wait for lock, if any
364 while ($LOCK{$key}) {
365 #local $Coro::current->{desc} = "$Coro::current->{desc} <waiting for lock $key>";
366 push @{ $LOCK{$key} }, $Coro::current;
367 Coro::schedule;
368 }
369} 382}
370 383
371sub lock_acquire($) { 384sub lock_acquire($) {
372 my ($key) = @_; 385 $LOCKS->guard ($_[0])
373
374 # wait, to be sure we are not locked
375 lock_wait $key;
376
377 $LOCK{$key} = [];
378 $LOCKER{$key} = $Coro::current;#d#
379
380 Guard::guard {
381 delete $LOCKER{$key};#d#
382 # wake up all waiters, to be on the safe side
383 $_->ready for @{ delete $LOCK{$key} };
384 }
385} 386}
386 387
387sub lock_active($) { 388sub lock_active($) {
388 my ($key) = @_; 389 $LOCKS->count ($_[0]) < 1
389
390 ! ! $LOCK{$key}
391} 390}
392 391
393sub freeze_mainloop { 392sub freeze_mainloop {
394 tick_inhibit_inc; 393 tick_inhibit_inc;
395 394
… …
1173 $decname, length $$rdata, scalar @$objs; 1172 $decname, length $$rdata, scalar @$objs;
1174 1173
1175 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) { 1174 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
1176 aio_chmod $fh, SAVE_MODE; 1175 aio_chmod $fh, SAVE_MODE;
1177 aio_write $fh, 0, (length $$rdata), $$rdata, 0; 1176 aio_write $fh, 0, (length $$rdata), $$rdata, 0;
1178 aio_fsync $fh if $cf::USE_FSYNC; 1177 if ($cf::USE_FSYNC) {
1178 aio_sync_file_range $fh, 0, 0, IO::AIO::SYNC_FILE_RANGE_WAIT_BEFORE | IO::AIO::SYNC_FILE_RANGE_WRITE | IO::AIO::SYNC_FILE_RANGE_WAIT_AFTER;
1179 aio_fsync $fh;
1180 }
1179 aio_close $fh; 1181 aio_close $fh;
1180 1182
1181 if (@$objs) { 1183 if (@$objs) {
1182 if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) { 1184 if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) {
1183 aio_chmod $fh, SAVE_MODE; 1185 aio_chmod $fh, SAVE_MODE;
1184 my $data = Coro::Storable::nfreeze { version => 1, objs => $objs }; 1186 my $data = Coro::Storable::nfreeze { version => 1, objs => $objs };
1185 aio_write $fh, 0, (length $data), $data, 0; 1187 aio_write $fh, 0, (length $data), $data, 0;
1186 aio_fsync $fh if $cf::USE_FSYNC; 1188 if ($cf::USE_FSYNC) {
1189 aio_sync_file_range $fh, 0, 0, IO::AIO::SYNC_FILE_RANGE_WAIT_BEFORE | IO::AIO::SYNC_FILE_RANGE_WRITE | IO::AIO::SYNC_FILE_RANGE_WAIT_AFTER;
1190 aio_fsync $fh;
1191 }
1187 aio_close $fh; 1192 aio_close $fh;
1188 aio_rename "$filename.pst~", "$filename.pst"; 1193 aio_rename "$filename.pst~", "$filename.pst";
1189 } 1194 }
1190 } else { 1195 } else {
1191 aio_unlink "$filename.pst"; 1196 aio_unlink "$filename.pst";
… …
1194 aio_rename "$filename~", $filename; 1199 aio_rename "$filename~", $filename;
1195 1200
1196 $filename =~ s%/[^/]+$%%; 1201 $filename =~ s%/[^/]+$%%;
1197 aio_pathsync $filename if $cf::USE_FSYNC; 1202 aio_pathsync $filename if $cf::USE_FSYNC;
1198 } else { 1203 } else {
1199 warn "FATAL: $filename~: $!\n"; 1204 warn "unable to save objects: $filename~: $!\n";
1200 } 1205 }
1201 } else { 1206 } else {
1202 aio_unlink $filename; 1207 aio_unlink $filename;
1203 aio_unlink "$filename.pst"; 1208 aio_unlink "$filename.pst";
1204 } 1209 }
… …
1342 1347
1343# "readahead" all extensions 1348# "readahead" all extensions
1344sub cache_extensions { 1349sub cache_extensions {
1345 my $grp = IO::AIO::aio_group; 1350 my $grp = IO::AIO::aio_group;
1346 1351
1347 add $grp IO::AIO::aio_readdir $LIBDIR, sub { 1352 add $grp IO::AIO::aio_readdirx $LIBDIR, IO::AIO::READDIR_STAT_ORDER, sub {
1348 for (grep /\.ext$/, @{$_[0]}) { 1353 for (grep /\.ext$/, @{$_[0]}) {
1349 add $grp IO::AIO::aio_load "$LIBDIR/$_", my $data; 1354 add $grp IO::AIO::aio_load "$LIBDIR/$_", my $data;
1350 } 1355 }
1351 }; 1356 };
1352 1357
… …
1888 1893
1889 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/go; 1894 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/go;
1890 "$UNIQUEDIR/$path" 1895 "$UNIQUEDIR/$path"
1891} 1896}
1892 1897
1893# and all this just because we cannot iterate over
1894# all maps in C++...
1895sub change_all_map_light {
1896 my ($change) = @_;
1897
1898 $_->change_map_light ($change)
1899 for grep $_->outdoor, values %cf::MAP;
1900}
1901
1902sub decay_objects { 1898sub decay_objects {
1903 my ($self) = @_; 1899 my ($self) = @_;
1904 1900
1905 return if $self->{deny_reset}; 1901 return if $self->{deny_reset};
1906 1902
… …
1988sub find { 1984sub find {
1989 my ($path, $origin) = @_; 1985 my ($path, $origin) = @_;
1990 1986
1991 $path = normalise $path, $origin && $origin->path; 1987 $path = normalise $path, $origin && $origin->path;
1992 1988
1993 cf::lock_wait "map_data:$path";#d#remove 1989 my $guard1 = cf::lock_acquire "map_data:$path";#d#remove
1994 cf::lock_wait "map_find:$path"; 1990 my $guard2 = cf::lock_acquire "map_find:$path";
1995 1991
1996 $cf::MAP{$path} || do { 1992 $cf::MAP{$path} || do {
1997 my $guard1 = cf::lock_acquire "map_data:$path"; # just for the fun of it
1998 my $guard2 = cf::lock_acquire "map_find:$path";
1999
2000 my $map = new_from_path cf::map $path 1993 my $map = new_from_path cf::map $path
2001 or return; 1994 or return;
2002 1995
2003 $map->{last_save} = $cf::RUNTIME; 1996 $map->{last_save} = $cf::RUNTIME;
2004 1997
… …
2072 unless ($self->{deny_activate}) { 2065 unless ($self->{deny_activate}) {
2073 $self->decay_objects; 2066 $self->decay_objects;
2074 $self->fix_auto_apply; 2067 $self->fix_auto_apply;
2075 $self->update_buttons; 2068 $self->update_buttons;
2076 cf::cede_to_tick; 2069 cf::cede_to_tick;
2077 $self->set_darkness_map;
2078 cf::cede_to_tick;
2079 $self->activate; 2070 $self->activate;
2080 } 2071 }
2081 2072
2082 $self->{last_save} = $cf::RUNTIME; 2073 $self->{last_save} = $cf::RUNTIME;
2083 $self->last_access ($cf::RUNTIME); 2074 $self->last_access ($cf::RUNTIME);
… …
2249 2240
2250 my $lock = cf::lock_acquire "map_data:$self->{path}"; 2241 my $lock = cf::lock_acquire "map_data:$self->{path}";
2251 2242
2252 return if $self->players; 2243 return if $self->players;
2253 2244
2254 warn "resetting map ", $self->path; 2245 warn "resetting map ", $self->path, "\n";
2255 2246
2256 $self->in_memory (cf::MAP_SWAPPED); 2247 $self->in_memory (cf::MAP_SWAPPED);
2257 2248
2258 # need to save uniques path 2249 # need to save uniques path
2259 unless ($self->{deny_save}) { 2250 unless ($self->{deny_save}) {
… …
2350 : normalise $_ 2341 : normalise $_
2351 } @{ aio_readdir $UNIQUEDIR or [] } 2342 } @{ aio_readdir $UNIQUEDIR or [] }
2352 ] 2343 ]
2353} 2344}
2354 2345
2346=item cf::map::static_maps
2347
2348Returns an arrayref if paths of all static maps (all preinstalled F<.map>
2349file in the shared directory excluding F</styles> and F</editor>). May
2350block.
2351
2352=cut
2353
2354sub static_maps() {
2355 my @dirs = "";
2356 my @maps;
2357
2358 while (@dirs) {
2359 my $dir = shift @dirs;
2360
2361 next if $dir eq "/styles" || $dir eq "/editor";
2362
2363 my ($dirs, $files) = Coro::AIO::aio_scandir "$MAPDIR$dir", 2
2364 or return;
2365
2366 for (@$files) {
2367 s/\.map$// or next;
2368 utf8::decode $_;
2369 push @maps, "$dir/$_";
2370 }
2371
2372 push @dirs, map "$dir/$_", @$dirs;
2373 }
2374
2375 \@maps
2376}
2377
2355=back 2378=back
2356 2379
2357=head3 cf::object 2380=head3 cf::object
2358 2381
2359=cut 2382=cut
… …
2424 2447
2425our $SAY_CHANNEL = { 2448our $SAY_CHANNEL = {
2426 id => "say", 2449 id => "say",
2427 title => "Map", 2450 title => "Map",
2428 reply => "say ", 2451 reply => "say ",
2429 tooltip => "Things said to and replied from npcs near you and other players on the same map only.", 2452 tooltip => "Things said to and replied from NPCs near you and other players on the same map only.",
2430}; 2453};
2431 2454
2432our $CHAT_CHANNEL = { 2455our $CHAT_CHANNEL = {
2433 id => "chat", 2456 id => "chat",
2434 title => "Chat", 2457 title => "Chat",
… …
2554 ($x, $y) = (-1, -1) 2577 ($x, $y) = (-1, -1)
2555 unless (defined $x) && (defined $y); 2578 unless (defined $x) && (defined $y);
2556 2579
2557 # use -1 or undef as default coordinates, not 0, 0 2580 # use -1 or undef as default coordinates, not 0, 0
2558 ($x, $y) = ($map->enter_x, $map->enter_y) 2581 ($x, $y) = ($map->enter_x, $map->enter_y)
2559 if $x <=0 && $y <= 0; 2582 if $x <= 0 && $y <= 0;
2560 2583
2561 $map->load; 2584 $map->load;
2562 $map->load_neighbours; 2585 $map->load_neighbours;
2563 2586
2564 return unless $self->contr->active; 2587 return unless $self->contr->active;
2565 $self->flag (cf::FLAG_DEBUG, 0);#d# temp
2566 $self->activate_recursive;
2567 2588
2568 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2589 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2569 $self->enter_map ($map, $x, $y); 2590 $self->enter_map ($map, $x, $y);
2591
2592 # only activate afterwards, to support waiting in hooks
2593 $self->activate_recursive;
2570} 2594}
2571 2595
2572=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]]) 2596=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]])
2573 2597
2574Moves the player to the given map-path and coordinates by first freezing 2598Moves the player to the given map-path and coordinates by first freezing
… …
2762 2786
2763 utf8::encode $text; 2787 utf8::encode $text;
2764 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text); 2788 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text);
2765} 2789}
2766 2790
2791=item $client->send_big_packet ($pkt)
2792
2793Like C<send_packet>, but tries to compress large packets, and fragments
2794them as required.
2795
2796=cut
2797
2798our $MAXFRAGSIZE = cf::MAXSOCKBUF - 64;
2799
2800sub cf::client::send_big_packet {
2801 my ($self, $pkt) = @_;
2802
2803 # try lzf for large packets
2804 $pkt = "lzf " . Compress::LZF::compress $pkt
2805 if 1024 <= length $pkt and $self->{can_lzf};
2806
2807 # split very large packets
2808 if ($MAXFRAGSIZE < length $pkt and $self->{can_lzf}) {
2809 $self->send_packet ("frag $_") for unpack "(a$MAXFRAGSIZE)*", $pkt;
2810 $pkt = "frag";
2811 }
2812
2813 $self->send_packet ($pkt);
2814}
2815
2767=item $client->send_msg ($channel, $msg, $color, [extra...]) 2816=item $client->send_msg ($channel, $msg, $color, [extra...])
2768 2817
2769Send a drawinfo or msg packet to the client, formatting the msg for the 2818Send a drawinfo or msg packet to the client, formatting the msg for the
2770client if neccessary. C<$type> should be a string identifying the type of 2819client if neccessary. C<$type> should be a string identifying the type of
2771the message, with C<log> being the default. If C<$color> is negative, suppress 2820the message, with C<log> being the default. If C<$color> is negative, suppress
… …
2773 2822
2774=cut 2823=cut
2775 2824
2776# non-persistent channels (usually the info channel) 2825# non-persistent channels (usually the info channel)
2777our %CHANNEL = ( 2826our %CHANNEL = (
2827 "c/motd" => {
2828 id => "infobox",
2829 title => "MOTD",
2830 reply => undef,
2831 tooltip => "The message of the day",
2832 },
2778 "c/identify" => { 2833 "c/identify" => {
2779 id => "infobox", 2834 id => "infobox",
2780 title => "Identify", 2835 title => "Identify",
2781 reply => undef, 2836 reply => undef,
2782 tooltip => "Items recently identified", 2837 tooltip => "Items recently identified",
… …
2784 "c/examine" => { 2839 "c/examine" => {
2785 id => "infobox", 2840 id => "infobox",
2786 title => "Examine", 2841 title => "Examine",
2787 reply => undef, 2842 reply => undef,
2788 tooltip => "Signs and other items you examined", 2843 tooltip => "Signs and other items you examined",
2844 },
2845 "c/shopinfo" => {
2846 id => "infobox",
2847 title => "Shop Info",
2848 reply => undef,
2849 tooltip => "What your bargaining skill tells you about the shop",
2789 }, 2850 },
2790 "c/book" => { 2851 "c/book" => {
2791 id => "infobox", 2852 id => "infobox",
2792 title => "Book", 2853 title => "Book",
2793 reply => undef, 2854 reply => undef,
… …
2809 id => "infobox", 2870 id => "infobox",
2810 title => "Body Parts", 2871 title => "Body Parts",
2811 reply => undef, 2872 reply => undef,
2812 tooltip => "Shows which body parts you posess and are available", 2873 tooltip => "Shows which body parts you posess and are available",
2813 }, 2874 },
2875 "c/statistics" => {
2876 id => "infobox",
2877 title => "Statistics",
2878 reply => undef,
2879 tooltip => "Shows your primary statistics",
2880 },
2814 "c/skills" => { 2881 "c/skills" => {
2815 id => "infobox", 2882 id => "infobox",
2816 title => "Skills", 2883 title => "Skills",
2817 reply => undef, 2884 reply => undef,
2818 tooltip => "Shows your experience per skill and item power", 2885 tooltip => "Shows your experience per skill and item power",
2886 },
2887 "c/shopitems" => {
2888 id => "infobox",
2889 title => "Shop Items",
2890 reply => undef,
2891 tooltip => "Shows the items currently for sale in this shop",
2892 },
2893 "c/resistances" => {
2894 id => "infobox",
2895 title => "Resistances",
2896 reply => undef,
2897 tooltip => "Shows your resistances",
2898 },
2899 "c/pets" => {
2900 id => "infobox",
2901 title => "Pets",
2902 reply => undef,
2903 tooltip => "Shows information abotu your pets/a specific pet",
2904 },
2905 "c/perceiveself" => {
2906 id => "infobox",
2907 title => "Perceive Self",
2908 reply => undef,
2909 tooltip => "You gained detailed knowledge about yourself",
2819 }, 2910 },
2820 "c/uptime" => { 2911 "c/uptime" => {
2821 id => "infobox", 2912 id => "infobox",
2822 title => "Uptime", 2913 title => "Uptime",
2823 reply => undef, 2914 reply => undef,
… …
2833 id => "party", 2924 id => "party",
2834 title => "Party", 2925 title => "Party",
2835 reply => "gsay ", 2926 reply => "gsay ",
2836 tooltip => "Messages and chat related to your party", 2927 tooltip => "Messages and chat related to your party",
2837 }, 2928 },
2929 "c/death" => {
2930 id => "death",
2931 title => "Death",
2932 reply => undef,
2933 tooltip => "Reason for and more info about your most recent death",
2934 },
2935 "c/say" => $SAY_CHANNEL,
2936 "c/chat" => $CHAT_CHANNEL,
2838); 2937);
2839 2938
2840sub cf::client::send_msg { 2939sub cf::client::send_msg {
2841 my ($self, $channel, $msg, $color, @extra) = @_; 2940 my ($self, $channel, $msg, $color, @extra) = @_;
2842 2941
… …
2847 2946
2848 # check predefined channels, for the benefit of C 2947 # check predefined channels, for the benefit of C
2849 if ($CHANNEL{$channel}) { 2948 if ($CHANNEL{$channel}) {
2850 $channel = $CHANNEL{$channel}; 2949 $channel = $CHANNEL{$channel};
2851 2950
2852 $self->ext_msg (channel_info => $channel) 2951 $self->ext_msg (channel_info => $channel);
2853 if $self->can_msg;
2854
2855 $channel = $channel->{id}; 2952 $channel = $channel->{id};
2856 2953
2857 } elsif (ref $channel) { 2954 } elsif (ref $channel) {
2858 # send meta info to client, if not yet sent 2955 # send meta info to client, if not yet sent
2859 unless (exists $self->{channel}{$channel->{id}}) { 2956 unless (exists $self->{channel}{$channel->{id}}) {
2860 $self->{channel}{$channel->{id}} = $channel; 2957 $self->{channel}{$channel->{id}} = $channel;
2861 $self->ext_msg (channel_info => $channel) 2958 $self->ext_msg (channel_info => $channel);
2862 if $self->can_msg;
2863 } 2959 }
2864 2960
2865 $channel = $channel->{id}; 2961 $channel = $channel->{id};
2866 } 2962 }
2867 2963
2868 return unless @extra || length $msg; 2964 return unless @extra || length $msg;
2869 2965
2870 if ($self->can_msg) {
2871 # default colour, mask it out 2966 # default colour, mask it out
2872 $color &= ~(cf::NDI_COLOR_MASK | cf::NDI_DEF) 2967 $color &= ~(cf::NDI_COLOR_MASK | cf::NDI_DEF)
2873 if $color & cf::NDI_DEF; 2968 if $color & cf::NDI_DEF;
2874 2969
2875 my $pkt = "msg " 2970 my $pkt = "msg "
2876 . $self->{json_coder}->encode ( 2971 . $self->{json_coder}->encode (
2877 [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra] 2972 [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra]
2878 ); 2973 );
2879 2974
2880 # try lzf for large packets
2881 $pkt = "lzf " . Compress::LZF::compress $pkt
2882 if 1024 <= length $pkt and $self->{can_lzf};
2883
2884 # split very large packets
2885 if (8192 < length $pkt and $self->{can_lzf}) {
2886 $self->send_packet ("frag $_") for unpack "(a8192)*", $pkt;
2887 $pkt = "frag";
2888 }
2889
2890 $self->send_packet ($pkt); 2975 $self->send_big_packet ($pkt);
2891 } else {
2892 if ($color >= 0) {
2893 # replace some tags by gcfclient-compatible ones
2894 for ($msg) {
2895 1 while
2896 s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
2897 || s/<i>([^<]*)<\/i>/[i]${1}[\/i]/
2898 || s/<u>([^<]*)<\/u>/[ul]${1}[\/ul]/
2899 || s/<tt>([^<]*)<\/tt>/[fixed]${1}[\/fixed]/
2900 || s/<fg name=\"([^"]+)\">([^<]*)<\/fg>/[color=$1]${2}[\/color]/;
2901 }
2902
2903 $color &= cf::NDI_COLOR_MASK;
2904
2905 utf8::encode $msg;
2906
2907 if (0 && $msg =~ /\[/) {
2908 # COMMAND/INFO
2909 $self->send_packet ("drawextinfo $color 10 8 $msg")
2910 } else {
2911 $msg =~ s/\[\/?(?:b|i|u|fixed|color)[^\]]*\]//g;
2912 $self->send_packet ("drawinfo $color $msg")
2913 }
2914 }
2915 }
2916} 2976}
2917 2977
2918=item $client->ext_msg ($type, @msg) 2978=item $client->ext_msg ($type, @msg)
2919 2979
2920Sends an ext event to the client. 2980Sends an ext event to the client.
… …
2923 2983
2924sub cf::client::ext_msg($$@) { 2984sub cf::client::ext_msg($$@) {
2925 my ($self, $type, @msg) = @_; 2985 my ($self, $type, @msg) = @_;
2926 2986
2927 if ($self->extcmd == 2) { 2987 if ($self->extcmd == 2) {
2928 $self->send_packet ("ext " . $self->{json_coder}->encode ([$type, @msg])); 2988 $self->send_big_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
2929 } elsif ($self->extcmd == 1) { # TODO: remove 2989 } elsif ($self->extcmd == 1) { # TODO: remove
2930 push @msg, msgtype => "event_$type"; 2990 push @msg, msgtype => "event_$type";
2931 $self->send_packet ("ext " . $self->{json_coder}->encode ({@msg})); 2991 $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
2932 } 2992 }
2933} 2993}
2934 2994
2935=item $client->ext_reply ($msgid, @msg) 2995=item $client->ext_reply ($msgid, @msg)
2936 2996
… …
2940 3000
2941sub cf::client::ext_reply($$@) { 3001sub cf::client::ext_reply($$@) {
2942 my ($self, $id, @msg) = @_; 3002 my ($self, $id, @msg) = @_;
2943 3003
2944 if ($self->extcmd == 2) { 3004 if ($self->extcmd == 2) {
2945 $self->send_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg])); 3005 $self->send_big_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg]));
2946 } elsif ($self->extcmd == 1) { 3006 } elsif ($self->extcmd == 1) {
2947 #TODO: version 1, remove 3007 #TODO: version 1, remove
2948 unshift @msg, msgtype => "reply", msgid => $id; 3008 unshift @msg, msgtype => "reply", msgid => $id;
2949 $self->send_packet ("ext " . $self->{json_coder}->encode ({@msg})); 3009 $self->send_big_packet ("ext " . $self->{json_coder}->encode ({@msg}));
2950 } 3010 }
2951} 3011}
2952 3012
2953=item $success = $client->query ($flags, "text", \&cb) 3013=item $success = $client->query ($flags, "text", \&cb)
2954 3014
… …
3095The following functions and methods are available within a safe environment: 3155The following functions and methods are available within a safe environment:
3096 3156
3097 cf::object 3157 cf::object
3098 contr pay_amount pay_player map x y force_find force_add destroy 3158 contr pay_amount pay_player map x y force_find force_add destroy
3099 insert remove name archname title slaying race decrease split 3159 insert remove name archname title slaying race decrease split
3160 value
3100 3161
3101 cf::object::player 3162 cf::object::player
3102 player 3163 player
3103 3164
3104 cf::player 3165 cf::player
… …
3110=cut 3171=cut
3111 3172
3112for ( 3173for (
3113 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y 3174 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y
3114 insert remove inv nrof name archname title slaying race 3175 insert remove inv nrof name archname title slaying race
3115 decrease split destroy change_exp)], 3176 decrease split destroy change_exp value msg lore send_msg)],
3116 ["cf::object::player" => qw(player)], 3177 ["cf::object::player" => qw(player)],
3117 ["cf::player" => qw(peaceful)], 3178 ["cf::player" => qw(peaceful send_msg)],
3118 ["cf::map" => qw(trigger)], 3179 ["cf::map" => qw(trigger)],
3119) { 3180) {
3120 no strict 'refs'; 3181 no strict 'refs';
3121 my ($pkg, @funs) = @$_; 3182 my ($pkg, @funs) = @$_;
3122 *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"}) 3183 *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"})
… …
3139 my ($code, %vars) = @_; 3200 my ($code, %vars) = @_;
3140 3201
3141 my $qcode = $code; 3202 my $qcode = $code;
3142 $qcode =~ s/"/‟/g; # not allowed in #line filenames 3203 $qcode =~ s/"/‟/g; # not allowed in #line filenames
3143 $qcode =~ s/\n/\\n/g; 3204 $qcode =~ s/\n/\\n/g;
3205
3206 %vars = (_dummy => 0) unless %vars;
3144 3207
3145 local $_; 3208 local $_;
3146 local @safe::cf::_safe_eval_args = values %vars; 3209 local @safe::cf::_safe_eval_args = values %vars;
3147 3210
3148 my $eval = 3211 my $eval =
… …
3228 while (my ($face, $info) = each %$faces) { 3291 while (my ($face, $info) = each %$faces) {
3229 my $idx = (cf::face::find $face) || cf::face::alloc $face; 3292 my $idx = (cf::face::find $face) || cf::face::alloc $face;
3230 3293
3231 cf::face::set_visibility $idx, $info->{visibility}; 3294 cf::face::set_visibility $idx, $info->{visibility};
3232 cf::face::set_magicmap $idx, $info->{magicmap}; 3295 cf::face::set_magicmap $idx, $info->{magicmap};
3233 cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32}; 3296 cf::face::set_data $idx, 0, $info->{data32}, $info->{hash32};
3234 cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64}; 3297 cf::face::set_data $idx, 1, $info->{data64}, $info->{hash64};
3235 3298
3236 cf::cede_to_tick; 3299 cf::cede_to_tick;
3237 } 3300 }
3238 3301
3239 while (my ($face, $info) = each %$faces) { 3302 while (my ($face, $info) = each %$faces) {
… …
3263 3326
3264 cf::anim::invalidate_all; # d'oh 3327 cf::anim::invalidate_all; # d'oh
3265 } 3328 }
3266 3329
3267 { 3330 {
3268 # TODO: for gcfclient pleasure, we should give resources
3269 # that gcfclient doesn't grok a >10000 face index.
3270 my $res = $facedata->{resource}; 3331 my $res = $facedata->{resource};
3271 3332
3272 while (my ($name, $info) = each %$res) { 3333 while (my ($name, $info) = each %$res) {
3273 if (defined $info->{type}) { 3334 if (defined $info->{type}) {
3274 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3335 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3275 my $data;
3276 3336
3277 if ($info->{type} & 1) { 3337 cf::face::set_data $idx, 0, $info->{data}, $info->{hash};
3278 # prepend meta info
3279
3280 my $meta = $enc->encode ({
3281 name => $name,
3282 %{ $info->{meta} || {} },
3283 });
3284
3285 $data = pack "(w/a*)*", $meta, $info->{data};
3286 } else {
3287 $data = $info->{data};
3288 }
3289
3290 cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
3291 cf::face::set_type $idx, $info->{type}; 3338 cf::face::set_type $idx, $info->{type};
3292 } else { 3339 } else {
3293 $RESOURCE{$name} = $info; 3340 $RESOURCE{$name} = $info;
3294 } 3341 }
3295 3342
… …
3379 3426
3380 warn "finished reloading resource files\n"; 3427 warn "finished reloading resource files\n";
3381} 3428}
3382 3429
3383sub reload_config { 3430sub reload_config {
3431 warn "reloading config file...\n";
3432
3384 open my $fh, "<:utf8", "$CONFDIR/config" 3433 open my $fh, "<:utf8", "$CONFDIR/config"
3385 or return; 3434 or return;
3386 3435
3387 local $/; 3436 local $/;
3388 *CFG = YAML::Load <$fh>; 3437 *CFG = YAML::XS::Load scalar <$fh>;
3389 3438
3390 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3439 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
3391 3440
3392 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3441 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
3393 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 3442 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
… …
3397 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()" 3446 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
3398 and die "WARNING: m(un)lockall failed: $!\n"; 3447 and die "WARNING: m(un)lockall failed: $!\n";
3399 }; 3448 };
3400 warn $@ if $@; 3449 warn $@ if $@;
3401 } 3450 }
3451
3452 warn "finished reloading resource files\n";
3402} 3453}
3403 3454
3404sub pidfile() { 3455sub pidfile() {
3405 sysopen my $fh, $PIDFILE, O_RDWR | O_CREAT 3456 sysopen my $fh, $PIDFILE, O_RDWR | O_CREAT
3406 or die "$PIDFILE: $!"; 3457 or die "$PIDFILE: $!";
… …
3418 3469
3419 seek $fh, 0, 0; 3470 seek $fh, 0, 0;
3420 print $fh $$; 3471 print $fh $$;
3421} 3472}
3422 3473
3474sub main_loop {
3475 warn "EV::loop starting\n";
3476 if (1) {
3477 EV::loop;
3478 }
3479 warn "EV::loop returned\n";
3480 goto &main_loop unless $REALLY_UNLOOP;
3481}
3482
3423sub main { 3483sub main {
3424 cf::init_globals; # initialise logging 3484 cf::init_globals; # initialise logging
3425 3485
3426 LOG llevInfo, "Welcome to Deliantra, v" . VERSION; 3486 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3427 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team."; 3487 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
… …
3430 3490
3431 cf::init_experience; 3491 cf::init_experience;
3432 cf::init_anim; 3492 cf::init_anim;
3433 cf::init_attackmess; 3493 cf::init_attackmess;
3434 cf::init_dynamic; 3494 cf::init_dynamic;
3435 cf::init_block;
3436 3495
3437 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3496 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3438 3497
3439 # we must not ever block the main coroutine 3498 # we must not ever block the main coroutine
3440 local $Coro::idle = sub { 3499 local $Coro::idle = sub {
… …
3446 }; 3505 };
3447 3506
3448 evthread_start IO::AIO::poll_fileno; 3507 evthread_start IO::AIO::poll_fileno;
3449 3508
3450 cf::sync_job { 3509 cf::sync_job {
3510 cf::load_settings;
3511 cf::load_materials;
3512
3451 reload_resources; 3513 reload_resources;
3452 reload_config; 3514 reload_config;
3453 db_init; 3515 db_init;
3454 3516
3455 cf::load_settings;
3456 cf::load_materials;
3457 cf::init_uuid; 3517 cf::init_uuid;
3458 cf::init_signals; 3518 cf::init_signals;
3459 cf::init_commands; 3519 cf::init_commands;
3460 cf::init_skills; 3520 cf::init_skills;
3461 3521
… …
3466 load_extensions; 3526 load_extensions;
3467 3527
3468 utime time, time, $RUNTIMEFILE; 3528 utime time, time, $RUNTIMEFILE;
3469 3529
3470 # no (long-running) fork's whatsoever before this point(!) 3530 # no (long-running) fork's whatsoever before this point(!)
3531 use POSIX ();
3471 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD}; 3532 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD};
3472 3533
3473 (pop @POST_INIT)->(0) while @POST_INIT; 3534 (pop @POST_INIT)->(0) while @POST_INIT;
3474 }; 3535 };
3475 3536
3476 EV::loop; 3537 main_loop;
3477} 3538}
3478 3539
3479############################################################################# 3540#############################################################################
3480# initialisation and cleanup 3541# initialisation and cleanup
3481 3542
… …
3737 clear_package "safe::$_" 3798 clear_package "safe::$_"
3738 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region); 3799 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
3739 3800
3740 warn "unloading cf.pm \"a bit\""; 3801 warn "unloading cf.pm \"a bit\"";
3741 delete $INC{"cf.pm"}; 3802 delete $INC{"cf.pm"};
3742 delete $INC{"cf/pod.pm"}; 3803 delete $INC{"cf/$_.pm"} for @EXTRA_MODULES;
3743 3804
3744 # don't, removes xs symbols, too, 3805 # don't, removes xs symbols, too,
3745 # and global variables created in xs 3806 # and global variables created in xs
3746 #clear_package __PACKAGE__; 3807 #clear_package __PACKAGE__;
3747 3808
3748 warn "unload completed, starting to reload now"; 3809 warn "unload completed, starting to reload now";
3749 3810
3750 warn "reloading cf.pm"; 3811 warn "reloading cf.pm";
3751 require cf; 3812 require cf;
3752 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 3813 cf::_connect_to_perl_1;
3753 3814
3754 warn "loading config and database again"; 3815 warn "loading config and database again";
3755 cf::reload_config; 3816 cf::reload_config;
3756 3817
3757 warn "loading extensions"; 3818 warn "loading extensions";
… …
3964 LOG llevInfo, "[ABT] [suppressed]\n"; 4025 LOG llevInfo, "[ABT] [suppressed]\n";
3965 } 4026 }
3966} 4027}
3967 4028
3968# load additional modules 4029# load additional modules
3969use cf::pod; 4030require "cf/$_.pm" for @EXTRA_MODULES;
4031cf::_connect_to_perl_2;
3970 4032
3971END { cf::emergency_save } 4033END { cf::emergency_save }
3972 4034
39731 40351
3974 4036

Diff Legend

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