diff options
Diffstat (limited to 'plugins/perl')
| -rw-r--r-- | plugins/perl/lib/IRC.pm | 10 | ||||
| -rw-r--r-- | plugins/perl/lib/Xchat.pm | 37 | ||||
| -rw-r--r-- | plugins/perl/lib/Xchat/Embed.pm | 12 |
3 files changed, 40 insertions, 19 deletions
diff --git a/plugins/perl/lib/IRC.pm b/plugins/perl/lib/IRC.pm index c22a8e73..5cc419d0 100644 --- 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 cb1dc3d6..504f3c5c 100644 --- 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 1b779f80..c5857eb0 100644 --- 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}; } |