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.239 by root, Mon Apr 16 06:23:42 2007 UTC vs.
Revision 1.249 by root, Wed Apr 18 12:43:54 2007 UTC

… …
9use Event; 9use Event;
10use Opcode; 10use Opcode;
11use Safe; 11use Safe;
12use Safe::Hole; 12use Safe::Hole;
13 13
14use Coro 3.52 (); 14use Coro 3.61 ();
15use Coro::State; 15use Coro::State;
16use Coro::Event; 16use Coro::Event;
17use Coro::Timer; 17use Coro::Timer;
18use Coro::Signal; 18use Coro::Signal;
19use Coro::Semaphore; 19use Coro::Semaphore;
… …
54 54
55our $RELOAD; # number of reloads so far 55our $RELOAD; # number of reloads so far
56our @EVENT; 56our @EVENT;
57our $LIBDIR = datadir . "/ext"; 57our $LIBDIR = datadir . "/ext";
58 58
59our $TICK = MAX_TIME * 1e-6; 59our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
60our $TICK_WATCHER; 60our $TICK_WATCHER;
61our $AIO_POLL_WATCHER; 61our $AIO_POLL_WATCHER;
62our $NEXT_RUNTIME_WRITE; # when should the runtime file be written 62our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
63our $NEXT_TICK; 63our $NEXT_TICK;
64our $NOW; 64our $NOW;
… …
2329sub db_put($$$) { 2329sub db_put($$$) {
2330 BDB::dbreq_pri 4; 2330 BDB::dbreq_pri 4;
2331 BDB::db_put $DB, undef, "$_[0]/$_[1]", Compress::LZF::sfreeze_cr $_[2], 0, sub { }; 2331 BDB::db_put $DB, undef, "$_[0]/$_[1]", Compress::LZF::sfreeze_cr $_[2], 0, sub { };
2332} 2332}
2333 2333
2334=item cf::cache $id => ...
2335
2336Generic caching function that returns the value of the resource $id,
2337caching and regenerating as required.
2338
2339This function can block.
2340
2341 source => filename returning the data (must be a scalar)
2342 expensive => true == try to cache harder
2343 filter => sub that processes the data into a scalar
2344
2345=cut
2346
2347sub cache {
2348 my ($id, %arg) = @_;
2349
2350 aio_stat $arg{source}
2351 and Carp::croak "$arg{source}: $!";
2352
2353 my $meta = join ":", (stat _)[7,9];
2354 my $md5;
2355
2356 if ($arg{expensive}) {
2357 0 <= aio_load $arg{source}, my $buf
2358 or Carp::croak "$arg{source}: $!";
2359
2360 $md5 = Digest::MD5::md5_hex $buf;
2361 }
2362
2363 my $dbmeta = db_get "$id/meta";
2364 if ($dbmeta ne $meta) {
2365 # changed, we need to process
2366 } else {
2367 # just fetch
2368 }
2369
2370
2371}
2372
2334############################################################################# 2373#############################################################################
2335# the server's init and main functions 2374# the server's init and main functions
2336 2375
2337sub load_facedata { 2376sub load_facedata($) {
2338 my $path = sprintf "%s/facedata", cf::datadir; 2377 my ($path) = @_;
2339 2378
2340 warn "loading facedata from $path\n"; 2379 warn "loading facedata from $path\n";
2341 2380
2342 my $facedata; 2381 my $facedata;
2343 0 < aio_load $path, $facedata 2382 0 < aio_load $path, $facedata
… …
2384 } 2423 }
2385 2424
2386 1 2425 1
2387} 2426}
2388 2427
2428sub reload_facedata {
2429 load_facedata sprintf "%s/facedata", cf::datadir
2430 or die "unable to load facedata\n";
2431}
2432
2433sub reload_regions {
2434 load_resource_file sprintf "%s/%s/regions", cf::datadir, cf::mapdir
2435 or die "unable to load regions file\n";
2436}
2437
2438sub reload_archetypes {
2439 load_resource_file sprintf "%s/archetypes", cf::datadir
2440 or die "unable to load archetypes\n";
2441}
2442
2443sub reload_treasures {
2444 load_resource_file sprintf "%s/treasures", cf::datadir
2445 or die "unable to load treasurelists\n";
2446}
2447
2389sub reload_resources { 2448sub reload_resources {
2390 load_resource_file sprintf "%s/%s/regions", cf::datadir, cf::mapdir 2449 warn "reloading resource files...\n";
2391 or die "unable to load regions file\n";#d# 2450
2451 reload_regions;
2392 load_facedata 2452 reload_facedata;
2393 or die "unable to load facedata\n";#d# 2453 reload_archetypes;
2454 reload_treasures;
2455
2456 warn "finished reloading resource files\n";
2394} 2457}
2395 2458
2396sub init { 2459sub init {
2397 reload_resources; 2460 reload_resources;
2398} 2461}
… …
2491 2554
2492 warn Carp::longmess "post_cleanup backtrace" 2555 warn Carp::longmess "post_cleanup backtrace"
2493 if $make_core; 2556 if $make_core;
2494} 2557}
2495 2558
2496sub reload() { 2559sub do_reload_perl() {
2497 # can/must only be called in main 2560 # can/must only be called in main
2498 if ($Coro::current != $Coro::main) { 2561 if ($Coro::current != $Coro::main) {
2499 warn "can only reload from main coroutine"; 2562 warn "can only reload from main coroutine";
2500 return; 2563 return;
2501 } 2564 }
… …
2600 warn "reattaching attachments to maps"; 2663 warn "reattaching attachments to maps";
2601 reattach $_ for values %MAP; 2664 reattach $_ for values %MAP;
2602 warn "reattaching attachments to players"; 2665 warn "reattaching attachments to players";
2603 reattach $_ for values %PLAYER; 2666 reattach $_ for values %PLAYER;
2604 2667
2605 warn "loading reloadable resources";
2606 reload_resources;
2607
2608 warn "leaving sync_job"; 2668 warn "leaving sync_job";
2609 2669
2610 1 2670 1
2611 } or do { 2671 } or do {
2612 warn $@; 2672 warn $@;
… …
2617 warn "reloaded"; 2677 warn "reloaded";
2618}; 2678};
2619 2679
2620our $RELOAD_WATCHER; # used only during reload 2680our $RELOAD_WATCHER; # used only during reload
2621 2681
2682sub reload_perl() {
2683 # doing reload synchronously and two reloads happen back-to-back,
2684 # coro crashes during coro_state_free->destroy here.
2685
2686 $RELOAD_WATCHER ||= Event->timer (
2687 reentrant => 0,
2688 after => 0,
2689 data => WF_AUTOCANCEL,
2690 cb => sub {
2691 do_reload_perl;
2692 undef $RELOAD_WATCHER;
2693 },
2694 );
2695}
2696
2622register_command "reload" => sub { 2697register_command "reload" => sub {
2623 my ($who, $arg) = @_; 2698 my ($who, $arg) = @_;
2624 2699
2625 if ($who->flag (FLAG_WIZ)) { 2700 if ($who->flag (FLAG_WIZ)) {
2626 $who->message ("reloading server."); 2701 $who->message ("reloading server.");
2627 2702 async { reload_perl };
2628 # doing reload synchronously and two reloads happen back-to-back,
2629 # coro crashes during coro_state_free->destroy here.
2630
2631 $RELOAD_WATCHER ||= Event->timer (
2632 reentrant => 0,
2633 after => 0,
2634 data => WF_AUTOCANCEL,
2635 cb => sub {
2636 reload;
2637 undef $RELOAD_WATCHER;
2638 },
2639 );
2640 } 2703 }
2641}; 2704};
2642 2705
2643unshift @INC, $LIBDIR; 2706unshift @INC, $LIBDIR;
2644 2707
… …
2646 2709
2647our @WAIT_FOR_TICK; 2710our @WAIT_FOR_TICK;
2648our @WAIT_FOR_TICK_BEGIN; 2711our @WAIT_FOR_TICK_BEGIN;
2649 2712
2650sub wait_for_tick { 2713sub wait_for_tick {
2714 return unless $TICK_WATCHER->is_active;
2715 return if $Coro::current == $Coro::main;
2716
2651 my $signal = new Coro::Signal; 2717 my $signal = new Coro::Signal;
2652 push @WAIT_FOR_TICK, $signal; 2718 push @WAIT_FOR_TICK, $signal;
2653 $signal->wait; 2719 $signal->wait;
2654} 2720}
2655 2721
2656sub wait_for_tick_begin { 2722sub wait_for_tick_begin {
2723 return unless $TICK_WATCHER->is_active;
2724 return if $Coro::current == $Coro::main;
2725
2657 my $signal = new Coro::Signal; 2726 my $signal = new Coro::Signal;
2658 push @WAIT_FOR_TICK_BEGIN, $signal; 2727 push @WAIT_FOR_TICK_BEGIN, $signal;
2659 $signal->wait; 2728 $signal->wait;
2660} 2729}
2661 2730
… …
2673 } 2742 }
2674 2743
2675 $NOW = Event::time; 2744 $NOW = Event::time;
2676 2745
2677 cf::server_tick; # one server iteration 2746 cf::server_tick; # one server iteration
2747
2678 $RUNTIME += $TICK; 2748 $RUNTIME += $TICK;
2679 $NEXT_TICK += $TICK; 2749 $NEXT_TICK += $TICK;
2680 2750
2681 if ($NOW >= $NEXT_RUNTIME_WRITE) { 2751 if ($NOW >= $NEXT_RUNTIME_WRITE) {
2682 $NEXT_RUNTIME_WRITE = $NOW + 10; 2752 $NEXT_RUNTIME_WRITE = $NOW + 10;
… …
2684 write_runtime 2754 write_runtime
2685 or warn "ERROR: unable to write runtime file: $!"; 2755 or warn "ERROR: unable to write runtime file: $!";
2686 }; 2756 };
2687 } 2757 }
2688 2758
2759# my $AFTER = Event::time;
2760# warn $AFTER - $NOW;#d#
2761
2762 # if we are delayed by four ticks or more, skip them all
2763 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
2764
2765 $TICK_WATCHER->at ($NEXT_TICK);
2766 $TICK_WATCHER->start;
2767
2689 if (my $sig = shift @WAIT_FOR_TICK_BEGIN) { 2768 if (my $sig = shift @WAIT_FOR_TICK_BEGIN) {
2690 $sig->send; 2769 $sig->send;
2691 } 2770 }
2692 while (my $sig = shift @WAIT_FOR_TICK) { 2771 while (my $sig = shift @WAIT_FOR_TICK) {
2693 $sig->send; 2772 $sig->send;
2694 } 2773 }
2695 2774
2696# my $AFTER = Event::time; 2775 _post_tick;
2697# warn $AFTER - $NOW;#d#
2698
2699 # if we are delayed by four ticks or more, skip them all
2700 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
2701
2702 $TICK_WATCHER->at ($NEXT_TICK);
2703 $TICK_WATCHER->start;
2704 }, 2776 },
2705); 2777);
2706 2778
2707{ 2779{
2708 BDB::max_poll_time $TICK * 0.1; 2780 BDB::max_poll_time $TICK * 0.1;
… …
2767 prio => 6, 2839 prio => 6,
2768 cb => \&IO::AIO::poll_cb, 2840 cb => \&IO::AIO::poll_cb,
2769 ); 2841 );
2770} 2842}
2771 2843
2844# load additional modules
2845use cf::pod;
2846
2772END { cf::emergency_save } 2847END { cf::emergency_save }
2773 2848
27741 28491
2775 2850

Diff Legend

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