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

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.558 by root, Tue Oct 5 22:35:30 2010 UTC vs.
Revision 1.566 by root, Sun May 1 16:58:16 2011 UTC

 #
 # This file is part of Deliantra, the Roguelike Realtime MMORPG.
 #
-# Copyright (©) 2006,2007,2008,2009,2010 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
+# Copyright (©) 2006,2007,2008,2009,2010,2011 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
 #
 # Deliantra is free software: you can redistribute it and/or modify it under
 # the terms of the Affero GNU General Public License as published by the
 # Free Software Foundation, either version 3 of the License, or (at your
 # option) any later version.
 our @EVENT;
 our @REFLECT; # set by XS
 our %REFLECT; # set by us
 our $CONFDIR     = confdir;
 our $DATADIR     = datadir;
 our $LIBDIR      = "$DATADIR/ext";
 our $PODDIR      = "$DATADIR/pod";
 our $MAPDIR      = "$DATADIR/" . mapdir;
 our $LOCALDIR    = localdir;
 our $TMPDIR      = "$LOCALDIR/" . tmpdir;
 our $UNIQUEDIR   = "$LOCALDIR/" . uniquedir;
 our $PLAYERDIR   = "$LOCALDIR/" . playerdir;
 our $RANDOMDIR   = "$LOCALDIR/random";
 }
 $EV::DIED = sub {
    Carp::cluck "error in event callback: @_";
 };
+#############################################################################
+sub fork_call(&@);
+sub get_slot($;$$);
 #############################################################################
 =head2 UTILITY FUNCTIONS
       $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
       $d
    } || "[unable to dump $_[0]: '$@']";
 }
+=item $scalar = load_file $path
+Loads the given file from path and returns its contents. Croaks on error
+and can block.
+=cut
+sub load_file($) {
+   0 <= aio_load $_[0], my $data
+      or Carp::croak "$_[0]: $!";
+   $data
+}
 =item $ref = cf::decode_json $json
 Converts a JSON string into the corresponding perl data structure.
 =item $json = cf::encode_json $ref
 our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max
 sub encode_json($) { $json_coder->encode ($_[0]) }
 sub decode_json($) { $json_coder->decode ($_[0]) }
+=item $ref = cf::decode_storable $scalar
+Same as Coro::Storable::thaw, so blocks.
+=cut
+BEGIN { *decode_storable = \&Coro::Storable::thaw }
-=item $ref = cf::yaml_load $scalar
+=item $ref = cf::decode_yaml $scalar
 Same as YAML::XS::Load, but doesn't leak, because it forks (and thus blocks).
 =cut
-sub fork_call(&@);
+sub decode_yaml($) {
-sub yaml_load($) {
    fork_call { YAML::XS::Load $_[0] } @_
+}
+=item $scalar = cf::unlzf $scalar
+Same as Compress::LZF::compress, but takes server ticks into account, so
+blocks.
+=cut
+sub unlzf($) {
+   # we assume 100mb/s minimum decompression speed (noncompressible data on a ~2ghz machine)
+   cf::get_slot +(length $_[0]) / 100_000_000, 0, "unlzf";
+   Compress::LZF::decompress $_[0]
 }
 =item cf::post_init { BLOCK }
 Execute the given codeblock, I<after> all extensions have been (re-)loaded,
    EV::periodic $start, $interval, 0, $cb
 }
 =item cf::get_slot $time[, $priority[, $name]]
