view licq2gaim.pl @ 8448:ebb160ec42af

[gaim-migrate @ 9178] Another rad patch from SimGuy: This patch adds the proper check in to prevent users from sending blank lines, even if they contain markup. It also seems to resolve the problem where in ICQ and MSN, you can't send a smiley if it's alone on a line. I'm not sure why this is fixed so it might have been a coincidence. I took the opportunity to clean up the send_cb function, so it's got some deprecated and/or commented code removed. And hey, if you open an empty conv with someone and click the bold button and then hit enter it gives you a gtk warning. Somebody fix that. Gtk: file gtktextbuffer.c: line 1794 (gtk_text_buffer_get_iter_at_mark): assertion `GTK_IS_TEXT_MARK (mark)' failed committer: Tailor Script <tailor@pidgin.im>
author Mark Doliner <mark@kingant.net>
date Mon, 15 Mar 2004 01:44:39 +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);
}