diff --git a/scripts/infolist.pl b/scripts/infolist.pl new file mode 100644 index 0000000..4564504 --- /dev/null +++ b/scripts/infolist.pl @@ -0,0 +1,103 @@ +# Released into the Public Domain +use strict; +use warnings; + +my $SCRIPT_NAME = 'infolist'; +my $SCRIPT_AUTHOR = 'The Krusty Krab '; +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('irc_nick', '', + weechat::buffer_get_string($buffer, 'localvar_server').','. + weechat::buffer_get_string($buffer, 'localvar_channel')); + $iptr ? info("infolist created at $iptr") : + error("error creating infolist"); + } + + return weechat::WEECHAT_RC_OK; +}