view libpurple/plugins/perl/scripts/function_list.pl @ 24865:fbfbebc9197e

Fix two related bugs: 1. When renaming a group and only changing capitalization, Pidgin prompted you "You are about to merge "Some Group" and "some group" 2. When renaming a group and only changing capitalization, libpurple got into an infinite loop because the dest and source groups were the same, and it tried to add buddies to itself until itself was empty. This resulted in increasing memory and 100% CPU utilization until the process was killed. Did we recently change purple_find_group() to be case insensitive or something?
author Mark Doliner <mark@kingant.net>
date Mon, 22 Dec 2008 22:01:34 +0000
parents fab49a6e9b25
children
line wrap: on
line source

$MODULE_NAME = "List all Purple:: (and Pidgin::) functions";
use Purple;
# Uncomment this to print the Pidgin:: functions as well.
#use Pidgin;

# All the information Purple gets about our nifty plugin
%PLUGIN_INFO = (
	perl_api_version => 2,
	name             => "Perl: $MODULE_NAME",
	version          => "0.1",
	summary          => "Print to standard output all the functions under the Purple:: (and Pidgin::) packages",
	description      => "Print to standard output all the functions under the Purple:: (and Pidgin::) packages",
	author           => "Etan Reisner <deryni\@gmail.com>",
	url              => "http://sourceforge.net/users/deryni9/",
	id               => "functionlist",

	load             => "plugin_load",
	unload           => "plugin_unload"
);

sub plugin_init {
	return %PLUGIN_INFO;
}

sub print_array {
	my $array = shift;

	my @arr = sort @$array;
	foreach $mod (@arr) {
		my @sub;

		foreach $key (sort keys %{$mod}) {
			if ($key =~ /::$/) {
				push @sub, "$mod$key";
			} else {
				print "$mod$key\n";
			}
		}
		print_array(\@sub);
	}
}

sub plugin_load {
	my $plugin = shift;
	my @purplearray;
	my @pidginarray;

	foreach $key (sort keys %Purple::) {
		if ($key =~ /::$/) {
			push @purplearray, "Purple::$key";
		} else {
			print "Purple::$key\n";
		}
	}
	print_array(\@purplearray);

	foreach $key (sort keys %Pidgin::) {
		if ($key =~ /::$/) {
			push @pidginarray, "Pidgin::$key";
		} else {
			print "Pidgin::$key\n";
		}
	}
	print_array(\@pidginarray);
}

sub plugin_unload {
	my $plugin = shift;
}