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.539 by root, Tue May 4 22:49:21 2010 UTC vs.
Revision 1.543 by root, Wed May 5 23:23:29 2010 UTC

… …
76# strictly for debugging 76# strictly for debugging
77$SIG{QUIT} = sub { Carp::cluck "SIGQUIT" }; 77$SIG{QUIT} = sub { Carp::cluck "SIGQUIT" };
78 78
79sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 79sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
80 80
81our @ORIG_INC;
82
81our %COMMAND = (); 83our %COMMAND = ();
82our %COMMAND_TIME = (); 84our %COMMAND_TIME = ();
83 85
84our @EXTS = (); # list of extension package names 86our @EXTS = (); # list of extension package names
85our %EXTCMD = (); 87our %EXTCMD = ();
… …
122our $BDB_DEADLOCK_WATCHER; 124our $BDB_DEADLOCK_WATCHER;
123our $BDB_CHECKPOINT_WATCHER; 125our $BDB_CHECKPOINT_WATCHER;
124our $BDB_TRICKLE_WATCHER; 126our $BDB_TRICKLE_WATCHER;
125our $DB_ENV; 127our $DB_ENV;
126 128
127our @EXTRA_MODULES = qw(pod match mapscript); 129our @EXTRA_MODULES = qw(pod match mapscript incloader);
128 130
129our %CFG; 131our %CFG;
130 132
131our $UPTIME; $UPTIME ||= time; 133our $UPTIME; $UPTIME ||= time;
132our $RUNTIME; 134our $RUNTIME;
… …
1449 1451
1450 my $active = eval $v->{source}; 1452 my $active = eval $v->{source};
1451 1453
1452 if (length $@) { 1454 if (length $@) {
1453 error "$v->{path}: $@\n"; 1455 error "$v->{path}: $@\n";
1454 undef $@; # work around perl 5.10.0 utf-8 caching bug
1455 1456
1456 cf::cleanup "mandatory extension '$k' failed to load, exiting." 1457 cf::cleanup "mandatory extension '$k' failed to load, exiting."
1457 if exists $v->{meta}{mandatory}; 1458 if exists $v->{meta}{mandatory};
1458 1459
1459 warn "$v->{base}: optional extension cannot be loaded, skipping.\n"; 1460 warn "$v->{base}: optional extension cannot be loaded, skipping.\n";
… …
1868} 1869}
1869 1870
1870sub normalise { 1871sub normalise {
1871 my ($path, $base) = @_; 1872 my ($path, $base) = @_;
1872 1873
1873 $path = "$path"; # make sure its a string 1874 $path = "$path"; # make sure it's a string
1874 1875
1875 $path =~ s/\.map$//; 1876 $path =~ s/\.map$//;
1876 1877
1877 # map plan: 1878 # map plan:
1878 # 1879 #
… …
1917 $self->init; # pass $1 etc. 1918 $self->init; # pass $1 etc.
1918 return $self; 1919 return $self;
1919 } 1920 }
1920 } 1921 }
1921 1922
1922 Carp::cluck "unable to resolve path '$path' (base '$base')."; 1923 Carp::cluck "unable to resolve path '$path' (base '$base')";
1923 () 1924 ()
1924} 1925}
1925 1926
1926sub init { 1927sub init {
1927 my ($self) = @_; 1928 my ($self) = @_;
… …
2049} 2050}
2050 2051
2051sub find; 2052sub find;
2052sub find { 2053sub find {
2053 my ($path, $origin) = @_; 2054 my ($path, $origin) = @_;
2055
2056 cf::cede_to_tick;
2054 2057
2055 $path = normalise $path, $origin && $origin->path; 2058 $path = normalise $path, $origin && $origin->path;
2056 2059
2057 my $guard1 = cf::lock_acquire "map_data:$path";#d#remove 2060 my $guard1 = cf::lock_acquire "map_data:$path";#d#remove
2058 my $guard2 = cf::lock_acquire "map_find:$path"; 2061 my $guard2 = cf::lock_acquire "map_find:$path";
… …
3588 3591
3589sub main { 3592sub main {
3590 cf::init_globals; # initialise logging 3593 cf::init_globals; # initialise logging
3591 3594
3592 LOG llevInfo, "Welcome to Deliantra, v" . VERSION; 3595 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3593 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team."; 3596 LOG llevInfo, "Copyright (C) 2005-2010 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
3594 LOG llevInfo, "Copyright (C) 1994 Mark Wedel."; 3597 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3595 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen."; 3598 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3596 3599
3597 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3600 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3598 3601
… …
3606 }; 3609 };
3607 3610
3608 evthread_start IO::AIO::poll_fileno; 3611 evthread_start IO::AIO::poll_fileno;
3609 3612
3610 cf::sync_job { 3613 cf::sync_job {
3614 cf::incloader::init ();
3615
3611 cf::init_experience; 3616 cf::init_experience;
3612 cf::init_anim; 3617 cf::init_anim;
3613 cf::init_attackmess; 3618 cf::init_attackmess;
3614 cf::init_dynamic; 3619 cf::init_dynamic;
3615 3620
… …
3640 }; 3645 };
3641 3646
3642 cf::object::thawer::errors_are_fatal 0; 3647 cf::object::thawer::errors_are_fatal 0;
3643 info "parse errors in files are no longer fatal from this point on.\n"; 3648 info "parse errors in files are no longer fatal from this point on.\n";
3644 3649
3650 my $free_main; $free_main = EV::idle sub {
3651 undef $free_main;
3652 undef &main; # free gobs of memory :)
3653 };
3654
3645 main_loop; 3655 goto &main_loop;
3646} 3656}
3647 3657
3648############################################################################# 3658#############################################################################
3649# initialisation and cleanup 3659# initialisation and cleanup
3650 3660
… …
3851 } 3861 }
3852} 3862}
3853 3863
3854sub do_reload_perl() { 3864sub do_reload_perl() {
3855 # can/must only be called in main 3865 # can/must only be called in main
3856 if (in_main) { 3866 unless (in_main) {
3857 error "can only reload from main coroutine"; 3867 error "can only reload from main coroutine";
3858 return; 3868 return;
3859 } 3869 }
3860 3870
3861 return if $RELOAD++; 3871 return if $RELOAD++;
3862 3872
3863 my $t1 = AE::time; 3873 my $t1 = AE::time;
3864 3874
3865 while ($RELOAD) { 3875 while ($RELOAD) {
3876 cf::get_slot 0.1, -1, "reload_perl";
3866 info "reloading..."; 3877 info "reloading...";
3867 3878
3868 trace "entering sync_job"; 3879 trace "entering sync_job";
3869 3880
3870 cf::sync_job { 3881 cf::sync_job {
3871 cf::emergency_save; 3882 #cf::emergency_save;
3872 3883
3873 trace "cancelling all extension coros"; 3884 trace "cancelling all extension coros";
3874 $_->cancel for values %EXT_CORO; 3885 $_->cancel for values %EXT_CORO;
3875 %EXT_CORO = (); 3886 %EXT_CORO = ();
3876 3887
… …
3991 reload_perl; 4002 reload_perl;
3992 }; 4003 };
3993 } 4004 }
3994}; 4005};
3995 4006
3996unshift @INC, $LIBDIR; 4007#############################################################################
3997 4008
3998my $bug_warning = 0; 4009my $bug_warning = 0;
3999 4010
4000our @WAIT_FOR_TICK; 4011our @WAIT_FOR_TICK;
4001our @WAIT_FOR_TICK_BEGIN; 4012our @WAIT_FOR_TICK_BEGIN;

Diff Legend

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