SoniEx2
/
c.sexchat
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Update XChat to r1514

This commit is contained in:
Berke Viktor 2012-07-13 20:16:10 +02:00
parent d563f64ab8
commit ed0e530b79
4 changed files with 156 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
ChangeLog
View File

@ -32,6 +32,10 @@ highlights. The full CVS log is available at www.xchat.org/cvslog/
* Fixed a bug in the reinit handling code. The bug prevented the plugin from
cleaning up properly. Which includes unloading scripts and removing
their GUI entries.
* Remove the restriction on having only 1 package per script. Any inner
packages declared will also be unloaded when the script is unload. If
multiple script declare an inner package with the same name then unloading
or reloading one of those scripts will cause problems.
------------------------------------------------------------------------------
2.8.8 - 30/May/2010

15
plugins/perl/lib/Xchat.pm
View File

@ -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;

120
plugins/perl/lib/Xchat/Embed.pm
View File

@ -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} ) {
@ -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

85
plugins/perl/perl.c
View File

@ -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);