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.446 by root, Tue Sep 16 16:03:02 2008 UTC vs.
Revision 1.453 by root, Tue Sep 23 04:29:11 2008 UTC

… …
63 63
64# configure various modules to our taste 64# configure various modules to our taste
65# 65#
66$Storable::canonical = 1; # reduce rsync transfers 66$Storable::canonical = 1; # reduce rsync transfers
67Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator 67Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator
68
69$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
70
71# make sure c-lzf reinitialises itself
72Compress::LZF::set_serializer "Storable", "Storable::net_mstore", "Storable::mretrieve";
68Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later 73Compress::LZF::sfreeze_cr { }; # prime Compress::LZF so it does not use require later
69
70$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
71 74
72sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 75sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
73 76
74our %COMMAND = (); 77our %COMMAND = ();
75our %COMMAND_TIME = (); 78our %COMMAND_TIME = ();
… …
78our %EXTCMD = (); 81our %EXTCMD = ();
79our %EXTICMD = (); 82our %EXTICMD = ();
80our %EXT_CORO = (); # coroutines bound to extensions 83our %EXT_CORO = (); # coroutines bound to extensions
81our %EXT_MAP = (); # pluggable maps 84our %EXT_MAP = (); # pluggable maps
82 85
83our $RELOAD; # number of reloads so far 86our $RELOAD; # number of reloads so far, non-zero while in reload
84our @EVENT; 87our @EVENT;
85 88
86our $CONFDIR = confdir; 89our $CONFDIR = confdir;
87our $DATADIR = datadir; 90our $DATADIR = datadir;
88our $LIBDIR = "$DATADIR/ext"; 91our $LIBDIR = "$DATADIR/ext";
… …
125our $LOAD; # a number between 0 (idle) and 1 (too many objects) 128our $LOAD; # a number between 0 (idle) and 1 (too many objects)
126our $LOADAVG; # same thing, but with alpha-smoothing 129our $LOADAVG; # same thing, but with alpha-smoothing
127our $JITTER; # average jitter 130our $JITTER; # average jitter
128our $TICK_START; # for load detecting purposes 131our $TICK_START; # for load detecting purposes
129 132
133our @POST_INIT;
134
130binmode STDOUT; 135binmode STDOUT;
131binmode STDERR; 136binmode STDERR;
132 137
133# read virtual server time, if available 138# read virtual server time, if available
134unless ($RUNTIME || !-e $RUNTIMEFILE) { 139unless ($RUNTIME || !-e $RUNTIMEFILE) {
… …
302our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max 307our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max
303 308
304sub encode_json($) { $json_coder->encode ($_[0]) } 309sub encode_json($) { $json_coder->encode ($_[0]) }
305sub decode_json($) { $json_coder->decode ($_[0]) } 310sub decode_json($) { $json_coder->decode ($_[0]) }
306 311
312=item cf::post_init { BLOCK }
313
314Execute the given codeblock, I<after> all extensions have been (re-)loaded,
315but I<before> the server starts ticking again.
316
317The cdoeblock will have a single boolean argument to indicate whether this
318is a reload or not.
319
320=cut
321
322sub post_init(&) {
323 push @POST_INIT, shift;
324}
325
307=item cf::lock_wait $string 326=item cf::lock_wait $string
308 327
309Wait until the given lock is available. See cf::lock_acquire. 328Wait until the given lock is available. See cf::lock_acquire.
310 329
311=item my $lock = cf::lock_acquire $string 330=item my $lock = cf::lock_acquire $string
… …
338 return;#d# 357 return;#d#
339 }#d# 358 }#d#
340 359
341 # wait for lock, if any 360 # wait for lock, if any
342 while ($LOCK{$key}) { 361 while ($LOCK{$key}) {
362 #local $Coro::current->{desc} = "$Coro::current->{desc} <waiting for lock $key>";
343 push @{ $LOCK{$key} }, $Coro::current; 363 push @{ $LOCK{$key} }, $Coro::current;
344 Coro::schedule; 364 Coro::schedule;
345 } 365 }
346} 366}
347 367
… …
730 750
731############################################################################# 751#############################################################################
732 752
733=head2 ATTACHABLE OBJECTS 753=head2 ATTACHABLE OBJECTS
734 754
735Many objects in crossfire are so-called attachable objects. That means you can 755Many objects in deliantra are so-called attachable objects. That means you can
736attach callbacks/event handlers (a collection of which is called an "attachment") 756attach callbacks/event handlers (a collection of which is called an "attachment")
737to it. All such attachable objects support the following methods. 757to it. All such attachable objects support the following methods.
738 758
739In the following description, CLASS can be any of C<global>, C<object> 759In the following description, CLASS can be any of C<global>, C<object>
740C<player>, C<client> or C<map> (i.e. the attachable objects in 760C<player>, C<client> or C<map> (i.e. the attachable objects in
… …
790=item cf::CLASS::attachment $name, ... 810=item cf::CLASS::attachment $name, ...
791 811
792Register an attachment by C<$name> through which attachable objects of the 812Register an attachment by C<$name> through which attachable objects of the
793given CLASS can refer to this attachment. 813given CLASS can refer to this attachment.
794 814
795Some classes such as crossfire maps and objects can specify attachments 815Some classes such as deliantra maps and objects can specify attachments
796that are attached at load/instantiate time, thus the need for a name. 816that are attached at load/instantiate time, thus the need for a name.
797 817
798These calls expect any number of the following handler/hook descriptions: 818These calls expect any number of the following handler/hook descriptions:
799 819
800=over 4 820=over 4
… …
1388 1408
1389=back 1409=back
1390 1410
1391=head2 CORE EXTENSIONS 1411=head2 CORE EXTENSIONS
1392 1412
1393Functions and methods that extend core crossfire objects. 1413Functions and methods that extend core deliantra objects.
1394 1414
1395=cut 1415=cut
1396 1416
1397package cf::player; 1417package cf::player;
1398 1418
… …
1441 1461
1442sub exists($) { 1462sub exists($) {
1443 my ($login) = @_; 1463 my ($login) = @_;
1444 1464
1445 $cf::PLAYER{$login} 1465 $cf::PLAYER{$login}
1446 or cf::sync_job { !aio_stat path $login } 1466 or !aio_stat path $login
1447} 1467}
1448 1468
1449sub find($) { 1469sub find($) {
1450 return $cf::PLAYER{$_[0]} || do { 1470 return $cf::PLAYER{$_[0]} || do {
1451 my $login = $_[0]; 1471 my $login = $_[0];
… …
1622 } 1642 }
1623 1643
1624 \@paths 1644 \@paths
1625} 1645}
1626 1646
1627=item $protocol_xml = $player->expand_cfpod ($crossfire_pod) 1647=item $protocol_xml = $player->expand_cfpod ($cfpod)
1628 1648
1629Expand crossfire pod fragments into protocol xml. 1649Expand deliantra pod fragments into protocol xml.
1630 1650
1631=item $player->ext_reply ($msgid, @msg) 1651=item $player->ext_reply ($msgid, @msg)
1632 1652
1633Sends an ext reply to the player. 1653Sends an ext reply to the player.
1634 1654
… …
2692 $self->contr->savebed ($map, $x, $y) 2712 $self->contr->savebed ($map, $x, $y)
2693 if $exit->flag (cf::FLAG_DAMNED); 2713 if $exit->flag (cf::FLAG_DAMNED);
2694 2714
2695 1 2715 1
2696 }) { 2716 }) {
2697 $self->message ("Something went wrong deep within the crossfire server. " 2717 $self->message ("Something went wrong deep within the deliantra server. "
2698 . "I'll try to bring you back to the map you were before. " 2718 . "I'll try to bring you back to the map you were before. "
2699 . "Please report this to the dungeon master!", 2719 . "Please report this to the dungeon master!",
2700 cf::NDI_UNIQUE | cf::NDI_RED); 2720 cf::NDI_UNIQUE | cf::NDI_RED);
2701 2721
2702 warn "ERROR in enter_exit: $@"; 2722 warn "ERROR in enter_exit: $@";
… …
2768 id => "infobox", 2788 id => "infobox",
2769 title => "Body Parts", 2789 title => "Body Parts",
2770 reply => undef, 2790 reply => undef,
2771 tooltip => "Shows which body parts you posess and are available", 2791 tooltip => "Shows which body parts you posess and are available",
2772 }, 2792 },
2793 "c/skills" => {
2794 id => "infobox",
2795 title => "Skills",
2796 reply => undef,
2797 tooltip => "Shows your experience per skill and item power",
2798 },
2773 "c/uptime" => { 2799 "c/uptime" => {
2774 id => "infobox", 2800 id => "infobox",
2775 title => "Uptime", 2801 title => "Uptime",
2776 reply => undef, 2802 reply => undef,
2777 tooltip => "How long the server has been running since last restart", 2803 tooltip => "How long the server has been running since last restart",
… …
2791); 2817);
2792 2818
2793sub cf::client::send_msg { 2819sub cf::client::send_msg {
2794 my ($self, $channel, $msg, $color, @extra) = @_; 2820 my ($self, $channel, $msg, $color, @extra) = @_;
2795 2821
2796 $msg = $self->pl->expand_cfpod ($msg); 2822 $msg = $self->pl->expand_cfpod ($msg)
2823 unless $color & cf::NDI_VERBATIM;
2797 2824
2798 $color &= cf::NDI_CLIENT_MASK; # just in case... 2825 $color &= cf::NDI_CLIENT_MASK; # just in case...
2799 2826
2800 # check predefined channels, for the benefit of C 2827 # check predefined channels, for the benefit of C
2801 if ($CHANNEL{$channel}) { 2828 if ($CHANNEL{$channel}) {
… …
3330 reload_treasures; 3357 reload_treasures;
3331 3358
3332 warn "finished reloading resource files\n"; 3359 warn "finished reloading resource files\n";
3333} 3360}
3334 3361
3335sub init {
3336 my $guard = freeze_mainloop;
3337
3338 evthread_start IO::AIO::poll_fileno;
3339
3340 reload_resources;
3341}
3342
3343sub reload_config { 3362sub reload_config {
3344 open my $fh, "<:utf8", "$CONFDIR/config" 3363 open my $fh, "<:utf8", "$CONFDIR/config"
3345 or return; 3364 or return;
3346 3365
3347 local $/; 3366 local $/;
… …
3379 seek $fh, 0, 0; 3398 seek $fh, 0, 0;
3380 print $fh $$; 3399 print $fh $$;
3381} 3400}
3382 3401
3383sub main { 3402sub main {
3384 atomic; 3403 cf::init_globals; # initialise logging
3404
3405 LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
3406 LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
3407 LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
3408 LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
3409
3410 cf::init_experience;
3411 cf::init_anim;
3412 cf::init_attackmess;
3413 cf::init_dynamic;
3414 cf::init_block;
3415
3416 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3385 3417
3386 # we must not ever block the main coroutine 3418 # we must not ever block the main coroutine
3387 local $Coro::idle = sub { 3419 local $Coro::idle = sub {
3388 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 3420 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
3389 (async { 3421 (async {
3390 $Coro::current->{desc} = "IDLE BUG HANDLER"; 3422 $Coro::current->{desc} = "IDLE BUG HANDLER";
3391 EV::loop EV::LOOP_ONESHOT; 3423 EV::loop EV::LOOP_ONESHOT;
3392 })->prio (Coro::PRIO_MAX); 3424 })->prio (Coro::PRIO_MAX);
3393 }; 3425 };
3394 3426
3395 { 3427 evthread_start IO::AIO::poll_fileno;
3396 my $guard = freeze_mainloop; 3428
3429 cf::sync_job {
3430 reload_resources;
3397 reload_config; 3431 reload_config;
3398 db_init; 3432 db_init;
3433
3434 cf::load_settings;
3435 cf::load_materials;
3436 cf::init_uuid;
3437 cf::init_signals;
3438 cf::init_commands;
3439 cf::init_skills;
3440
3441 cf::init_beforeplay;
3442
3443 atomic;
3444
3399 load_extensions; 3445 load_extensions;
3400 3446
3401 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3402 }
3403
3404 utime time, time, $RUNTIMEFILE; 3447 utime time, time, $RUNTIMEFILE;
3405 3448
3406 # no (long-running) fork's whatsoever before this point(!) 3449 # no (long-running) fork's whatsoever before this point(!)
3407 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD}; 3450 POSIX::close delete $ENV{LOCKUTIL_LOCK_FD} if exists $ENV{LOCKUTIL_LOCK_FD};
3451
3452 (pop @POST_INIT)->(0) while @POST_INIT;
3453 };
3408 3454
3409 EV::loop; 3455 EV::loop;
3410} 3456}
3411 3457
3412############################################################################# 3458#############################################################################
… …
3570 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH}; 3616 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
3571 for my $name (keys %$leaf_symtab) { 3617 for my $name (keys %$leaf_symtab) {
3572 _gv_clear *{"$pkg$name"}; 3618 _gv_clear *{"$pkg$name"};
3573# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"}; 3619# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"};
3574 } 3620 }
3575 warn "cleared package #$pkg\n";#d# 3621 warn "cleared package $pkg\n";#d#
3576} 3622}
3577
3578our $RELOAD; # how many times to reload
3579 3623
3580sub do_reload_perl() { 3624sub do_reload_perl() {
3581 # can/must only be called in main 3625 # can/must only be called in main
3582 if ($Coro::current != $Coro::main) { 3626 if ($Coro::current != $Coro::main) {
3583 warn "can only reload from main coroutine"; 3627 warn "can only reload from main coroutine";
… …
3678 warn "reattaching attachments to maps"; 3722 warn "reattaching attachments to maps";
3679 reattach $_ for values %MAP; 3723 reattach $_ for values %MAP;
3680 warn "reattaching attachments to players"; 3724 warn "reattaching attachments to players";
3681 reattach $_ for values %PLAYER; 3725 reattach $_ for values %PLAYER;
3682 3726
3727 warn "running post_load";
3728 (pop @POST_INIT)->(1) while @POST_INIT;
3729
3683 warn "leaving sync_job"; 3730 warn "leaving sync_job";
3684 3731
3685 1 3732 1
3686 } or do { 3733 } or do {
3687 warn $@; 3734 warn $@;
… …
3697 3744
3698sub reload_perl() { 3745sub reload_perl() {
3699 # doing reload synchronously and two reloads happen back-to-back, 3746 # doing reload synchronously and two reloads happen back-to-back,
3700 # coro crashes during coro_state_free->destroy here. 3747 # coro crashes during coro_state_free->destroy here.
3701 3748
3702 $RELOAD_WATCHER ||= EV::timer 0, 0, sub { 3749 $RELOAD_WATCHER ||= EV::timer $TICK * 1.5, 0, sub {
3703 do_reload_perl; 3750 do_reload_perl;
3704 undef $RELOAD_WATCHER; 3751 undef $RELOAD_WATCHER;
3705 }; 3752 };
3706} 3753}
3707 3754

Diff Legend

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