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.158 by root, Wed Jan 10 19:52:43 2007 UTC vs.
Revision 1.159 by root, Wed Jan 10 22:50:12 2007 UTC

… …
33 33
34$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
35 35
36our %COMMAND = (); 36our %COMMAND = ();
37our %COMMAND_TIME = (); 37our %COMMAND_TIME = ();
38
39our @EXTS = (); # list of extension package names
38our %EXTCMD = (); 40our %EXTCMD = ();
41our %EXT_CORO = (); # coroutines bound to extensions
39 42
40our @EVENT; 43our @EVENT;
41our $LIBDIR = datadir . "/ext"; 44our $LIBDIR = datadir . "/ext";
42 45
43our $TICK = MAX_TIME * 1e-6; 46our $TICK = MAX_TIME * 1e-6;
… …
52 55
53our %PLAYER; # all users 56our %PLAYER; # all users
54our %MAP; # all maps 57our %MAP; # all maps
55our $LINK_MAP; # the special {link} map 58our $LINK_MAP; # the special {link} map
56our $RANDOM_MAPS = cf::localdir . "/random"; 59our $RANDOM_MAPS = cf::localdir . "/random";
57our %EXT_CORO; # coroutines bound to extensions
58 60
59our $WAIT_FOR_TICK; $WAIT_FOR_TICK ||= new Coro::Signal; 61our $WAIT_FOR_TICK; $WAIT_FOR_TICK ||= new Coro::Signal;
60our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal; 62our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal;
61 63
62binmode STDOUT; 64binmode STDOUT;
… …
156} 158}
157 159
158$Event::DIED = sub { 160$Event::DIED = sub {
159 warn "error in event callback: @_"; 161 warn "error in event callback: @_";
160}; 162};
161
162my %ext_pkg;
163my @exts;
164my @hook;
165 163
166=head2 UTILITY FUNCTIONS 164=head2 UTILITY FUNCTIONS
167 165
168=over 4 166=over 4
169 167
… …
319 } 317 }
320} 318}
321 319
322=item $coro = cf::async_ext { BLOCK } 320=item $coro = cf::async_ext { BLOCK }
323 321
324Like async, but this coro is automcatially being canceled when the 322Like async, but this coro is automatically being canceled when the
325extension calling this is being unloaded. 323extension calling this is being unloaded.
326 324
327=cut 325=cut
328 326
329sub async_ext(&) { 327sub async_ext(&) {
… …
945=cut 943=cut
946 944
947sub register_extcmd { 945sub register_extcmd {
948 my ($name, $cb) = @_; 946 my ($name, $cb) = @_;
949 947
950 my $caller = caller;
951 #warn "registering extcmd '$name' to '$caller'";
952
953 $EXTCMD{$name} = [$cb, $caller]; 948 $EXTCMD{$name} = $cb;
954} 949}
955 950
956cf::player->attach ( 951cf::player->attach (
957 on_command => sub { 952 on_command => sub {
958 my ($pl, $name, $params) = @_; 953 my ($pl, $name, $params) = @_;
… …
971 966
972 my $msg = eval { from_json $buf }; 967 my $msg = eval { from_json $buf };
973 968
974 if (ref $msg) { 969 if (ref $msg) {
975 if (my $cb = $EXTCMD{$msg->{msgtype}}) { 970 if (my $cb = $EXTCMD{$msg->{msgtype}}) {
976 if (my %reply = $cb->[0]->($pl, $msg)) { 971 if (my %reply = $cb->($pl, $msg)) {
977 $pl->ext_reply ($msg->{msgid}, %reply); 972 $pl->ext_reply ($msg->{msgid}, %reply);
978 } 973 }
979 } 974 }
980 } else { 975 } else {
981 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; 976 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
… …
983 978
984 cf::override; 979 cf::override;
985 }, 980 },
986); 981);
987 982
988sub register {
989 my ($base, $pkg) = @_;
990
991 #TODO
992}
993
994sub load_extension { 983sub load_extension {
995 my ($path) = @_; 984 my ($path) = @_;
996 985
997 $path =~ /([^\/\\]+)\.ext$/ or die "$path"; 986 $path =~ /([^\/\\]+)\.ext$/ or die "$path";
998 my $base = $1; 987 my $base = $1;
… …
1013 1002
1014 eval $source 1003 eval $source
1015 or die $@ ? "$path: $@\n" 1004 or die $@ ? "$path: $@\n"
1016 : "extension disabled.\n"; 1005 : "extension disabled.\n";
1017 1006
1018 push @exts, $pkg; 1007 push @EXTS, $pkg;
1019 $ext_pkg{$base} = $pkg;
1020
1021# no strict 'refs';
1022# @{"$pkg\::ISA"} = ext::;
1023
1024 register $base, $pkg;
1025}
1026
1027sub unload_extension {
1028 my ($pkg) = @_;
1029
1030 warn "removing extension $pkg\n";
1031
1032 # remove hooks
1033 #TODO
1034# for my $idx (0 .. $#PLUGIN_EVENT) {
1035# delete $hook[$idx]{$pkg};
1036# }
1037
1038 # remove commands
1039 for my $name (keys %COMMAND) {
1040 my @cb = grep $_->[0] ne $pkg, @{ $COMMAND{$name} };
1041
1042 if (@cb) {
1043 $COMMAND{$name} = \@cb;
1044 } else {
1045 delete $COMMAND{$name};
1046 }
1047 }
1048
1049 # remove extcmds
1050 for my $name (grep $EXTCMD{$_}[1] eq $pkg, keys %EXTCMD) {
1051 delete $EXTCMD{$name};
1052 }
1053
1054 if (my $cb = $pkg->can ("unload")) {
1055 eval {
1056 $cb->($pkg);
1057 1
1058 } or warn "$pkg unloaded, but with errors: $@";
1059 }
1060
1061 Symbol::delete_package $pkg;
1062} 1008}
1063 1009
1064sub load_extensions { 1010sub load_extensions {
1065 for my $ext (<$LIBDIR/*.ext>) { 1011 for my $ext (<$LIBDIR/*.ext>) {
1066 next unless -r $ext; 1012 next unless -r $ext;
… …
2340 return; 2286 return;
2341 } 2287 }
2342 2288
2343 warn "reloading..."; 2289 warn "reloading...";
2344 2290
2291 warn "freezing server";
2345 my $guard = freeze_mainloop; 2292 my $guard = freeze_mainloop;
2346 cf::emergency_save; 2293 cf::emergency_save;
2347 2294
2295 warn "sync database to disk";
2296 cf::db_sync;
2297 IO::AIO::flush;
2298
2348 eval { 2299 eval {
2349 # if anything goes wrong in here, we should simply crash as we already saved 2300 # if anything goes wrong in here, we should simply crash as we already saved
2350 2301
2351 # cancel all watchers 2302 warn "cancel all watchers";
2352 for (Event::all_watchers) { 2303 for (Event::all_watchers) {
2353 $_->cancel if $_->data & WF_AUTOCANCEL; 2304 $_->cancel if $_->data & WF_AUTOCANCEL;
2354 } 2305 }
2355 2306
2356 # cancel all extension coros 2307 warn "cancel all extension coros";
2357 $_->cancel for values %EXT_CORO; 2308 $_->cancel for values %EXT_CORO;
2358 %EXT_CORO = (); 2309 %EXT_CORO = ();
2359 2310
2311 warn "remove commands";
2312 %COMMAND = ();
2313
2314 warn "remove ext commands";
2315 %EXTCMD = ();
2316
2360 # unload all extensions 2317 warn "unload/nuke all extensions";
2361 for (@exts) { 2318 for my $pkg (@EXTS) {
2362 warn "unloading <$_>"; 2319 warn "unloading <$pkg>";
2363 unload_extension $_; 2320
2321 if (my $cb = $pkg->can ("unload")) {
2322 eval {
2323 $cb->($pkg);
2324 1
2325 } or warn "$pkg unloaded, but with errors: $@";
2364 } 2326 }
2365 2327
2328 Symbol::delete_package $pkg;
2329 }
2330
2366 # unload all modules loaded from $LIBDIR 2331 warn "unload all perl modules loaded from $LIBDIR";
2367 while (my ($k, $v) = each %INC) { 2332 while (my ($k, $v) = each %INC) {
2368 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; 2333 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
2369 2334
2370 warn "removing <$k>"; 2335 warn "removing <$k>";
2371 delete $INC{$k}; 2336 delete $INC{$k};
… …
2378 } 2343 }
2379 2344
2380 Symbol::delete_package $k; 2345 Symbol::delete_package $k;
2381 } 2346 }
2382 2347
2383 # sync database to disk
2384 cf::db_sync;
2385 IO::AIO::flush;
2386
2387 # get rid of safe::, as good as possible 2348 warn "get rid of safe::, as good as possible";
2388 Symbol::delete_package "safe::$_" 2349 Symbol::delete_package "safe::$_"
2389 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region); 2350 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
2390 2351
2391 # remove register_script_function callbacks
2392 # TODO
2393
2394 # unload cf.pm "a bit" 2352 warn "unload cf.pm \"a bit\"";
2395 delete $INC{"cf.pm"}; 2353 delete $INC{"cf.pm"};
2396 2354
2397 # don't, removes xs symbols, too, 2355 # don't, removes xs symbols, too,
2398 # and global variables created in xs 2356 # and global variables created in xs
2399 #Symbol::delete_package __PACKAGE__; 2357 #Symbol::delete_package __PACKAGE__;
2400 2358
2401 # reload cf.pm
2402 warn "reloading cf.pm"; 2359 warn "reloading cf.pm";
2403 require cf; 2360 require cf;
2404 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 2361 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
2405 2362
2406 # load config and database again 2363 warn "load config and database again";
2407 cf::cfg_load; 2364 cf::cfg_load;
2408 cf::db_load; 2365 cf::db_load;
2409 2366
2410 # load extensions
2411 warn "load extensions"; 2367 warn "load extensions";
2412 cf::load_extensions; 2368 cf::load_extensions;
2413 2369
2414 # reattach attachments to objects 2370 warn "reattach attachments to objects/players";
2415 warn "reattach";
2416 _global_reattach; 2371 _global_reattach;
2372 warn "reattach attachments to maps";
2417 reattach $_ for values %MAP; 2373 reattach $_ for values %MAP;
2418 }; 2374 };
2419 2375
2420 if ($@) { 2376 if ($@) {
2421 warn $@; 2377 warn $@;
2422 warn "error while reloading, exiting."; 2378 warn "error while reloading, exiting.";
2423 exit 1; 2379 exit 1;
2424 } 2380 }
2425 2381
2426 warn "reloaded successfully"; 2382 warn "reloaded";
2427}; 2383};
2428 2384
2429############################################################################# 2385#############################################################################
2430 2386
2431unless ($LINK_MAP) { 2387unless ($LINK_MAP) {
… …
2466 $LINK_MAP->{deny_save} = 1; 2422 $LINK_MAP->{deny_save} = 1;
2467 $LINK_MAP->{deny_reset} = 1; 2423 $LINK_MAP->{deny_reset} = 1;
2468 2424
2469 $cf::MAP{$LINK_MAP->path} = $LINK_MAP; 2425 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
2470} 2426}
2471
2472register "<global>", __PACKAGE__;
2473 2427
2474register_command "reload" => sub { 2428register_command "reload" => sub {
2475 my ($who, $arg) = @_; 2429 my ($who, $arg) = @_;
2476 2430
2477 if ($who->flag (FLAG_WIZ)) { 2431 if ($who->flag (FLAG_WIZ)) {

Diff Legend

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