-Allocate $time seconds of blocking CPU time at priority C<$priority>:
+Allocate $time seconds of blocking CPU time at priority C<$priority>
-This call blocks and returns only when you have at least C<$time> seconds
+(default: 0):  This call blocks and returns only when you have at least
-of cpu time till the next tick. The slot is only valid till the next cede.
+C<$time> seconds of cpu time till the next tick. The slot is only valid
+till the next cede.
+Background jobs should use a priority les than zero, interactive jobs
+should use 100 or more.
 The optional C<$name> can be used to identify the job to run. It might be
 used for statistical purposes and should identify the same time-class.
 Useful for short background jobs.
       my @data;
       my $md5;
       for (0 .. $#$src) {
-         0 <= aio_load $src->[$_], $data[$_]
+         $data[$_] = load_file $src->[$_];
-            or Carp::croak "$src->[$_]: $!";
       }
       # if processing is expensive, check
       # checksum first
       if (1) {
             while (my ($k, $v) = each %todo) {
                cf::cleanup "mandatory extension '$k' has unresolved dependencies, exiting."
                   if exists $v->{meta}{mandatory};
             }
+            last;
          }
       }
    };
 }
    # {...        are special paths that are not being touched
    # ?xxx/...    are special absolute paths
    # ?random/... random maps
    # /...        normal maps
    # ~user/...   per-player map of a specific user
+   # !up !down   for quad maps, or other maps with up/down layers
    $path =~ s/$PATH_SEP/\//go;
    # treat it as relative path if it starts with
    # something that looks reasonable
    if ($path =~ m{^(?:\./|\.\./|\w)}) {
       $base or Carp::carp "normalise called with relative path and no base: '$path'";
       $base =~ s{[^/]+/?$}{};
       $path = "$base/$path";
+   } elsif ($path eq '!up') {
+      $base && ref $base
+         or Carp::carp "normalise called with relative tile path and no base: '$path'";
+      my $uppth = $base->tile_path (cf::TILE_UP);
+      $path = $uppth if $uppth;
+   } elsif ($path eq '!down') {
+      $base && ref $base
+         or Carp::carp "normalise called with relative tile path and no base: '$path'";
+      my $dpth = $base->tile_path (cf::TILE_DOWN);
+      $path = $dpth if $dpth;
    }
    for ($path) {
       redo if s{/\.?/}{/};
       redo if s{/[^/]+/\.\./}{/};
    Carp::cluck "unable to resolve path '$path' (base '$base')";
    ()
 }
+# may re-bless or do other evil things
 sub init {
    my ($self) = @_;
    $self
 }
    $self->{load_path} = $path;
    1
 }
+# used to laod the header of an original map
 sub load_header_orig {
    my ($self) = @_;
    $self->load_header_from ($self->load_path)
 }
+# used to laod the header of an instantiated map
 sub load_header_temp {
    my ($self) = @_;
    $self->load_header_from ($self->save_path)
 }
+# called after loading the header from an instantiated map
 sub prepare_temp {
    my ($self) = @_;
    $self->last_access ((delete $self->{last_access})
                        || $cf::RUNTIME); #d#
    # safety
    $self->{instantiate_time} = $cf::RUNTIME
       if $self->{instantiate_time} > $cf::RUNTIME;
 }
