[ViewVC] Diff of: cvs/deliantra/server/lib/cf.pm

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.535 by root, Thu Apr 29 08:21:28 2010 UTC vs.
Revision 1.543 by root, Wed May 5 23:23:29 2010 UTC

 # The authors can be reached via e-mail to <support@deliantra.net>
 #
 package cf;
-use 5.10.0;
+use common::sense;
-use utf8;
-use strict qw(vars subs);
 use Symbol;
 use List::Util;
 use Socket;
 use EV;
 # strictly for debugging
 $SIG{QUIT} = sub { Carp::cluck "SIGQUIT" };
 sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
+our @ORIG_INC;
 our %COMMAND      = ();
 our %COMMAND_TIME = ();
 our @EXTS         = (); # list of extension package names
 our %EXTCMD       = ();
 our $BDB_DEADLOCK_WATCHER;
 our $BDB_CHECKPOINT_WATCHER;
 our $BDB_TRICKLE_WATCHER;
 our $DB_ENV;
-our @EXTRA_MODULES = qw(pod match mapscript);
+our @EXTRA_MODULES = qw(pod match mapscript incloader);
 our %CFG;
 our $UPTIME; $UPTIME ||= time;
 our $RUNTIME;
          $ext{meta} = { map { (split /=/, $_, 2)[0, 1] } split /\s+/, $1 }
             if $source =~ /\A#!.*?perl.*?#\s*(.*)$/m;
          $ext{source} =
-            "package $pkg; use 5.10.0; use strict 'vars', 'subs'; use utf8;\n"
+            "package $pkg; use common::sense;\n"
             . "#line 1 \"$path\"\n{\n"
             . $source
             . "\n};\n1";
          $todo{$base} = \%ext;
 sub register {
    my (undef, $regex, $prio) = @_;
    my $pkg = caller;
-   no strict;
    push @{"$pkg\::ISA"}, __PACKAGE__;
    $EXT_MAP{$pkg} = [$prio, qr<$regex>];
 }
 }
 sub normalise {
    my ($path, $base) = @_;
-   $path = "$path"; # make sure its a string
+   $path = "$path"; # make sure it's a string
    $path =~ s/\.map$//;
    # map plan:
    #
          $self->init; # pass $1 etc.
          return $self;
       }
    }
-   Carp::cluck "unable to resolve path '$path' (base '$base').";
+   Carp::cluck "unable to resolve path '$path' (base '$base')";
    ()
 }
 sub init {
    my ($self) = @_;
 }
 sub find;
 sub find {
    my ($path, $origin) = @_;
+   cf::cede_to_tick;
    $path = normalise $path, $origin && $origin->path;
    my $guard1 = cf::lock_acquire "map_data:$path";#d#remove
    my $guard2 = cf::lock_acquire "map_find:$path";
                                decrease split destroy change_exp value msg lore send_msg)],
    ["cf::object::player" => qw(player)],
    ["cf::player"         => qw(peaceful send_msg)],
    ["cf::map"            => qw(trigger)],
 ) {
-   no strict 'refs';
    my ($pkg, @funs) = @$_;
    *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"})
       for @funs;
 }
 sub main {
    cf::init_globals; # initialise logging
    LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
-   LOG llevInfo, "Copyright (C) 2005-2008 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
+   LOG llevInfo, "Copyright (C) 2005-2010 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
    LOG llevInfo, "Copyright (C) 1994 Mark Wedel.";
    LOG llevInfo, "Copyright (C) 1992 Frank Tore Johansen.";
    $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
    };
    evthread_start IO::AIO::poll_fileno;
    cf::sync_job {
+      cf::incloader::init ();
       cf::init_experience;
       cf::init_anim;
       cf::init_attackmess;
       cf::init_dynamic;
    };
    cf::object::thawer::errors_are_fatal 0;
    info "parse errors in files are no longer fatal from this point on.\n";
+   my $free_main; $free_main = EV::idle sub {
+      undef $free_main;
+      undef &main; # free gobs of memory :)
+   };
-   main_loop;
+   goto &main_loop;
 }
 #############################################################################
 # initialisation and cleanup
       cf::write_runtime_sync; # external watchdog should not bark
       trace "emergency_perl_save: syncing database to disk";
       BDB::db_env_txn_checkpoint $DB_ENV;
-      info "emergency_perl_save: starting sync()\n";
+      info "emergency_perl_save: starting sync\n";
       IO::AIO::aio_sync sub {
-         info "emergency_perl_save: finished sync()\n";
+         info "emergency_perl_save: finished sync\n";
       };
       cf::write_runtime_sync; # external watchdog should not bark
       trace "emergency_perl_save: flushing outstanding aio requests";
    info "emergency_perl_save: leave\n";
 }
 sub post_cleanup {
    my ($make_core) = @_;
-   IO::AIO::flush;
    IO::AIO::flush;
    error Carp::longmess "post_cleanup backtrace"
       if $make_core;
    }
 }
 sub do_reload_perl() {
    # can/must only be called in main
-   if (in_main) {
+   unless (in_main) {
       error "can only reload from main coroutine";
       return;
    }
    return if $RELOAD++;
    my $t1 = AE::time;
    while ($RELOAD) {
+      cf::get_slot 0.1, -1, "reload_perl";
       info "reloading...";
       trace "entering sync_job";
       cf::sync_job {
-         cf::emergency_save;
+         #cf::emergency_save;
          trace "cancelling all extension coros";
          $_->cancel for values %EXT_CORO;
          %EXT_CORO = ();
          reload_perl;
       };
    }
 };
-unshift @INC, $LIBDIR;
+#############################################################################
 my $bug_warning = 0;
 our @WAIT_FOR_TICK;
 our @WAIT_FOR_TICK_BEGIN;

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.535 by root, Thu Apr 29 08:21:28 2010 UTC vs. Revision 1.543 by root, Wed May 5 23:23:29 2010 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.535 by root, Thu Apr 29 08:21:28 2010 UTC vs.
Revision 1.543 by root, Wed May 5 23:23:29 2010 UTC