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.538 by root, Tue May 4 21:45:43 2010 UTC vs.
Revision 1.542 by root, Wed May 5 09:05:03 2010 UTC

… …
20# The authors can be reached via e-mail to <support@deliantra.net> 20# The authors can be reached via e-mail to <support@deliantra.net>
21# 21#
22 22
23package cf; 23package cf;
24 24
25use 5.10.0; 25use common::sense;
26use utf8;
27use strict qw(vars subs);
28 26
29use Symbol; 27use Symbol;
30use List::Util; 28use List::Util;
31use Socket; 29use Socket;
32use EV; 30use EV;
… …
77 75
78# strictly for debugging 76# strictly for debugging
79$SIG{QUIT} = sub { Carp::cluck "SIGQUIT" }; 77$SIG{QUIT} = sub { Carp::cluck "SIGQUIT" };
80 78
81sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 79sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
80
81our @ORIG_INC;
82 82
83our %COMMAND = (); 83our %COMMAND = ();
84our %COMMAND_TIME = (); 84our %COMMAND_TIME = ();
85 85
86our @EXTS = (); # list of extension package names 86our @EXTS = (); # list of extension package names
… …
1451 1451
1452 my $active = eval $v->{source}; 1452 my $active = eval $v->{source};
1453 1453
1454 if (length $@) { 1454 if (length $@) {
1455 error "$v->{path}: $@\n"; 1455 error "$v->{path}: $@\n";
1456 undef $@; # work around perl 5.10.0 utf-8 caching bug
1457 1456
1458 cf::cleanup "mandatory extension '$k' failed to load, exiting." 1457 cf::cleanup "mandatory extension '$k' failed to load, exiting."
1459 if exists $v->{meta}{mandatory}; 1458 if exists $v->{meta}{mandatory};
1460 1459
1461 warn "$v->{base}: optional extension cannot be loaded, skipping.\n"; 1460 warn "$v->{base}: optional extension cannot be loaded, skipping.\n";
… …
1849 1848
1850sub register { 1849sub register {
1851 my (undef, $regex, $prio) = @_; 1850 my (undef, $regex, $prio) = @_;
1852 my $pkg = caller; 1851 my $pkg = caller;
1853 1852
1854 no strict;
1855 push @{"$pkg\::ISA"}, __PACKAGE__; 1853 push @{"$pkg\::ISA"}, __PACKAGE__;
1856 1854
1857 $EXT_MAP{$pkg} = [$prio, qr<$regex>]; 1855 $EXT_MAP{$pkg} = [$prio, qr<$regex>];
1858} 1856}
1859 1857
… …
3274 decrease split destroy change_exp value msg lore send_msg)], 3272 decrease split destroy change_exp value msg lore send_msg)],
3275 ["cf::object::player" => qw(player)], 3273 ["cf::object::player" => qw(player)],
3276 ["cf::player" => qw(peaceful send_msg)], 3274 ["cf::player" => qw(peaceful send_msg)],
3277 ["cf::map" => qw(trigger)], 3275 ["cf::map" => qw(trigger)],
3278) { 3276) {
3279 no strict 'refs';
3280 my ($pkg, @funs) = @$_; 3277 my ($pkg, @funs) = @$_;
3281 *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"}) 3278 *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"})
3282 for @funs; 3279 for @funs;
3283} 3280}
3284 3281
… …
3360=cut 3357=cut
3361 3358
3362############################################################################# 3359#############################################################################
3363# the server's init and main functions 3360# the server's init and main functions
3364 3361
3362# async inc loader. yay.
3363sub inc_loader {
3364 my $mod = $_[1];
3365
3366 if (in_main && !tick_inhibit) {
3367 Carp::cluck "ERROR: attempted synchronous perl module load ($mod)";
3368 } else {
3369 debug "loading perl module $mod\n";
3370 }
3371
3372 # 1. find real file
3373 for my $dir (@ORIG_INC) {
3374 ref $dir and next;
3375 0 <= Coro::AIO::aio_load "$dir/$mod", my $data
3376 or next;
3377
3378 $data = "#line 1 $dir/$mod\n$data";
3379
3380 open my $fh, "<", \$data or die;
3381
3382 return $fh;
3383 }
3384
3385 ()
3386}
3387
3388sub init_inc {
3389 # save original @INC
3390 @ORIG_INC = ($LIBDIR, @INC) unless @ORIG_INC;
3391
3392 # make sure we can do scalar-opens
3393 open my $dummy, "<", \my $dummy2;
3394
3395 # execute some stuff so perl load's some of the core modules
3396 /Ü/ =~ /ü/i;
3397 eval { &Storable::nstore_fd };
3398
3399 @INC = (\&inc_loader, @ORIG_INC); # @ORIG_INC is needed for DynaLoader, AutoLoad etc.
3400
3401 debug "module loading will be asynchronous from this point on.";
3402}
3403
3365sub load_facedata($) { 3404sub load_facedata($) {
3366 my ($path) = @_; 3405 my ($path) = @_;
3367 3406
3368 # HACK to clear player env face cache, we need some signal framework 3407 # HACK to clear player env face cache, we need some signal framework
3369 # for this (global event?) 3408 # for this (global event?)
… …
3592 3631
3593sub main { 3632sub main {
3594 cf::init_globals; # initialise logging 3633 cf::init_globals; # initialise logging
3595 3634
3596 LOG llevInfo, "Welcome to Deliantra, v" . VERSION; 3635 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3597 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team."; 3636 LOG llevInfo, "Copyright (C) 2005-2010 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
3598 LOG llevInfo, "Copyright (C) 1994 Mark Wedel."; 3637 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3599 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen."; 3638 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3600 3639
3601 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3640 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3602 3641
… …
3610 }; 3649 };
3611 3650
3612 evthread_start IO::AIO::poll_fileno; 3651 evthread_start IO::AIO::poll_fileno;
3613 3652
3614 cf::sync_job { 3653 cf::sync_job {
3654 init_inc;
3655
3615 cf::init_experience; 3656 cf::init_experience;
3616 cf::init_anim; 3657 cf::init_anim;
3617 cf::init_attackmess; 3658 cf::init_attackmess;
3618 cf::init_dynamic; 3659 cf::init_dynamic;
3619 3660
… …
3644 }; 3685 };
3645 3686
3646 cf::object::thawer::errors_are_fatal 0; 3687 cf::object::thawer::errors_are_fatal 0;
3647 info "parse errors in files are no longer fatal from this point on.\n"; 3688 info "parse errors in files are no longer fatal from this point on.\n";
3648 3689
3690 my $free_main; $free_main = EV::idle sub {
3691 undef $free_main;
3692 undef &main; # free gobs of memory :)
3693 };
3694
3649 main_loop; 3695 goto &main_loop;
3650} 3696}
3651 3697
3652############################################################################# 3698#############################################################################
3653# initialisation and cleanup 3699# initialisation and cleanup
3654 3700
… …
3995 reload_perl; 4041 reload_perl;
3996 }; 4042 };
3997 } 4043 }
3998}; 4044};
3999 4045
4000unshift @INC, $LIBDIR; 4046#############################################################################
4001 4047
4002my $bug_warning = 0; 4048my $bug_warning = 0;
4003 4049
4004our @WAIT_FOR_TICK; 4050our @WAIT_FOR_TICK;
4005our @WAIT_FOR_TICK_BEGIN; 4051our @WAIT_FOR_TICK_BEGIN;

Diff Legend

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