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.549 by root, Tue May 11 13:19:59 2010 UTC vs.
Revision 1.550 by root, Fri May 14 22:56:47 2010 UTC

… …
381 381
382=cut 382=cut
383 383
384sub post_init(&) { 384sub post_init(&) {
385 push @POST_INIT, shift; 385 push @POST_INIT, shift;
386}
387
388sub _post_init {
389 trace "running post_init jobs";
390
391 # run them in parallel...
392
393 my @join;
394
395 while () {
396 push @join, map &Coro::async ($_, 0), @POST_INIT;
397 @POST_INIT = ();
398
399 @join or last;
400
401 (pop @join)->join;
402 }
386} 403}
387 404
388=item cf::lock_wait $string 405=item cf::lock_wait $string
389 406
390Wait until the given lock is available. See cf::lock_acquire. 407Wait until the given lock is available. See cf::lock_acquire.
… …
3660 3677
3661 # no (long-running) fork's whatsoever before this point(!) 3678 # no (long-running) fork's whatsoever before this point(!)
3662 use POSIX (); 3679 use POSIX ();
3663 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD}; 3680 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD};
3664 3681
3665 (pop @POST_INIT)->(0) while @POST_INIT; 3682 cf::_post_init 0;
3666 }; 3683 };
3667 3684
3668 cf::object::thawer::errors_are_fatal 0; 3685 cf::object::thawer::errors_are_fatal 0;
3669 info "parse errors in files are no longer fatal from this point on.\n"; 3686 info "parse errors in files are no longer fatal from this point on.\n";
3670 3687
… …
3893 3910
3894 my $t1 = AE::time; 3911 my $t1 = AE::time;
3895 3912
3896 while ($RELOAD) { 3913 while ($RELOAD) {
3897 cf::get_slot 0.1, -1, "reload_perl"; 3914 cf::get_slot 0.1, -1, "reload_perl";
3898 info "reloading..."; 3915 info "perl_reload: reloading...";
3899 3916
3900 trace "entering sync_job"; 3917 trace "perl_reload: entering sync_job";
3901 3918
3902 cf::sync_job { 3919 cf::sync_job {
3903 #cf::emergency_save; 3920 #cf::emergency_save;
3904 3921
3905 trace "cancelling all extension coros"; 3922 trace "perl_reload: cancelling all extension coros";
3906 $_->cancel for values %EXT_CORO; 3923 $_->cancel for values %EXT_CORO;
3907 %EXT_CORO = (); 3924 %EXT_CORO = ();
3908 3925
3909 trace "removing commands"; 3926 trace "perl_reload: removing commands";
3910 %COMMAND = (); 3927 %COMMAND = ();
3911 3928
3912 trace "removing ext/exti commands"; 3929 trace "perl_reload: removing ext/exti commands";
3913 %EXTCMD = (); 3930 %EXTCMD = ();
3914 %EXTICMD = (); 3931 %EXTICMD = ();
3915 3932
3916 trace "unloading/nuking all extensions"; 3933 trace "perl_reload: unloading/nuking all extensions";
3917 for my $pkg (@EXTS) { 3934 for my $pkg (@EXTS) {
3918 trace "... unloading $pkg"; 3935 trace "... unloading $pkg";
3919 3936
3920 if (my $cb = $pkg->can ("unload")) { 3937 if (my $cb = $pkg->can ("unload")) {
3921 eval { 3938 eval {
… …
3926 3943
3927 trace "... clearing $pkg"; 3944 trace "... clearing $pkg";
3928 clear_package $pkg; 3945 clear_package $pkg;
3929 } 3946 }
3930 3947
3931 trace "unloading all perl modules loaded from $LIBDIR"; 3948 trace "perl_reload: unloading all perl modules loaded from $LIBDIR";
3932 while (my ($k, $v) = each %INC) { 3949 while (my ($k, $v) = each %INC) {
3933 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; 3950 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
3934 3951
3935 trace "... unloading $k"; 3952 trace "... unloading $k";
3936 delete $INC{$k}; 3953 delete $INC{$k};
… …
3943 } 3960 }
3944 3961
3945 clear_package $k; 3962 clear_package $k;
3946 } 3963 }
3947 3964
3948 trace "getting rid of safe::, as good as possible"; 3965 trace "perl_reload: getting rid of safe::, as good as possible";
3949 clear_package "safe::$_" 3966 clear_package "safe::$_"
3950 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region); 3967 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
3951 3968
3952 trace "unloading cf.pm \"a bit\""; 3969 trace "perl_reload: unloading cf.pm \"a bit\"";
3953 delete $INC{"cf.pm"}; 3970 delete $INC{"cf.pm"};
3954 delete $INC{"cf/$_.pm"} for @EXTRA_MODULES; 3971 delete $INC{"cf/$_.pm"} for @EXTRA_MODULES;
3955 3972
3956 # don't, removes xs symbols, too, 3973 # don't, removes xs symbols, too,
3957 # and global variables created in xs 3974 # and global variables created in xs
3958 #clear_package __PACKAGE__; 3975 #clear_package __PACKAGE__;
3959 3976
3960 info "unload completed, starting to reload now"; 3977 info "perl_reload: unload completed, starting to reload now";
3961 3978
3962 trace "reloading cf.pm"; 3979 trace "perl_reload: reloading cf.pm";
3963 require cf; 3980 require cf;
3964 cf::_connect_to_perl_1; 3981 cf::_connect_to_perl_1;
3965 3982
3966 trace "loading config and database again"; 3983 trace "perl_reload: loading config and database again";
3967 cf::reload_config; 3984 cf::reload_config;
3968 3985
3969 trace "loading extensions"; 3986 trace "perl_reload: loading extensions";
3970 cf::load_extensions; 3987 cf::load_extensions;
3971 3988
3972 if ($REATTACH_ON_RELOAD) { 3989 if ($REATTACH_ON_RELOAD) {
3973 trace "reattaching attachments to objects/players"; 3990 trace "perl_reload: reattaching attachments to objects/players";
3974 _global_reattach; # objects, sockets 3991 _global_reattach; # objects, sockets
3975 trace "reattaching attachments to maps"; 3992 trace "perl_reload: reattaching attachments to maps";
3976 reattach $_ for values %MAP; 3993 reattach $_ for values %MAP;
3977 trace "reattaching attachments to players"; 3994 trace "perl_reload: reattaching attachments to players";
3978 reattach $_ for values %PLAYER; 3995 reattach $_ for values %PLAYER;
3979 } 3996 }
3980 3997
3981 trace "running post_init jobs"; 3998 cf::_post_init 1;
3982 (pop @POST_INIT)->(1) while @POST_INIT;
3983 3999
3984 trace "leaving sync_job"; 4000 trace "perl_reload: leaving sync_job";
3985 4001
3986 1 4002 1
3987 } or do { 4003 } or do {
3988 error $@; 4004 error $@;
3989 cf::cleanup "error while reloading, exiting."; 4005 cf::cleanup "perl_reload: error, exiting.";
3990 }; 4006 };
3991 4007
3992 info "reloaded";
3993 --$RELOAD; 4008 --$RELOAD;
3994 } 4009 }
3995 4010
3996 $t1 = AE::time - $t1; 4011 $t1 = AE::time - $t1;
3997 info "reload completed in ${t1}s\n"; 4012 info "perl_reload: completed in ${t1}s\n";
3998}; 4013};
3999 4014
4000our $RELOAD_WATCHER; # used only during reload 4015our $RELOAD_WATCHER; # used only during reload
4001 4016
4002sub reload_perl() { 4017sub reload_perl() {

Diff Legend

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