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.160 by root, Wed Jan 10 22:54:06 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;
999 my $pkg = $1; 988 my $pkg = $1;
1000 $pkg =~ s/[^[:word:]]/_/g; 989 $pkg =~ s/[^[:word:]]/_/g;
1001 $pkg = "ext::$pkg"; 990 $pkg = "ext::$pkg";
1002 991
1003 warn "loading '$path' into '$pkg'\n"; 992 warn "... loading '$path' into '$pkg'\n";
1004 993
1005 open my $fh, "<:utf8", $path 994 open my $fh, "<:utf8", $path
1006 or die "$path: $!"; 995 or die "$path: $!";
1007 996
1008 my $source = 997 my $source =
… …
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 warn "... nuking $pkg";
2329 Symbol::delete_package $pkg;
2330 }
2331
2366 # unload all modules loaded from $LIBDIR 2332 warn "unload all perl modules loaded from $LIBDIR";
2367 while (my ($k, $v) = each %INC) { 2333 while (my ($k, $v) = each %INC) {
2368 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; 2334 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
2369 2335
2370 warn "removing <$k>"; 2336 warn "removing <$k>";
2371 delete $INC{$k}; 2337 delete $INC{$k};
… …
2378 } 2344 }
2379 2345
2380 Symbol::delete_package $k; 2346 Symbol::delete_package $k;
2381 } 2347 }
2382 2348
2383 # sync database to disk
2384 cf::db_sync;
2385 IO::AIO::flush;
2386
2387 # get rid of safe::, as good as possible 2349 warn "get rid of safe::, as good as possible";
2388 Symbol::delete_package "safe::$_" 2350 Symbol::delete_package "safe::$_"
2389 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region); 2351 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
2390 2352
2391 # remove register_script_function callbacks
2392 # TODO
2393
2394 # unload cf.pm "a bit" 2353 warn "unload cf.pm \"a bit\"";
2395 delete $INC{"cf.pm"}; 2354 delete $INC{"cf.pm"};
2396 2355
2397 # don't, removes xs symbols, too, 2356 # don't, removes xs symbols, too,
2398 # and global variables created in xs 2357 # and global variables created in xs
2399 #Symbol::delete_package __PACKAGE__; 2358 #Symbol::delete_package __PACKAGE__;
2400 2359
2401 # reload cf.pm
2402 warn "reloading cf.pm"; 2360 warn "reloading cf.pm";
2403 require cf; 2361 require cf;
2404 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 2362 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
2405 2363
2406 # load config and database again 2364 warn "load config and database again";
2407 cf::cfg_load; 2365 cf::cfg_load;
2408 cf::db_load; 2366 cf::db_load;
2409 2367
2410 # load extensions
2411 warn "load extensions"; 2368 warn "load extensions";
2412 cf::load_extensions; 2369 cf::load_extensions;
2413 2370
2414 # reattach attachments to objects 2371 warn "reattach attachments to objects/players";
2415 warn "reattach";
2416 _global_reattach; 2372 _global_reattach;
2373 warn "reattach attachments to maps";
2417 reattach $_ for values %MAP; 2374 reattach $_ for values %MAP;
2418 }; 2375 };
2419 2376
2420 if ($@) { 2377 if ($@) {
2421 warn $@; 2378 warn $@;
2422 warn "error while reloading, exiting."; 2379 warn "error while reloading, exiting.";
2423 exit 1; 2380 exit 1;
2424 } 2381 }
2425 2382
2426 warn "reloaded successfully"; 2383 warn "reloaded";
2427}; 2384};
2428 2385
2429############################################################################# 2386#############################################################################
2430 2387
2431unless ($LINK_MAP) { 2388unless ($LINK_MAP) {
… …
2466 $LINK_MAP->{deny_save} = 1; 2423 $LINK_MAP->{deny_save} = 1;
2467 $LINK_MAP->{deny_reset} = 1; 2424 $LINK_MAP->{deny_reset} = 1;
2468 2425
2469 $cf::MAP{$LINK_MAP->path} = $LINK_MAP; 2426 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
2470} 2427}
2471
2472register "<global>", __PACKAGE__;
2473 2428
2474register_command "reload" => sub { 2429register_command "reload" => sub {
2475 my ($who, $arg) = @_; 2430 my ($who, $arg) = @_;
2476 2431
2477 if ($who->flag (FLAG_WIZ)) { 2432 if ($who->flag (FLAG_WIZ)) {

Diff Legend

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