Fix the callback fixing code to account for inner packages.

git-svn-id: svn://svn.code.sf.net/p/xchat/svn@1519 893a96be-7f27-4fdf-9d1e-6aeec9d3cce1

diff --git a/plugins/perl/lib/IRC.pm b/plugins/perl/lib/IRC.pm
index c22a8e73e81af2e9557e987b3db43b847e4a28b6..5cc419d05dbdb4bee9d43a814f5310f52450f88b 100644 (file)
--- a/plugins/perl/lib/IRC.pm
+++ b/plugins/perl/lib/IRC.pm
@@ -3,7 +3,7 @@ package IRC;
 sub IRC::register {
   my ($script_name, $version, $callback) = @_;
   my $package = caller;
-  $callback = Xchat::Embed::fix_callback( $package, $callback) if $callback;
+  $callback = Xchat::Embed::fix_callback( $package, undef, $callback) if $callback;
   Xchat::register( $script_name, $version, undef, $callback );
 }
 
@@ -12,7 +12,7 @@ sub IRC::add_command_handler {
   my ($command, $callback) = @_;
   my $package = caller;
 
-  $callback = Xchat::Embed::fix_callback( $package, $callback );
+  $callback = Xchat::Embed::fix_callback( $package, undef, $callback );
 
   # starting index for word_eol array
   # this is for compatibility with '' as the command
@@ -30,7 +30,7 @@ sub IRC::add_command_handler {
 sub IRC::add_message_handler {
   my ($message, $callback) = @_;
   my $package = caller;
-  $callback = Xchat::Embed::fix_callback( $package, $callback );
+  $callback = Xchat::Embed::fix_callback( $package, undef, $callback );
 
   Xchat::hook_server( $message,
                      sub {
@@ -44,7 +44,7 @@ sub IRC::add_message_handler {
 sub IRC::add_print_handler {
   my ($event, $callback) = @_;
   my $package = caller;
-  $callback = Xchat::Embed::fix_callback( $package, $callback );
+  $callback = Xchat::Embed::fix_callback( $package, undef, $callback );
   Xchat::hook_print( $event,
                     sub {
                       my @word = @{$_[0]};
@@ -58,7 +58,7 @@ sub IRC::add_print_handler {
 sub IRC::add_timeout_handler {
   my ($timeout, $callback) = @_;
   my $package = caller;
-  $callback = Xchat::Embed::fix_callback( $package, $callback );
+  $callback = Xchat::Embed::fix_callback( $package, undef, $callback );
   Xchat::hook_timer( $timeout,
                     sub {
                       no strict 'refs';

diff --git a/plugins/perl/lib/Xchat.pm b/plugins/perl/lib/Xchat.pm
index cb1dc3d65b7839eda2e81f4c66ef5d910cb664c5..504f3c5cba6ea45f6f33419d3446708db4ad4a92 100644 (file)
--- a/plugins/perl/lib/Xchat.pm
+++ b/plugins/perl/lib/Xchat.pm
@@ -74,7 +74,7 @@ our @EXPORT = @{$EXPORT_TAGS{constants}};
 our @EXPORT_OK = @{$EXPORT_TAGS{all}};
 
 sub register {
-       my $package = Xchat::Embed::find_pkg();
+       my ($package, $calling_package) = Xchat::Embed::find_pkg();
        my $pkg_info = Xchat::Embed::pkg_info( $package );
        my $filename = $pkg_info->{filename};
        my ($name, $version, $description, $callback) = @_;
@@ -86,6 +86,11 @@ sub register {
        }
        
        $description = "" unless defined $description;
+       if( $callback ) {
+               $callback = Xchat::Embed::fix_callback(
+                       $package, $calling_package, $callback
+               );
+       }
        $pkg_info->{shutdown} = $callback;
        unless( $name && $name =~ /[[:print:]\w]/ ) {
                $name = "Not supplied";
@@ -124,9 +129,11 @@ sub hook_server {
        my $message = shift;
        my $callback = shift;
        my $options = shift;
-       my $package = Xchat::Embed::find_pkg();
+       my ($package, $calling_package) = Xchat::Embed::find_pkg();
        
-       $callback = Xchat::Embed::fix_callback( $package, $callback );
+       $callback = Xchat::Embed::fix_callback(
+               $package, $calling_package, $callback
+       );
        
        my ($priority, $data) = ( Xchat::PRI_NORM, undef );
        _process_hook_options(
@@ -148,9 +155,11 @@ sub hook_command {
        my $command = shift;
        my $callback = shift;
        my $options = shift;
-       my $package = Xchat::Embed::find_pkg();
+       my ($package, $calling_package) = Xchat::Embed::find_pkg();
 
-       $callback = Xchat::Embed::fix_callback( $package, $callback );
+       $callback = Xchat::Embed::fix_callback(
+               $package, $calling_package, $callback
+       );
        
        my ($priority, $help_text, $data) = ( Xchat::PRI_NORM, undef, undef );
        _process_hook_options(
@@ -172,9 +181,11 @@ sub hook_print {
        my $event = shift;
        my $callback = shift;
        my $options = shift;
-       my $package = Xchat::Embed::find_pkg();
+       my ($package, $calling_package) = Xchat::Embed::find_pkg();
 
-       $callback = Xchat::Embed::fix_callback( $package, $callback );
+       $callback = Xchat::Embed::fix_callback(
+               $package, $calling_package, $callback
+       );
        
        my ($priority, $run_after, $filter, $data) = ( Xchat::PRI_NORM, 0, 0, undef );
        _process_hook_options(
@@ -247,9 +258,11 @@ sub hook_print {
 sub hook_timer {
        return undef unless @_ >= 2;
        my ($timeout, $callback, $data) = @_;
-       my $package = Xchat::Embed::find_pkg();
+       my ($package, $calling_package) = Xchat::Embed::find_pkg();
 
-       $callback = Xchat::Embed::fix_callback( $package, $callback );
+       $callback = Xchat::Embed::fix_callback(
+               $package, $calling_package, $callback
+       );
 
        if(
                ref( $data ) eq 'HASH' && exists( $data->{data} )
@@ -272,8 +285,10 @@ sub hook_fd {
        my $fileno = fileno $fd;
        return undef unless defined $fileno; # no underlying fd for this handle
        
-       my $package = Xchat::Embed::find_pkg();
-       $callback = Xchat::Embed::fix_callback( $package, $callback );
+       my ($package, $calling_package) = Xchat::Embed::find_pkg();
+       $callback = Xchat::Embed::fix_callback(
+               $package, $calling_package, $callback
+       );
        
        my ($flags, $data) = (Xchat::FD_READ, undef);
        _process_hook_options(

diff --git a/plugins/perl/lib/Xchat/Embed.pm b/plugins/perl/lib/Xchat/Embed.pm
index 1b779f80e477bebcbc2277fe6c62092c51533aeb..c5857eb0626206072e6c72a08ce859b641487471 100644 (file)
--- a/plugins/perl/lib/Xchat/Embed.pm
+++ b/plugins/perl/lib/Xchat/Embed.pm
@@ -259,7 +259,7 @@ sub find_external_pkg {
                return @frame if $frame[0] !~ /(?:^IRC$|^Xchat)/;
                $level++;
        }
-
+       return;
 }
 
 sub find_pkg {
@@ -281,7 +281,7 @@ sub find_pkg {
        if( $frame[0] or $frame[1] ) {
                my $calling_package = $frame[0];
                if( defined( my $owner = $owner_package{ $calling_package } ) ) {
-                       return $owner;
+                       return ($owner, $calling_package);
                }
 
                $location = $frame[1] ? $frame[1] : "package $frame[0]";
@@ -294,10 +294,16 @@ sub find_pkg {
 
 }
 
+# convert function names into code references
 sub fix_callback {
-       my ($package, $callback) = @_;
+       my ($package, $calling_package, $callback) = @_;
        
        unless( ref $callback ) {
+               unless( $callback =~ /::/ ) {
+                       my $prefix = defined $calling_package ? $calling_package : $package;
+                       $callback =~ s/^/${prefix}::/;
+               }
+
                no strict 'subs';
                $callback = \&{$callback};
        }