--- deliantra/server/lib/cf.pm 2010/07/03 01:49:18 1.556 +++ deliantra/server/lib/cf.pm 2011/05/01 16:58:16 1.566 @@ -1,7 +1,7 @@ # # 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 @@ -95,10 +95,12 @@ 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; @@ -317,6 +319,11 @@ ############################################################################# +sub fork_call(&@); +sub get_slot($;$$); + +############################################################################# + =head2 UTILITY FUNCTIONS =over 4 @@ -344,6 +351,20 @@ } || "[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. @@ -359,18 +380,37 @@ sub encode_json($) { $json_coder->encode ($_[0]) } sub decode_json($) { $json_coder->decode ($_[0]) } -=item $ref = cf::yaml_load $scalar +=item $ref = cf::decode_storable $scalar -Same as YAML::XS::Load, but doesn't leak, because it forks (and thus blocks). +Same as Coro::Storable::thaw, so blocks. =cut -sub fork_call(&@); +BEGIN { *decode_storable = \&Coro::Storable::thaw } + +=item $ref = cf::decode_yaml $scalar + +Same as YAML::XS::Load, but doesn't leak, because it forks (and thus blocks). + +=cut -sub yaml_load($) { +sub decode_yaml($) { 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 all extensions have been (re-)loaded, @@ -462,9 +502,13 @@ =item cf::get_slot $time[, $priority[, $name]] -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 -of cpu time till the next tick. The slot is only valid till the next cede. +Allocate $time seconds of blocking CPU time at priority C<$priority> +(default: 0): This call blocks and returns only when you have at least +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. @@ -769,8 +813,7 @@ my $md5; for (0 .. $#$src) { - 0 <= aio_load $src->[$_], $data[$_] - or Carp::croak "$src->[$_]: $!"; + $data[$_] = load_file $src->[$_]; } # if processing is expensive, check @@ -1514,6 +1557,8 @@ cf::cleanup "mandatory extension '$k' has unresolved dependencies, exiting." if exists $v->{meta}{mandatory}; } + + last; } } }; @@ -1911,6 +1956,7 @@ # ?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; @@ -1921,6 +1967,20 @@ $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) { @@ -1951,6 +2011,7 @@ () } +# may re-bless or do other evil things sub init { my ($self) = @_; @@ -2025,18 +2086,21 @@ 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) = @_; @@ -2047,6 +2111,7 @@ if $self->{instantiate_time} > $cf::RUNTIME; } +# called after loading the header from an original map sub prepare_orig { my ($self) = @_; @@ -2082,7 +2147,7 @@ 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"; @@ -2132,26 +2197,31 @@ $self->pre_load; cf::cede_to_tick; - my $f = new_from_file cf::object::thawer $self->{load_path}; - $f->skip_block; - $self->_load_objects ($f) - or return; + if (exists $self->{load_path}) { + my $f = new_from_file cf::object::thawer $self->{load_path}; + $f->skip_block; + $self->_load_objects ($f) + or return; - $self->post_load_original - if delete $self->{load_original}; + $self->post_load_original + if delete $self->{load_original}; - if (my $uniq = $self->uniq_path) { - utf8::encode $uniq; - unless (aio_stat $uniq) { - if (my $f = new_from_file cf::object::thawer $uniq) { - $self->clear_unique_items; - $self->_load_objects ($f); - $f->resolve_delayed_derefs; + if (my $uniq = $self->uniq_path) { + utf8::encode $uniq; + unless (aio_stat $uniq) { + if (my $f = new_from_file cf::object::thawer $uniq) { + $self->clear_unique_items; + $self->_load_objects ($f); + $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 @@ -2245,7 +2315,7 @@ 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; @@ -2766,7 +2836,7 @@ } 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); @@ -2874,7 +2944,7 @@ 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; @@ -3401,10 +3471,7 @@ trace "loading facedata from $path\n"; - 0 < aio_load $path, my $facedata - or die "$path: $!"; - - $facedata = Coro::Storable::thaw $facedata; + my $facedata = decode_storable load_file $path; $facedata->{version} == 2 or cf::cleanup "$path: version mismatch, cannot proceed."; @@ -3428,6 +3495,7 @@ cf::face::set_magicmap $idx, $info->{magicmap}; cf::face::set_data $idx, 0, $info->{data32}, $info->{hash32}; cf::face::set_data $idx, 1, $info->{data64}, $info->{hash64}; + cf::face::set_data $idx, 2, $info->{glyph} , $info->{glyph} ; cf::cede_to_tick; } @@ -3532,10 +3600,7 @@ 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}[$_] @@ -3569,11 +3634,9 @@ sub reload_config { trace "reloading config file...\n"; - 0 < aio_load "$CONFDIR/config", my $config - or die "$CONFDIR/config: $!"; - + my $config = load_file "$CONFDIR/config"; utf8::decode $config; - *CFG = yaml_load $config; + *CFG = decode_yaml $config; $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_104_115", 49, 38]; @@ -3621,7 +3684,7 @@ 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.";