106 lines
2.7 KiB
Perl
106 lines
2.7 KiB
Perl
# Released into the Public Domain
|
|
use strict;
|
|
use warnings;
|
|
|
|
my $SCRIPT_NAME = 'infolist';
|
|
my $SCRIPT_AUTHOR = 'The Krusty Krab <wowaname@volatile.ch>';
|
|
my $SCRIPT_VERSION = '1.0';
|
|
my $SCRIPT_LICENCE = 'Public domain';
|
|
my $SCRIPT_DESC = "poke into allocated infolists to debug memory leaks";
|
|
|
|
my $HELP = <<'HELP';
|
|
This command allows you to inspect currently allocated infolists by address, so
|
|
you can more easily debug memory leaks. You may also use this command to free
|
|
infolists currently in memory to save you from restarting WeeChat every time you
|
|
encounter a stray infolist.
|
|
HELP
|
|
|
|
my ($SCRIPT_PREFIX, $buffer);
|
|
|
|
if (weechat::register($SCRIPT_NAME, $SCRIPT_AUTHOR, $SCRIPT_VERSION,
|
|
$SCRIPT_LICENCE, $SCRIPT_DESC, '', '')) {
|
|
weechat::hook_command('infolist', $SCRIPT_DESC,
|
|
'[arguments]',
|
|
$HELP, '', 'infolist_cb', '');
|
|
|
|
$SCRIPT_PREFIX = bracket(weechat::color('chat_nick').$SCRIPT_NAME);
|
|
}
|
|
|
|
# -- general functions -- #
|
|
|
|
sub bracket {
|
|
return join('', weechat::color('chat_delimiters'), '[',
|
|
weechat::color('reset'), join(' ', @_),
|
|
weechat::color('chat_delimiters'), ']',
|
|
weechat::color('reset'));
|
|
}
|
|
|
|
sub error {
|
|
weechat::print($buffer, weechat::prefix('error')."$SCRIPT_NAME: ".shift);
|
|
}
|
|
|
|
sub info {
|
|
weechat::print($buffer, "$SCRIPT_PREFIX\t".shift);
|
|
}
|
|
|
|
sub look {
|
|
my ($iptr, $fields) = @_;
|
|
my @rtn;
|
|
for (split ',', $fields) {
|
|
my $item;
|
|
if (/^i:(.+)/) {
|
|
$item .= "i:$1: ".weechat::infolist_integer($iptr, $1);
|
|
} elsif (/^s:(.+)/) {
|
|
$item .= "s:$1: ".weechat::infolist_string($iptr, $1);
|
|
} elsif (/^p:(.+)/) {
|
|
$item .= "p:$1: ".weechat::infolist_pointer($iptr, $1);
|
|
} elsif (/^b:(.+)/) {
|
|
$item .= "b:$1: "#.weechat::infolist_buffer($iptr, $1);
|
|
} elsif (/^t:(.+)/) {
|
|
$item .= "t:$1: ".weechat::infolist_time($iptr, $1);
|
|
}
|
|
push @rtn, $item;
|
|
}
|
|
info(join ', ', @rtn);
|
|
}
|
|
|
|
sub infolist {
|
|
my ($iptr, $cmd) = @_;
|
|
|
|
if ($cmd eq 'ptr') {
|
|
info("looking at $iptr");
|
|
look($iptr, weechat::infolist_fields($iptr));
|
|
} elsif ($cmd eq 'iter') {
|
|
info("itering through $iptr");
|
|
weechat::infolist_reset_item_cursor($iptr);
|
|
look($iptr, weechat::infolist_fields($iptr))
|
|
while (weechat::infolist_next($iptr));
|
|
} elsif ($cmd eq 'free') {
|
|
weechat::infolist_free($iptr);
|
|
info("freed $iptr");
|
|
}
|
|
}
|
|
|
|
sub infolist_cb {
|
|
$buffer = $_[1];
|
|
my $args = $_[2];
|
|
chomp $args;
|
|
|
|
if (!$args) {
|
|
weechat::command('', '/debug infolists');
|
|
} elsif ($args =~ /^(0x[0-9a-f]+) *(.+)/i) {
|
|
infolist($1, $2);
|
|
} elsif ($args =~ /^new *([^ ]*) *([^ ]*|\-) *(.*|\-)/) {
|
|
# let's get a nicklist and leave it open
|
|
my $iptr = weechat::infolist_get(
|
|
$1,
|
|
$2 eq '-' ? '' : $2,
|
|
$3 eq '-' ? '' : $3
|
|
);
|
|
$iptr ? info("infolist created at $iptr") :
|
|
error("error creating infolist");
|
|
}
|
|
|
|
return weechat::WEECHAT_RC_OK;
|
|
}
|