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.540 by root, Tue May 4 23:32:29 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
… …
1849 1849
1850sub register { 1850sub register {
1851 my (undef, $regex, $prio) = @_; 1851 my (undef, $regex, $prio) = @_;
1852 my $pkg = caller; 1852 my $pkg = caller;
1853 1853
1854 no strict;
1855 push @{"$pkg\::ISA"}, __PACKAGE__; 1854 push @{"$pkg\::ISA"}, __PACKAGE__;
1856 1855
1857 $EXT_MAP{$pkg} = [$prio, qr<$regex>]; 1856 $EXT_MAP{$pkg} = [$prio, qr<$regex>];
1858} 1857}
1859 1858
… …
3274 decrease split destroy change_exp value msg lore send_msg)], 3273 decrease split destroy change_exp value msg lore send_msg)],
3275 ["cf::object::player" => qw(player)], 3274 ["cf::object::player" => qw(player)],
3276 ["cf::player" => qw(peaceful send_msg)], 3275 ["cf::player" => qw(peaceful send_msg)],
3277 ["cf::map" => qw(trigger)], 3276 ["cf::map" => qw(trigger)],
3278) { 3277) {
3279 no strict 'refs';
3280 my ($pkg, @funs) = @$_; 3278 my ($pkg, @funs) = @$_;
3281 *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"}) 3279 *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"})
3282 for @funs; 3280 for @funs;
3283} 3281}
3284 3282
… …
3360=cut 3358=cut
3361 3359
3362############################################################################# 3360#############################################################################
3363# the server's init and main functions 3361# the server's init and main functions
3364 3362
3363# async inc loader. yay.
3364sub inc_loader {
3365 my $mod = $_[1];
3366
3367 if (in_main && !tick_inhibit) {
3368 Carp::cluck "ERROR: attempted synchronous perl module load ($mod)";
3369 } else {
3370 debug "loading perl module $mod\n";
3371 }
3372
3373 # 1. find real file
3374 for my $dir (@ORIG_INC) {
3375 warn "$dir/$mod\n";#d#
3376 ref $dir and next;
3377 0 <= Coro::AIO::aio_load "$dir/$mod", my $data
3378 or next;
3379
3380 $data = "#line 1 $dir/$mod\n$data";
3381
3382 open my $fh, "<", \$data or die;
3383
3384 return $fh;
3385 }
3386
3387 ()
3388}
3389
3390sub init_inc {
3391 # save original @INC
3392 @ORIG_INC = ($LIBDIR, @INC) unless @ORIG_INC;
3393
3394 # make sure we can do scalar-opens
3395 open my $dummy, "<", \my $dummy2;
3396
3397 # execute some stuff so perl load's some of the core modules
3398 /Ü/ =~ /ü/i;
3399 eval { &Storable::nstore_fd };
3400
3401 @INC = (\&inc_loader, @ORIG_INC); # @ORIG_INC is needed for DynaLoader, AutoLoad etc.
3402
3403 debug "module loading will be asynchronous from this point on.";
3404}
3405
3365sub load_facedata($) { 3406sub load_facedata($) {
3366 my ($path) = @_; 3407 my ($path) = @_;
3367 3408
3368 # HACK to clear player env face cache, we need some signal framework 3409 # HACK to clear player env face cache, we need some signal framework
3369 # for this (global event?) 3410 # for this (global event?)
… …
3592 3633
3593sub main { 3634sub main {
3594 cf::init_globals; # initialise logging 3635 cf::init_globals; # initialise logging
3595 3636
3596 LOG llevInfo, "Welcome to Deliantra, v" . VERSION; 3637 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3597 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team."; 3638 LOG llevInfo, "Copyright (C) 2005-2010 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
3598 LOG llevInfo, "Copyright (C) 1994 Mark Wedel."; 3639 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3599 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen."; 3640 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3600 3641
3601 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3642 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3602 3643
… …
3610 }; 3651 };
3611 3652
3612 evthread_start IO::AIO::poll_fileno; 3653 evthread_start IO::AIO::poll_fileno;
3613 3654
3614 cf::sync_job { 3655 cf::sync_job {
3656 init_inc;
3657
3615 cf::init_experience; 3658 cf::init_experience;
3616 cf::init_anim; 3659 cf::init_anim;
3617 cf::init_attackmess; 3660 cf::init_attackmess;
3618 cf::init_dynamic; 3661 cf::init_dynamic;
3619 3662
… …
3644 }; 3687 };
3645 3688
3646 cf::object::thawer::errors_are_fatal 0; 3689 cf::object::thawer::errors_are_fatal 0;
3647 info "parse errors in files are no longer fatal from this point on.\n"; 3690 info "parse errors in files are no longer fatal from this point on.\n";
3648 3691
3692 my $free_main; $free_main = EV::idle sub {
3693 undef $free_main;
3694 undef &main; # free gobs of memory :)
3695 };
3696
3649 main_loop; 3697 goto &main_loop;
3650} 3698}
3651 3699
3652############################################################################# 3700#############################################################################
3653# initialisation and cleanup 3701# initialisation and cleanup
3654 3702
… …
3995 reload_perl; 4043 reload_perl;
3996 }; 4044 };
3997 } 4045 }
3998}; 4046};
3999 4047
4000unshift @INC, $LIBDIR; 4048#############################################################################
4001 4049
4002my $bug_warning = 0; 4050my $bug_warning = 0;
4003 4051
4004our @WAIT_FOR_TICK; 4052our @WAIT_FOR_TICK;
4005our @WAIT_FOR_TICK_BEGIN; 4053our @WAIT_FOR_TICK_BEGIN;

Diff Legend

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