--- deliantra/server/lib/cf.pm 2006/08/25 15:21:57 1.40 +++ deliantra/server/lib/cf.pm 2006/08/26 08:44:06 1.44 @@ -73,14 +73,14 @@ # guessed hierarchies -@ext::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object'; -@ext::cf::object::map::ISA = @cf::object::map::ISA = 'cf::object'; +@safe::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object'; +@safe::cf::object::map::ISA = @cf::object::map::ISA = 'cf::object'; -# we bless all objects into derived classes to force a method lookup +# 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::map cf::object::player cf::player cf::map cf::party cf::region cf::arch)) { no strict 'refs'; - @{"ext::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; + @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; } $Event::DIED = sub { @@ -94,6 +94,21 @@ my %extcmd; ############################################################################# +# object support + +sub reattach { + warn "reattach<@_>\n"; +} + +sub instantiate { + warn "instantiate<@_>\n"; +} + +sub clone { + warn "clone<@_>\n"; +} + +############################################################################# # "new" plug-in system =item cf::object::attach ... # NYI @@ -301,7 +316,7 @@ my $base = $1; my $pkg = $1; $pkg =~ s/[^[:word:]]/_/g; - $pkg = "cf::ext::$pkg"; + $pkg = "ext::$pkg"; warn "loading '$path' into '$pkg'\n"; @@ -354,7 +369,7 @@ delete $extcmd{$name}; } - if (my $cb = $pkg->can ("on_unload")) { + if (my $cb = $pkg->can ("unload")) { eval { $cb->($pkg); 1 @@ -408,8 +423,8 @@ Symbol::delete_package $k; } - # 4. get rid of ext::, as good as possible - Symbol::delete_package "ext::$_" + # 4. get rid of safe::, as good as possible + Symbol::delete_package "safe::$_" for qw(cf::object cf::object::map cf::object::player cf::player cf::map cf::party cf::region); # 5. remove register_script_function callbacks @@ -418,7 +433,8 @@ # 6. unload cf.pm "a bit" delete $INC{"cf.pm"}; - # don't, removes xs symbols, too + # don't, removes xs symbols, too, + # and global variables created in xs #Symbol::delete_package __PACKAGE__; # 7. reload cf.pm @@ -467,23 +483,25 @@ # extcmd framework, basically convert ext # into pkg::->on_extcmd_arg1 (...) while shortcutting a few -sub on_extcmd { - my ($pl, $buf) = @_; +attach_to_players + on_extcmd => sub { + my ($pl, $buf) = @_; - my $msg = eval { from_json $buf }; + my $msg = eval { from_json $buf }; - if (ref $msg) { - if (my $cb = $extcmd{$msg->{msgtype}}) { - if (my %reply = $cb->[0]->($pl, $msg)) { - $pl->ext_reply ($msg->{msgid}, %reply); + if (ref $msg) { + if (my $cb = $extcmd{$msg->{msgtype}}) { + if (my %reply = $cb->[0]->($pl, $msg)) { + $pl->ext_reply ($msg->{msgid}, %reply); + } } + } else { + warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; } - } else { - warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; - } - 1 -} + cf::override; + }, +; ############################################################################# # load/save/clean perl data associated with a map @@ -625,7 +643,7 @@ ############################################################################# # map scripting support -our $safe = new Safe "ext"; +our $safe = new Safe "safe"; our $safe_hole = new Safe::Hole; $SIG{FPE} = 'IGNORE'; @@ -641,7 +659,7 @@ ) { no strict 'refs'; my ($pkg, @funs) = @$_; - *{"ext::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"}) + *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"}) for @funs; } @@ -653,9 +671,9 @@ $qcode =~ s/\n/\\n/g; local $_; - local @ext::cf::_safe_eval_args = values %vars; + local @safe::cf::_safe_eval_args = values %vars; - $code = + my $eval = "do {\n" . "my (" . (join ",", map "\$$_", keys %vars) . ") = \@cf::_safe_eval_args;\n" . "#line 0 \"{$qcode}\"\n" @@ -664,9 +682,15 @@ ; sub_generation_inc; - my @res = wantarray ? $safe->reval ($code) : scalar $safe->reval ($code); + my @res = wantarray ? $safe->reval ($eval) : scalar $safe->reval ($eval); sub_generation_inc; + if ($@) { + warn "$@"; + warn "while executing safe code '$code'\n"; + warn "with arguments " . (join " ", %vars) . "\n"; + } + wantarray ? @res : $res[0] } @@ -674,7 +698,7 @@ my ($fun, $cb) = @_; no strict 'refs'; - *{"ext::$fun"} = $safe_hole->wrap ($cb); + *{"safe::$fun"} = $safe_hole->wrap ($cb); } #############################################################################