--- deliantra/server/lib/cf.pm 2006/07/19 22:51:40 1.24 +++ deliantra/server/lib/cf.pm 2006/07/20 22:03:36 1.26 @@ -66,8 +66,15 @@ # guessed hierarchies -@cf::object::player::ISA = 'cf::object'; -@cf::object::map::ISA = 'cf::object'; +@ext::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object'; +@ext::cf::object::map::ISA = @cf::object::map::ISA = 'cf::object'; + +# we bless all objects into derived classes to force a method lookup +# within the Safe compartment. +for my $pkg (qw(cf::object cf::object::map cf::object::player cf::player cf::map cf::party cf::region)) { + no strict 'refs'; + @{"ext::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; +} $Event::DIED = sub { warn "error in event callback: @_"; @@ -321,19 +328,6 @@ *on_player_load = sub { my ($ob, $path) = @_; - if (open my $fh, "<:raw", "$path.cfperl") { - - #d##TODO#remove - - my $data = Storable::thaw do { local $/; <$fh> }; - - $data->{version} <= 1 - or return; # too new - - %$ob = %{$data->{ob}}; - return; - } - for my $o ($ob, $ob->inv) { if (my $value = $o->get_ob_key_value ("_perl_data")) { $o->set_ob_key_value ("_perl_data"); @@ -348,8 +342,6 @@ $_->set_ob_key_value (_perl_data => unpack "H*", Storable::nfreeze $_) for grep %$_, $ob, $ob->inv; - - unlink "$path.cfperl";#d##TODO#remove }; ############################################################################# @@ -391,9 +383,18 @@ $safe->permit_only (Opcode::opset qw(:base_core :base_mem :base_orig :base_math sort time)); -# here we would export the classes and methods available to script code -#@ext::cf::object::player::ISA = @cf::object::player::ISA; -#@ext::cf::object::map::ISA = @cf::object::map::ISA; +# here we export the classes and methods available to script code + +for ( + ["cf::object" => qw(contr)], + ["cf::object::player" => qw(player)], + ["cf::player" => qw(peaceful)], +) { + no strict 'refs'; + my ($pkg, @funs) = @$_; + *{"ext::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"}) + for @funs; +} sub safe_eval($;@) { my ($code, %vars) = @_; @@ -405,13 +406,19 @@ local $_; local @ext::cf::_safe_eval_args = values %vars; - $safe->reval ( + $code = "do {\n" . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n" . "#line 0 \"{$qcode}\"\n" . $code . "\n}" - ) + ; + + sub_generation_inc; + my @res = wantarray ? $safe->reval ($code) : scalar $safe->reval ($code); + sub_generation_inc; + + wantarray ? @res : $res[0] } sub register_script_function {