From dd7199ea5b56b16b3d0dfe385ddac38f1b0a6841 Mon Sep 17 00:00:00 2001
From: wowaname <wowaname@volatile.ch>
Date: Sat, 20 Aug 2016 10:20:43 +0000
Subject: [PATCH] infolist.pl added

infolist.py exists, but this script seems to be much simpler
---
 scripts/infolist.pl | 103 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 103 insertions(+)
 create mode 100644 scripts/infolist.pl

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 <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('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;
+}