+# called after loading the header from an original map
 sub prepare_orig {
    my ($self) = @_;
    $self->{load_original} = 1;
    $self->{instantiate_time} = $cf::RUNTIME;
 sub find {
    my ($path, $origin) = @_;
    cf::cede_to_tick;
-   $path = normalise $path, $origin && $origin->path;
+   $path = normalise $path, $origin;
    my $guard1 = cf::lock_acquire "map_data:$path";#d#remove
    my $guard2 = cf::lock_acquire "map_find:$path";
    $cf::MAP{$path} || do {
       $self->alloc;
       $self->pre_load;
       cf::cede_to_tick;
+      if (exists $self->{load_path}) {
-      my $f = new_from_file cf::object::thawer $self->{load_path};
+         my $f = new_from_file cf::object::thawer $self->{load_path};
-      $f->skip_block;
+         $f->skip_block;
-      $self->_load_objects ($f)
+         $self->_load_objects ($f)
-         or return;
+            or return;
-      $self->post_load_original
+         $self->post_load_original
-         if delete $self->{load_original};
+            if delete $self->{load_original};
-      if (my $uniq = $self->uniq_path) {
+         if (my $uniq = $self->uniq_path) {
-         utf8::encode $uniq;
+            utf8::encode $uniq;
-         unless (aio_stat $uniq) {
+            unless (aio_stat $uniq) {
-            if (my $f = new_from_file cf::object::thawer $uniq) {
+               if (my $f = new_from_file cf::object::thawer $uniq) {
-               $self->clear_unique_items;
+                  $self->clear_unique_items;
-               $self->_load_objects ($f);
+                  $self->_load_objects ($f);
-               $f->resolve_delayed_derefs;
+                  $f->resolve_delayed_derefs;
+               }
             }
          }
-      }
-      $f->resolve_delayed_derefs;
+         $f->resolve_delayed_derefs;
+      } else {
+         $self->post_load_original
+            if delete $self->{load_original};
+      }
       cf::cede_to_tick;
       # now do the right thing for maps
       $self->link_multipart_objects;
       $self->difficulty ($self->estimate_difficulty)
 our $MAP_PREFETCHER = undef;
 sub find_async {
    my ($path, $origin, $load) = @_;
-   $path = normalise $path, $origin && $origin->{path};
+   $path = normalise $path, $origin;
    if (my $map = $cf::MAP{$path}) {
       return $map if !$load || $map->in_memory == cf::MAP_ACTIVE;
    }
             ($path, $x, $y) = (undef, undef, undef);
          }
       }
       my $map = eval {
-         my $map = defined $path ? cf::map::find $path : undef;
+         my $map = defined $path ? cf::map::find $path, $self->map : undef;
          if ($map) {
             $map = $map->customise_for ($self);
             $map = $check->($map, $x, $y, $self) if $check && $map;
          } else {
             prepare_random_map $exit
                if $exit->slaying eq "/!";
          }
-         my $map = cf::map::normalise $exit->slaying, $exit->map && $exit->map->path;
+         my $map = cf::map::normalise $exit->slaying, $exit->map;
          my $x   = $exit->stats->hp;
          my $y   = $exit->stats->sp;
          $self->goto ($map, $x, $y);
    my $enc = JSON::XS->new->utf8->canonical->relaxed;
    trace "loading facedata from $path\n";
-   0 < aio_load $path, my $facedata
+   my $facedata = decode_storable load_file $path;
-      or die "$path: $!";
-   $facedata = Coro::Storable::thaw $facedata;
    $facedata->{version} == 2
       or cf::cleanup "$path: version mismatch, cannot proceed.";
    # patch in the exptable
 }
 sub reload_sound {
    trace "loading sound config from $DATADIR/sound\n";
-   0 < Coro::AIO::aio_load "$DATADIR/sound", my $data
-      or die "$DATADIR/sound $!";
-   my $soundconf = JSON::XS->new->utf8->relaxed->decode ($data);
+   my $soundconf = JSON::XS->new->utf8->relaxed->decode (load_file "$DATADIR/sound");
    for (0 .. SOUND_CAST_SPELL_0 - 1) {
       my $sound = $soundconf->{compat}[$_]
          or next;
 }
 sub reload_config {
    trace "reloading config file...\n";
-   0 < aio_load "$CONFDIR/config", my $config
+   my $config = load_file "$CONFDIR/config";
-      or die "$CONFDIR/config: $!";
    utf8::decode $config;
-   *CFG = yaml_load $config;
+   *CFG = decode_yaml $config;
    $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_104_115", 49, 38];
    $cf::map::MAX_RESET     = $CFG{map_max_reset}     if exists $CFG{map_max_reset};
    $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
 sub main {
    cf::init_globals; # initialise logging
    LOG llevInfo, "Welcome to Deliantra, v" . VERSION;
-   LOG llevInfo, "Copyright (C) 2005-2010 Marc Alexander Lehmann / Robin Redeker / the Deliantra team.";
+   LOG llevInfo, "Copyright (C) 2005-2011 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

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.558 by root, Tue Oct 5 22:35:30 2010 UTC vs. Revision 1.566 by root, Sun May 1 16:58:16 2011 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.558 by root, Tue Oct 5 22:35:30 2010 UTC vs.
Revision 1.566 by root, Sun May 1 16:58:16 2011 UTC