--- deliantra/server/lib/cf.pm 2006/08/30 08:28:33 1.56 +++ deliantra/server/lib/cf.pm 2006/09/08 17:41:41 1.63 @@ -13,12 +13,10 @@ use strict; -_reload_1; +_init_vars; our %COMMAND = (); our @EVENT; -our %PROP_TYPE; -our %PROP_IDX; our $LIBDIR = maps_directory "perl"; our $TICK = MAX_TIME * 1e-6; @@ -36,40 +34,6 @@ }; } -my %ignore_set = (MAP_PROP_PATH => 1); # I hate the plug-in api. Deeply! - -# generate property mutators -sub prop_gen { - my ($prefix, $class) = @_; - - no strict 'refs'; - - for my $prop (keys %PROP_TYPE) { - $prop =~ /^\Q$prefix\E_(.*$)/ or next; - my $sub = lc $1; - - my $type = $PROP_TYPE{$prop}; - my $idx = $PROP_IDX {$prop}; - - *{"$class\::get_$sub"} = *{"$class\::$sub"} = sub { - $_[0]->get_property ($type, $idx) - }; - - *{"$class\::set_$sub"} = sub { - $_[0]->set_property ($type, $idx, $_[1]); - } unless $ignore_set{$prop}; - } -} - -# auto-generate most of the API - -prop_gen OBJECT_PROP => "cf::object"; -# CFAPI_OBJECT_ANIMATION? -prop_gen PLAYER_PROP => "cf::object::player"; - -prop_gen MAP_PROP => "cf::map"; -prop_gen ARCH_PROP => "cf::arch"; - @safe::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object'; # we bless all objects into (empty) derived classes to force a method lookup @@ -478,29 +442,53 @@ } sub object_freezer_save { - my ($filename, $objs) = @_; + my ($filename, $rdata, $objs) = @_; - if (@$objs) { - open my $fh, ">:raw", "$filename.pst~"; - syswrite $fh, Storable::nfreeze { version => 1, objs => $objs }; - close $fh; - chmod SAVE_MODE, "$filename.pst~"; - rename "$filename.pst~", "$filename.pst"; + if (length $$rdata) { + warn sprintf "saving %s (%d,%d)\n", + $filename, length $$rdata, scalar @$objs; + + if (open my $fh, ">:raw", "$filename~") { + chmod SAVE_MODE, $fh; + syswrite $fh, $$rdata; + close $fh; + + if (@$objs && open my $fh, ">:raw", "$filename.pst~") { + chmod SAVE_MODE, $fh; + syswrite $fh, Storable::nfreeze { version => 1, objs => $objs }; + close $fh; + rename "$filename.pst~", "$filename.pst"; + } else { + unlink "$filename.pst"; + } + + rename "$filename~", $filename; + } else { + warn "FATAL: $filename~: $!\n"; + } } else { + unlink $filename; unlink "$filename.pst"; } - - chmod SAVE_MODE, "$filename~"; - rename "$filename~", $filename; } sub object_thawer_load { my ($filename) = @_; - open my $fh, "<:raw:perlio", "$filename.pst" - or return; + local $/; + + my $av; + + #TODO: use sysread etc. + if (open my $data, "<:raw:perlio", $filename) { + $data = <$data>; + if (open my $pst, "<:raw:perlio", "$filename.pst") { + $av = eval { (Storable::thaw <$pst>)->{objs} }; + } + return ($data, $av); + } - eval { local $/; (Storable::thaw <$fh>)->{objs} } + () } attach_to_objects @@ -706,6 +694,12 @@ # 7. reload cf.pm $msg->("reloading cf.pm"); require cf; + + $msg->("load extensions"); + cf::load_extensions; + + $msg->("reattach"); + _global_reattach; }; $msg->($@) if $@; @@ -766,27 +760,6 @@ unlink "$path.pst"; }; -# old style persistent data, TODO: remove #d# -*cf::mapsupport::on_swapin = sub { - my ($map) = @_; - - my $path = $map->tmpname; - $path = $map->path unless defined $path; - - warn "$path.cfperl\n";#d# - - open my $fh, "<:raw", "$path.cfperl" - or return; # no perl data - - my $data = Storable::thaw do { local $/; <$fh> }; - - $data->{version} <= 1 - or return; # too new - - $map->_set_obs ($data->{obs}); - $map->invoke (EVENT_MAP_UPGRADE); -}; - attach_to_maps prio => -10000, package => cf::mapsupport::; ############################################################################# @@ -796,6 +769,7 @@ @_, map all_objects ($_->inv), @_ } +# TODO: compatibility cruft, remove when no longer needed attach_to_players on_load => sub { my ($pl, $path) = @_; @@ -926,6 +900,7 @@ # the server's main() sub main { + load_extensions; Event::loop; } @@ -936,8 +911,6 @@ unshift @INC, $LIBDIR; -load_extensions; - $TICK_WATCHER = Event->timer ( prio => 1, at => $NEXT_TICK || 1, @@ -955,7 +928,5 @@ }, ); -_reload_2; - 1