X-Git-Url: http://git.vpit.fr/?p=perl%2Fscripts%2Fxchat.git;a=blobdiff_plain;f=Xchat%2FXPI%2FUtils.pm;fp=Xchat%2FXPI%2FUtils.pm;h=8fab3c469aae892395cf1ceec3f48bd49e1df141;hp=ad99f0ff0162b140e40634d560a0c4a1d7fc49df;hb=7e00cc69db0ee7a4379b5378f1673efc4b531ae8;hpb=edd1cbfd1a969e16d8df9988eb448a53c97c02e7 diff --git a/Xchat/XPI/Utils.pm b/Xchat/XPI/Utils.pm index ad99f0f..8fab3c4 100644 --- a/Xchat/XPI/Utils.pm +++ b/Xchat/XPI/Utils.pm @@ -45,12 +45,36 @@ sub Xchat::XPI::Utils::ContextGuard::DESTROY { set_context ${$_[0]}; } +sub called_from_script (&) { + my $code = shift; + my $level = 0; + my ($package, $filename); + while (1) { + my @frame = caller $level; + last unless @frame; + if ($frame[0] !~ /^(?:Xchat|HexChat)::XPI\b/) { + ($package, $filename) = @frame[0, 1]; + last; + } + ++$level; + } + if (defined $filename) { + my $internal_package = Xchat::Embed::file2pkg($filename); + my $mock = sub { $internal_package, $package }; + no warnings 'redefine'; + local *Xchat::Embed::find_pkg = $mock; + local *HexChat::Embed::find_pkg = $mock; + $code->(); + } +} + use base qw; our @EXPORT = (); our %EXPORT_TAGS = ('funcs' => [ qw< dye_nick save_context local_context + called_from_script > ]); our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];