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.475 by root, Tue Jul 21 06:17:00 2009 UTC vs.
Revision 1.483 by root, Mon Oct 12 04:02:17 2009 UTC

… …
88our %EXT_CORO = (); # coroutines bound to extensions 88our %EXT_CORO = (); # coroutines bound to extensions
89our %EXT_MAP = (); # pluggable maps 89our %EXT_MAP = (); # pluggable maps
90 90
91our $RELOAD; # number of reloads so far, non-zero while in reload 91our $RELOAD; # number of reloads so far, non-zero while in reload
92our @EVENT; 92our @EVENT;
93our @REFLECT; # set by XS
94our %REFLECT; # set by us
93 95
94our $CONFDIR = confdir; 96our $CONFDIR = confdir;
95our $DATADIR = datadir; 97our $DATADIR = datadir;
96our $LIBDIR = "$DATADIR/ext"; 98our $LIBDIR = "$DATADIR/ext";
97our $PODDIR = "$DATADIR/pod"; 99our $PODDIR = "$DATADIR/pod";
… …
115our $BDB_DEADLOCK_WATCHER; 117our $BDB_DEADLOCK_WATCHER;
116our $BDB_CHECKPOINT_WATCHER; 118our $BDB_CHECKPOINT_WATCHER;
117our $BDB_TRICKLE_WATCHER; 119our $BDB_TRICKLE_WATCHER;
118our $DB_ENV; 120our $DB_ENV;
119 121
120our @EXTRA_MODULES = qw(pod mapscript); 122our @EXTRA_MODULES = qw(pod match mapscript);
121 123
122our %CFG; 124our %CFG;
123 125
124our $UPTIME; $UPTIME ||= time; 126our $UPTIME; $UPTIME ||= time;
125our $RUNTIME; 127our $RUNTIME;
… …
161 163
162sub cf::map::normalise; 164sub cf::map::normalise;
163 165
164############################################################################# 166#############################################################################
165 167
168%REFLECT = ();
169for (@REFLECT) {
170 my $reflect = JSON::XS::decode_json $_;
171 $REFLECT{$reflect->{class}} = $reflect;
172}
173
174# this is decidedly evil
175$REFLECT{object}{flags} = { map +($_ => undef), grep $_, map /^FLAG_([A-Z0-9_]+)$/ && lc $1, keys %{"cf::"} };
176
177#############################################################################
178
166=head2 GLOBAL VARIABLES 179=head2 GLOBAL VARIABLES
167 180
168=over 4 181=over 4
169 182
170=item $cf::UPTIME 183=item $cf::UPTIME
… …
218 231
219This array contains the results of the last C<invoke ()> call. When 232This array contains the results of the last C<invoke ()> call. When
220C<cf::override> is called C<@cf::INVOKE_RESULTS> is set to the parameters of 233C<cf::override> is called C<@cf::INVOKE_RESULTS> is set to the parameters of
221that call. 234that call.
222 235
236=item %cf::REFLECT
237
238Contains, for each (C++) class name, a hash reference with information
239about object members (methods, scalars, arrays and flags) and other
240metadata, which is useful for introspection.
241
223=back 242=back
224 243
225=cut 244=cut
226 245
227BEGIN { 246$Coro::State::WARNHOOK = sub {
228 *CORE::GLOBAL::warn = sub {
229 my $msg = join "", @_; 247 my $msg = join "", @_;
230 248
231 $msg .= "\n" 249 $msg .= "\n"
232 unless $msg =~ /\n$/; 250 unless $msg =~ /\n$/;
233 251
234 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge; 252 $msg =~ s/([\x00-\x08\x0b-\x1f])/sprintf "\\x%02x", ord $1/ge;
235 253
236 LOG llevError, $msg; 254 LOG llevError, $msg;
237 }; 255};
238}
239 256
240$Coro::State::DIEHOOK = sub { 257$Coro::State::DIEHOOK = sub {
241 return unless $^S eq 0; # "eq", not "==" 258 return unless $^S eq 0; # "eq", not "=="
259
260 warn Carp::longmess $_[0];
242 261
243 if ($Coro::current == $Coro::main) {#d# 262 if ($Coro::current == $Coro::main) {#d#
244 warn "DIEHOOK called in main context, Coro bug?\n";#d# 263 warn "DIEHOOK called in main context, Coro bug?\n";#d#
245 return;#d# 264 return;#d#
246 }#d# 265 }#d#
247 266
248 # kill coroutine otherwise 267 # kill coroutine otherwise
249 warn Carp::longmess $_[0];
250 Coro::terminate 268 Coro::terminate
251}; 269};
252
253$SIG{__DIE__} = sub { }; #d#?
254 270
255@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 271@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
256@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 272@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
257@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable'; 273@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable';
258@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable'; 274@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable';
… …
2223 2239
2224 my $lock = cf::lock_acquire "map_data:$self->{path}"; 2240 my $lock = cf::lock_acquire "map_data:$self->{path}";
2225 2241
2226 return if $self->players; 2242 return if $self->players;
2227 2243
2228 warn "resetting map ", $self->path; 2244 warn "resetting map ", $self->path, "\n";
2229 2245
2230 $self->in_memory (cf::MAP_SWAPPED); 2246 $self->in_memory (cf::MAP_SWAPPED);
2231 2247
2232 # need to save uniques path 2248 # need to save uniques path
2233 unless ($self->{deny_save}) { 2249 unless ($self->{deny_save}) {
… …
2534 2550
2535 $map->load; 2551 $map->load;
2536 $map->load_neighbours; 2552 $map->load_neighbours;
2537 2553
2538 return unless $self->contr->active; 2554 return unless $self->contr->active;
2539 $self->flag (cf::FLAG_DEBUG, 0);#d# temp
2540 $self->activate_recursive;
2541 2555
2542 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2556 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2543 $self->enter_map ($map, $x, $y); 2557 $self->enter_map ($map, $x, $y);
2558
2559 # only activate afterwards, to support waiting in hooks
2560 $self->activate_recursive;
2544} 2561}
2545 2562
2546=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]]) 2563=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]])
2547 2564
2548Moves the player to the given map-path and coordinates by first freezing 2565Moves the player to the given map-path and coordinates by first freezing
… …
3742 3759
3743 warn "unload completed, starting to reload now"; 3760 warn "unload completed, starting to reload now";
3744 3761
3745 warn "reloading cf.pm"; 3762 warn "reloading cf.pm";
3746 require cf; 3763 require cf;
3747 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 3764 cf::_connect_to_perl_1;
3748 3765
3749 warn "loading config and database again"; 3766 warn "loading config and database again";
3750 cf::reload_config; 3767 cf::reload_config;
3751 3768
3752 warn "loading extensions"; 3769 warn "loading extensions";
… …
3960 } 3977 }
3961} 3978}
3962 3979
3963# load additional modules 3980# load additional modules
3964require "cf/$_.pm" for @EXTRA_MODULES; 3981require "cf/$_.pm" for @EXTRA_MODULES;
3982cf::_connect_to_perl_2;
3965 3983
3966END { cf::emergency_save } 3984END { cf::emergency_save }
3967 3985
39681 39861
3969 3987

Diff Legend

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