From ed0e530b794c25edbc0539941924638a1e1e6f16 Mon Sep 17 00:00:00 2001 From: Berke Viktor Date: Fri, 13 Jul 2012 20:16:10 +0200 Subject: Update XChat to r1514 --- plugins/perl/lib/Xchat.pm | 15 ++--- plugins/perl/lib/Xchat/Embed.pm | 122 +++++++++++++++++++++++++++++++--------- plugins/perl/perl.c | 85 +++++++++++++++++----------- 3 files changed, 152 insertions(+), 70 deletions(-) (limited to 'plugins') diff --git a/plugins/perl/lib/Xchat.pm b/plugins/perl/lib/Xchat.pm index 1849789b..cb1dc3d6 100644 --- a/plugins/perl/lib/Xchat.pm +++ b/plugins/perl/lib/Xchat.pm @@ -1,7 +1,3 @@ -BEGIN { - $INC{'Xchat.pm'} = 'DUMMY'; -} - $SIG{__WARN__} = sub { my $message = shift @_; my ($package) = caller; @@ -141,7 +137,7 @@ sub hook_server { my $pkg_info = Xchat::Embed::pkg_info( $package ); my $hook = Xchat::Internal::hook_server( - $message, $priority, $callback, $data + $message, $priority, $callback, $data, $package ); push @{$pkg_info->{hooks}}, $hook if defined $hook; return $hook; @@ -165,7 +161,7 @@ sub hook_command { my $pkg_info = Xchat::Embed::pkg_info( $package ); my $hook = Xchat::Internal::hook_command( - $command, $priority, $callback, $help_text, $data + $command, $priority, $callback, $help_text, $data, $package ); push @{$pkg_info->{hooks}}, $hook if defined $hook; return $hook; @@ -242,7 +238,7 @@ sub hook_print { my $pkg_info = Xchat::Embed::pkg_info( $package ); my $hook = Xchat::Internal::hook_print( - $event, $priority, $callback, $data + $event, $priority, $callback, $data, $package ); push @{$pkg_info->{hooks}}, $hook if defined $hook; return $hook; @@ -276,7 +272,7 @@ sub hook_fd { my $fileno = fileno $fd; return undef unless defined $fileno; # no underlying fd for this handle - my ($package) = Xchat::Embed::find_pkg(); + my $package = Xchat::Embed::find_pkg(); $callback = Xchat::Embed::fix_callback( $package, $callback ); my ($flags, $data) = (Xchat::FD_READ, undef); @@ -297,7 +293,8 @@ sub hook_fd { my $hook = Xchat::Internal::hook_fd( $fileno, $cb, $flags, { DATA => $data, FD => $fd, CB => $callback, FLAGS => $flags, - } + }, + $package ); push @{$pkg_info->{hooks}}, $hook if defined $hook; return $hook; diff --git a/plugins/perl/lib/Xchat/Embed.pm b/plugins/perl/lib/Xchat/Embed.pm index dffbaf5e..1b779f80 100644 --- a/plugins/perl/lib/Xchat/Embed.pm +++ b/plugins/perl/lib/Xchat/Embed.pm @@ -2,8 +2,39 @@ package Xchat::Embed; use strict; use warnings; # list of loaded scripts keyed by their package names +# The package names are generated from the filename of the script using +# the file2pkg() function. +# The values of this hash are hash references with the following keys: +# filename +# The full path to the script. +# gui_entry +# This is xchat_plugin pointer that is used to remove the script from +# Plugins and Scripts window when a script is unloaded. This has also +# been converted with the PTR2IV() macro. +# hooks +# This is an array of hooks that are associated with this script. +# These are pointers that have been converted with the PTR2IV() macro. +# inner_packages +# Other packages that are defined in a script. This is not recommended +# partly because these will also get removed when a script is unloaded. +# loaded_at +# A timestamp of when the script was loaded. The value is whatever +# Time::HiRes::time() returns. This is used to retain load order when +# using the RELOADALL command. +# shutdown +# This is either a code ref or undef. It will be executed just before a +# script is unloaded. our %scripts; +# This is a mapping of "inner package" => "containing script package" +our %owner_package; + +# used to keep track of which package a hook belongs to, if the normal way of +# checking which script is calling a hook function fails this will be used +# instead. When a hook is created this will be copied to the HookData structure +# and when a callback is invoked this it will be used to set this value. +our $current_package; + sub load { my $file = expand_homedir( shift @_ ); my $package = file2pkg( $file ); @@ -28,32 +59,45 @@ sub load { # we shouldn't care about things after __END__ $source =~ s/^__END__.*//ms; - if( - my @replacements = $source =~ - m/^\s*package ((?:[^\W:]+(?:::)?)+)\s*?;/mg - ) { - - if ( @replacements > 1 ) { - Xchat::print( - "Too many package defintions, only 1 is allowed\n" - ); - return 1; - } - - my $original_package = shift @replacements; - - # remove original package declaration - $source =~ s/^(package $original_package\s*;)/#$1/m; - - # fixes things up for code calling subs with fully qualified names - $source =~ s/${original_package}:://g; - } - # this must come before the eval or the filename will not be found in # Xchat::register $scripts{$package}{filename} = $file; $scripts{$package}{loaded_at} = Time::HiRes::time(); + # this must be done before the error check so the unload will remove + # any inner packages defined by the script. if a script fails to load + # then any inner packages need to be removed as well. + my @inner_packages = $source =~ + m/^\s*package \s+ + ((?:[^\W:]+(?:::)?)+)\s*? # package name + # strict version number + (?:\d+(?:[.]\d+) # positive integer or decimal-fraction + |v\d+(?:[.]\d+){2,})? # dotted-decimal v-string + [{;] + /mgx; + + # check if any inner package defined in the to be loaded script has + # already been defined by another script + my @conflicts; + for my $inner ( @inner_packages ) { + if( exists $owner_package{ $inner } ) { + push @conflicts, $inner; + } + } + + # report conflicts and bail out + if( @conflicts ) { + my $error_message = + "'$file' won't be loaded due to conflicting inner packages:\n"; + for my $conflict_package ( @conflicts ) { + $error_message .= " $conflict_package already defined in " . + pkg_info($owner_package{ $conflict_package })->{filename}."\n"; + } + Xchat::print( $error_message ); + + return 2; + } + my $full_path = File::Spec->rel2abs( $file ); $source =~ s/^/#line 1 "$full_path"\n\x7Bpackage $package;/; @@ -64,6 +108,8 @@ sub load { $source =~ s/\Z/\x7D/; } + $scripts{$package}{inner_packages} = [ @inner_packages ]; + @owner_package{ @inner_packages } = ($package) x @inner_packages; _do_eval( $source ); unless( exists $scripts{$package}{gui_entry} ) { @@ -72,7 +118,7 @@ sub load { "", "unknown", "", $file ); } - + if( $@ ) { # something went wrong $@ =~ s/\(eval \d+\)/$file/g; @@ -120,11 +166,14 @@ sub unload { } } - if( exists $pkg_info->{gui_entry} ) { plugingui_remove( $pkg_info->{gui_entry} ); } + delete @owner_package{ @{$pkg_info->{inner_packages}} }; + for my $inner_package ( @{$pkg_info->{inner_packages}} ) { + Symbol::delete_package( $inner_package ); + } Symbol::delete_package( $package ); delete $scripts{$package}; return Xchat::EAT_ALL; @@ -207,7 +256,7 @@ sub find_external_pkg { my $level = 1; while( my @frame = caller( $level ) ) { - return @frame if $frame[0] !~ /^Xchat/; + return @frame if $frame[0] !~ /(?:^IRC$|^Xchat)/; $level++; } @@ -221,10 +270,20 @@ sub find_pkg { $level++; } + my $current_package = get_current_package(); + if( defined $current_package ) { + return $current_package; + } + my @frame = find_external_pkg(); my $location; if( $frame[0] or $frame[1] ) { + my $calling_package = $frame[0]; + if( defined( my $owner = $owner_package{ $calling_package } ) ) { + return $owner; + } + $location = $frame[1] ? $frame[1] : "package $frame[0]"; $location .= " line $frame[2]"; } else { @@ -239,10 +298,6 @@ sub fix_callback { my ($package, $callback) = @_; unless( ref $callback ) { - # change the package to the correct one in case it was hardcoded - $callback =~ s/^.*:://; - $callback = qq[${package}::$callback]; - no strict 'subs'; $callback = \&{$callback}; } @@ -250,4 +305,15 @@ sub fix_callback { return $callback; } +sub get_current_package { + return $current_package; +} + +sub set_current_package { + my $old_package = $current_package; + $current_package = shift; + + return $old_package; +} + 1 diff --git a/plugins/perl/perl.c b/plugins/perl/perl.c index 68789828..87127267 100644 --- a/plugins/perl/perl.c +++ b/plugins/perl/perl.c @@ -317,6 +317,14 @@ array2av (char *array[]) return av; } +/* sets $Xchat::Embed::current_package */ +static void +set_current_package (SV *package) +{ + SV *current_package = get_sv ("Xchat::Embed::current_package", 1); + SvSetSV_nosteal (current_package, package); +} + static int fd_cb (int fd, int flags, void *userdata) { @@ -332,7 +340,9 @@ fd_cb (int fd, int flags, void *userdata) XPUSHs (data->userdata); PUTBACK; + set_current_package (data->package); count = call_sv (data->callback, G_EVAL); + set_current_package (&PL_sv_undef); SPAGAIN; if (SvTRUE (ERRSV)) { @@ -390,7 +400,10 @@ timer_cb (void *userdata) if (data->ctx) { xchat_set_context (ph, data->ctx); } + + set_current_package (data->package); count = call_sv (data->callback, G_EVAL); + set_current_package (&PL_sv_undef); SPAGAIN; if (SvTRUE (ERRSV)) { @@ -447,7 +460,9 @@ server_cb (char *word[], char *word_eol[], void *userdata) PUTBACK; data->depth++; + set_current_package (data->package); count = call_sv (data->callback, G_EVAL); + set_current_package (&PL_sv_undef); data->depth--; SPAGAIN; if (SvTRUE (ERRSV)) { @@ -494,7 +509,9 @@ command_cb (char *word[], char *word_eol[], void *userdata) PUTBACK; data->depth++; + set_current_package (data->package); count = call_sv (data->callback, G_EVAL); + set_current_package (&PL_sv_undef); data->depth--; SPAGAIN; if (SvTRUE (ERRSV)) { @@ -568,7 +585,9 @@ print_cb (char *word[], void *userdata) PUTBACK; data->depth++; + set_current_package (data->package); count = call_sv (data->callback, G_EVAL); + set_current_package (&PL_sv_undef); data->depth--; SPAGAIN; if (SvTRUE (ERRSV)) { @@ -843,31 +862,32 @@ XS (XS_Xchat_hook_server) int pri; SV *callback; SV *userdata; + SV *package; xchat_hook *hook; HookData *data; dXSARGS; - if (items != 4) { + if (items != 5) { xchat_print (ph, - "Usage: Xchat::Internal::hook_server(name, priority, callback, userdata)"); + "Usage: Xchat::Internal::hook_server(name, priority, callback, userdata, package)"); } else { name = SvPV_nolen (ST (0)); pri = (int) SvIV (ST (1)); callback = ST (2); userdata = ST (3); + package = ST (4); data = NULL; data = malloc (sizeof (HookData)); if (data == NULL) { XSRETURN_UNDEF; } - data->callback = sv_mortalcopy (callback); - SvREFCNT_inc (data->callback); - data->userdata = sv_mortalcopy (userdata); - SvREFCNT_inc (data->userdata); + data->callback = newSVsv (callback); + data->userdata = newSVsv (userdata); data->depth = 0; - data->package = NULL; + data->package = newSVsv (package); + hook = xchat_hook_server (ph, name, pri, server_cb, data); XSRETURN_IV (PTR2IV (hook)); @@ -883,26 +903,28 @@ XS (XS_Xchat_hook_command) SV *callback; char *help_text = NULL; SV *userdata; + SV *package; xchat_hook *hook; HookData *data; dXSARGS; - if (items != 5) { + if (items != 6) { xchat_print (ph, - "Usage: Xchat::Internal::hook_command(name, priority, callback, help_text, userdata)"); + "Usage: Xchat::Internal::hook_command(name, priority, callback, help_text, userdata, package)"); } else { name = SvPV_nolen (ST (0)); pri = (int) SvIV (ST (1)); callback = ST (2); - /* leave the help text has NULL if the help text is undefined to avoid + /* leave the help text as NULL if the help text is undefined to avoid * overriding the default help message for builtin commands */ if (SvOK(ST (3))) { help_text = SvPV_nolen (ST (3)); } userdata = ST (4); + package = ST (5); data = NULL; data = malloc (sizeof (HookData)); @@ -910,12 +932,10 @@ XS (XS_Xchat_hook_command) XSRETURN_UNDEF; } - data->callback = sv_mortalcopy (callback); - SvREFCNT_inc (data->callback); - data->userdata = sv_mortalcopy (userdata); - SvREFCNT_inc (data->userdata); + data->callback = newSVsv (callback); + data->userdata = newSVsv (userdata); data->depth = 0; - data->package = NULL; + data->package = newSVsv (package); hook = xchat_hook_command (ph, name, pri, command_cb, help_text, data); XSRETURN_IV (PTR2IV (hook)); @@ -932,30 +952,30 @@ XS (XS_Xchat_hook_print) int pri; SV *callback; SV *userdata; + SV *package; xchat_hook *hook; HookData *data; dXSARGS; - if (items != 4) { + if (items != 5) { xchat_print (ph, - "Usage: Xchat::Internal::hook_print(name, priority, callback, userdata)"); + "Usage: Xchat::Internal::hook_print(name, priority, callback, userdata, package)"); } else { name = SvPV_nolen (ST (0)); pri = (int) SvIV (ST (1)); callback = ST (2); data = NULL; userdata = ST (3); + package = ST (4); data = malloc (sizeof (HookData)); if (data == NULL) { XSRETURN_UNDEF; } - data->callback = sv_mortalcopy (callback); - SvREFCNT_inc (data->callback); - data->userdata = sv_mortalcopy (userdata); - SvREFCNT_inc (data->userdata); + data->callback = newSVsv (callback); + data->userdata = newSVsv (userdata); data->depth = 0; - data->package = NULL; + data->package = newSVsv (package); hook = xchat_hook_print (ph, name, pri, print_cb, data); XSRETURN_IV (PTR2IV (hook)); @@ -990,13 +1010,10 @@ XS (XS_Xchat_hook_timer) XSRETURN_UNDEF; } - data->callback = sv_mortalcopy (callback); - SvREFCNT_inc (data->callback); - data->userdata = sv_mortalcopy (userdata); - SvREFCNT_inc (data->userdata); + data->callback = newSVsv (callback); + data->userdata = newSVsv (userdata); data->ctx = xchat_get_context (ph); - data->package = sv_mortalcopy (package); - SvREFCNT_inc (data->package); + data->package = newSVsv (package); hook = xchat_hook_timer (ph, timeout, timer_cb, data); data->hook = hook; @@ -1012,6 +1029,7 @@ XS (XS_Xchat_hook_fd) SV *callback; int flags; SV *userdata; + SV *package; xchat_hook *hook; HookData *data; @@ -1025,6 +1043,7 @@ XS (XS_Xchat_hook_fd) callback = ST (1); flags = (int) SvIV (ST (2)); userdata = ST (3); + package = ST (4); data = NULL; #ifdef WIN32 @@ -1045,11 +1064,10 @@ XS (XS_Xchat_hook_fd) XSRETURN_UNDEF; } - data->callback = sv_mortalcopy (callback); - SvREFCNT_inc (data->callback); - data->userdata = sv_mortalcopy (userdata); - SvREFCNT_inc (data->userdata); - data->package = NULL; + data->callback = newSVsv (callback); + data->userdata = newSVsv (userdata); + data->depth = 0; + data->package = newSVsv (package); hook = xchat_hook_fd (ph, fd, flags, fd_cb, data); data->hook = hook; @@ -1084,6 +1102,7 @@ XS (XS_Xchat_unhook) if (userdata->package != NULL) { SvREFCNT_dec (userdata->package); } + free (userdata); } XSRETURN (retCount); -- cgit 1.4.1