From: Vincent Pit <vince@profvince.com>
Date: Fri, 20 Nov 2015 13:53:30 +0000 (-0200)
Subject: Pretend that the xchat functions in XPI are called from the script
X-Git-Url: http://git.vpit.fr/?p=perl%2Fscripts%2Fxchat.git;a=commitdiff_plain;h=7e00cc69db0ee7a4379b5378f1673efc4b531ae8

Pretend that the xchat functions in XPI are called from the script

This replaces 73947ac5.
---

diff --git a/Xchat/XPI.pm b/Xchat/XPI.pm
index 6811e63..0733175 100644
--- a/Xchat/XPI.pm
+++ b/Xchat/XPI.pm
@@ -7,6 +7,9 @@ use Tie::RefHash;
 
 use Xchat;
 
+use lib Xchat::get_info('xchatdir');
+use Xchat::XPI::Utils qw<called_from_script>;
+
 our $VERSION = '0.05';
 
 use constant { COLOR_TAG => "\00307" };
@@ -23,7 +26,7 @@ sub new {
  $class    = ref($class) || $class;
  my %opts  = @_;
 
- my ($caller, $file) = (caller 0)[0, 1];
+ my $caller = (caller 0)[0];
 
  unless (defined $opts{tag}) {
   $opts{tag}     = ($caller =~ /([^:]*):*$/) ? $1 : 'UNKNOWN';
@@ -53,19 +56,17 @@ sub new {
  *$ph->{$_}  = $opts{$_} for @attributes;
  *$ph->{buf} = '';
 
- my $internal_pkg = Xchat::Embed::file2pkg($file);
- no warnings 'redefine';
- local *Xchat::Embed::find_pkg   = sub { $internal_pkg, $caller };
- local *HexChat::Embed::find_pkg = sub { $internal_pkg, $caller };
- Xchat::register(@opts{qw<name version banner>}, sub {
-  $ph->flush;
-  if (*$ph->{atexit_id}) {
-   my @callbacks = sort { *$ph->{atexit}{$b} <=> *$ph->{atexit}{$a} }
-                    keys %{*$ph->{atexit}};
-   $_->($ph) for @callbacks;
-  }
-  undef $ph;
- });
+ called_from_script {
+  Xchat::register(@opts{qw<name version banner>}, sub {
+   $ph->flush;
+   if (*$ph->{atexit_id}) {
+    my @callbacks = sort { *$ph->{atexit}{$b} <=> *$ph->{atexit}{$a} }
+                     keys %{*$ph->{atexit}};
+    $_->($ph) for @callbacks;
+   }
+   undef $ph;
+  })
+ };
  $ph->add_atexit($opts{unload}) if $opts{unload};
 
  $ph->print("\002", $ph->name, ' v', $ph->version,
diff --git a/Xchat/XPI/Events.pm b/Xchat/XPI/Events.pm
index d851caa..0f120a5 100644
--- a/Xchat/XPI/Events.pm
+++ b/Xchat/XPI/Events.pm
@@ -5,6 +5,9 @@ use warnings;
 
 use Xchat qw<:all>;
 
+use lib get_info 'xchatdir';
+use Xchat::XPI::Utils qw<called_from_script>;
+
 use constant DEFAULT_DELAY => 1000;
 
 our $VERSION = '0.04';
@@ -26,7 +29,9 @@ sub delay {
   $delay = DEFAULT_DELAY;
  }
 
- hook_timer $delay, \&_delay_cb, { data => \@_ };
+ called_from_script {
+  hook_timer $delay, \&_delay_cb, { data => \@_ }
+ }
 }
 
 sub _filter_cb {
@@ -44,7 +49,9 @@ sub _filter_cb {
 sub filter {
  my $from = shift;
 
- hook_print $from, \&_filter_cb, { data => \@_ };
+ called_from_script {
+  hook_print $from, \&_filter_cb, { data => \@_ }
+ }
 }
 
 use base qw<Exporter>;
diff --git a/Xchat/XPI/Net.pm b/Xchat/XPI/Net.pm
index 96c4af3..d4823a8 100644
--- a/Xchat/XPI/Net.pm
+++ b/Xchat/XPI/Net.pm
@@ -3,12 +3,15 @@ package Xchat::XPI::Net;
 use strict;
 use warnings;
 
+use Xchat qw<:all>;
+
+use lib get_info 'xchatdir';
+use Xchat::XPI::Utils qw<called_from_script>;
+
 use IO::Socket::INET;
 
 use Net::DNS;
 
-use Xchat qw<:all>;
-
 our $VERSION = '0.03';
 
 my $res;
@@ -32,10 +35,12 @@ sub resolve {
  return unless $sock;
  $sock->autoflush(1);
 
- return Xchat::hook_fd($sock, \&_dns_recv, {
-  flags => FD_READ,
-  data  => [ $callback, $args ],
- });
+ return called_from_script {
+  Xchat::hook_fd($sock, \&_dns_recv, {
+   flags => FD_READ,
+   data  => [ $callback, $args ],
+  });
+ }
 }
 
 sub _dns_recv {
@@ -107,10 +112,12 @@ sub whois {
  print $sock "$host\x0D\x0A";
  $sock->shutdown(1); # stop writing
 
- return Xchat::hook_fd($sock, \&_whois_recv, {
-  flags => FD_READ,
-  data  => [ $callback, $args ],
- });
+ return called_from_script {
+  Xchat::hook_fd($sock, \&_whois_recv, {
+   flags => FD_READ,
+   data  => [ $callback, $args ],
+  });
+ }
 }
 
 sub _whois_recv {
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<Exporter>;
 
 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 ];