view licq2gaim.pl @ 10345:2e01c503aa4f

[gaim-migrate @ 11556] Patch 1078151 from Felipe Contreras to fix some more MSN bugs: "User Dislpay messages, and other less used, did not set an slpcall, so the callback that should not be called, was called (in some very special cases)." ... "Here it goes the real real one, as far as I can tell. Cleaning + organizing + documentation + hard bug fix = big patch." -- Felipe Contreras I also fixed drag-and-drop to conversation window file transfers (which I had broken when I fixed some other dnd thing), made the debug output of the autoreconnect plugin more useful, and stopped the message notification plugin notifying you for messages sent by ignored users. committer: Tailor Script <tailor@pidgin.im>
author Stu Tomlinson <stu@nosnilmot.com>
date Sat, 11 Dec 2004 20:01:58 +0000
parents e967c0d93930
children
line wrap: on
line source

#!/usr/bin/perl -w
# licq2gaim.pl
#
# Arturo Cisneros, Jr <acjr@hal-pc.org>
# GPL'd

use strict;

my $DIR = "$ENV{HOME}/.licq";
my $GAIM = "$ENV{HOME}/.gaim";
my (@UINS, %USERS) = ();
my $OWNER = "";


get_uins();

foreach my $uin (@UINS) {
	$USERS{$uin} = get_alias($uin);
}

get_owner();
write_list();


sub get_uins {

	opendir(DIR, "$DIR/users") or die "Couldn't open dir $DIR/users/: $!";
	@UINS = grep !/^\./, readdir DIR;
	closedir(DIR);
}

sub get_owner {

	my @foo = ();

	open(FILE, "<$DIR/owner.uin") or die "Couldn't open file $DIR/owner.uin $!";
	while(<FILE>) {
		next unless /^Uin/;
		@foo = split;
		last;
	}
	close(FILE);

	$OWNER = $foo[2];
}

sub get_alias {

	my @foo = ();

	open(FILE, "<$DIR/users/$_[0]") or die "Couldn't open $DIR/users/$_[0]: $!";
	while(<FILE>) {
		next unless /^Alias/;
		@foo = split / /, $_, 3;
		last;
	}
	close(FILE);

	return $foo[2];
}

sub write_list {

	# Backup Original
	if( -e "$GAIM/$OWNER.3.blist") {
		rename("$GAIM/$OWNER.3.blist","$GAIM/$OWNER.3.bak");
	}

	# Write new file
	open(FILE, ">$GAIM/$OWNER.3.blist") or die "Couldn't open file for writing: $!";
	print FILE "m 1\n";
	print FILE "g ICQBuddies\n";
	while(my($key, $value) = each %USERS) {
		$key =~ s/\.uin$//;
		print FILE "b $key:$value";
	}
	close(FILE);
}