--- deliantra/server/lib/cf.pm 2006/08/27 13:02:04 1.47 +++ deliantra/server/lib/cf.pm 2006/08/28 14:05:24 1.51 @@ -74,7 +74,7 @@ # we bless all objects into (empty) derived classes to force a method lookup # within the Safe compartment. -for my $pkg (qw(cf::object cf::object::player cf::player cf::map cf::party cf::region cf::arch)) { +for my $pkg (qw(cf::object cf::object::player cf::player cf::map cf::party cf::region cf::arch cf::living)) { no strict 'refs'; @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; } @@ -107,15 +107,15 @@ ############################################################################# # "new" plug-in system -=item $object->attach ($attachment, ...) +=item $object->attach ($attachment, key => $value...) Attach a pre-registered attachment to an object. -=item $player->attach ($attachment, ...) +=item $player->attach ($attachment, key => $value...) Attach a pre-registered attachment to a player. -=item $map->attach ($attachment, ...) # not yet persistent +=item $map->attach ($attachment, key => $value...) # not yet persistent Attach a pre-registered attachment to a map. @@ -247,7 +247,7 @@ } sub _attach_attachment { - my ($obj, $name, @args) = @_; + my ($obj, $name, %arg) = @_; my $res; @@ -259,41 +259,33 @@ $res = _attach @$registry, $klass, @attach; } - if (my $cb = delete $registry->[EVENT_OBJECT_INSTANTIATE]) { - for (@$cb) { - eval { $_->[1]->($obj, @args); }; - if ($@) { - warn "$@"; - warn "... while processing '$name' instantiate with args <@args>.\n"; - } - } - } + $obj->{$name} = \%arg; } else { warn "object uses attachment '$name' that is not available, postponing.\n"; } - push @{$obj->{_attachment}}, $name; + $obj->{_attachment}{$name} = undef; $res->{attachment} = $name; $res } sub cf::object::attach { - my ($obj, $name, @args) = @_; + my ($obj, $name, %arg) = @_; - _attach_attachment $obj, $name, @args; + _attach_attachment $obj, $name, %arg; } sub cf::player::attach { - my ($obj, $name, @args) = @_; + my ($obj, $name, %arg) = @_; - _attach_attachment KLASS_PLAYER, $obj, $name, @args; + _attach_attachment KLASS_PLAYER, $obj, $name, %arg; } sub cf::map::attach { - my ($obj, $name, @args) = @_; + my ($obj, $name, %arg) = @_; - _attach_attachment KLASS_MAP, $obj, $name, @args; + _attach_attachment KLASS_MAP, $obj, $name, %arg; } sub attach_global { @@ -366,7 +358,8 @@ for (@$data) { my ($name, $args) = @$_; - attach $obj, $name, @{$args || [] }; + + $obj->attach ($name, %{$args || {} }); } } @@ -377,7 +370,9 @@ @$registry = (); - for my $name (@{ $obj->{_attachment} }) { + delete $obj->{_attachment} unless scalar keys %{ $obj->{_attachment} || {} }; + + for my $name (keys %{ $obj->{_attachment} || {} }) { if (my $attach = $attachment{$name}) { for (@$attach) { my ($klass, @attach) = @$_; @@ -392,17 +387,18 @@ sub object_freezer_save { my ($filename, $objs) = @_; - $filename .= ".pst"; - if (@$objs) { - open my $fh, ">:raw", "$filename~"; - chmod $fh, SAVE_MODE; + open my $fh, ">:raw", "$filename.pst~"; syswrite $fh, Storable::nfreeze { version => 1, objs => $objs }; close $fh; - rename "$filename~", $filename; + chmod SAVE_MODE, "$filename.pst~"; + rename "$filename.pst~", "$filename.pst"; } else { - unlink $filename; + unlink "$filename.pst"; } + + chmod SAVE_MODE, "$filename~"; + rename "$filename~", $filename; } sub object_thawer_load { @@ -423,7 +419,7 @@ %$dst = %$src; - $dst->{_attachment} = [@{ $src->{_attachment} }] + %{$dst->{_attachment}} = %{$src->{_attachment}} if exists $src->{_attachment}; }, ; @@ -674,10 +670,10 @@ my $path = $map->tmpname; defined $path or return; - unlink "$path.cfperl"; unlink "$path.pst"; }; +# old style persistent data, TODO: remove #d# *cf::mapsupport::on_swapin = *cf::mapsupport::on_load = sub { my ($map) = @_; @@ -694,6 +690,7 @@ or return; # too new $map->_set_obs ($data->{obs}); + $map->invoke (EVENT_MAP_UPGRADE); }; attach_to_maps prio => -10000, package => cf::mapsupport::;