#!/usr/bin/perl -w

my $APP  = 'AutoMSN Emoticon Scraper v1.1.2';
my $AUTH = 'Alex Ibrado <alex@kdex.org>';

use strict;
use IO::Socket;

print <<END;
$APP
$AUTH

This program connects to messenger.msn.com, downloads the emoticons,
and sets them up for use in e.g. Kopete.
END

my $ch = '';
print "Proceed? [Y/N] ";
do {
	chomp ($ch = <>);
	$ch = lc($ch);
} while($ch !~ /^[yn]$/);

if($ch ne 'y') {
	exit;
}

my $destdir = shift || '';
my $default = "/share/emoticons/AutoMSN";
my $default33 = "/share/apps/kopete/pics/emoticons/AutoMSN";

my $dir = tempdir('automsn-XXXXXX'); 

my $istrings = {};
my $xml = <<END;
<?xml version="1.0"?>
<messaging-emoticon-map>
END

print "\nRetrieving emoticons...\n";

my $cnt = 0;
my $html = geturl('http://messenger.msn.com/resource/emoticons.aspx');
$xml .= buildset($dir, \$istrings, $html, \$cnt) if $html;

$xml .= "</messaging-emoticon-map>\n";

if(open(XML, ">$dir/emoticons.xml")) {
	print XML $xml;
	close(XML);
} else {
	print "Unable to save xml file\n";
	exit;
}

if(!$destdir) {
	chomp(my $global = `kde-config --prefix`);
	chomp(my $local = `kde-config --localprefix`);

	my $kde = `kde-config --version`;
	if($kde =~ /KDE: 3\.(\d)/s) {
		$default = $default33 if $1 < 4;
	}
	$global .= $default;
	$local .= $default;
	$local =~s#//#/#;

	$ch = '';
	do {
		print <<END;

Select destination:
1 $local
2 $global
3 ./$dir
4 Custom
END
		print "> ";
		chomp($ch = <>);
	} while($ch !~ /^[1-4]$/);

	$_ = $ch;
	SWITCH : {
		/1/ && do { $destdir = $local; last SWITCH };
		/2/ && do { $destdir = $global ; last SWITCH };
		/3/ && do { $destdir = $dir; last SWITCH };
		/4/ && do {
			print "Enter destination: ";
			chomp($destdir = <>);
		}
	}
}

if($destdir) {
	if($ch != 3) {
		system("mkdir -p $destdir");
		system("mv -f $dir/* $destdir/");
		rmdir "$dir";
	}
	print "\n$cnt smileys saved in $destdir\n";
	if($ch < 3) {
		print "To activate, go to Settings/Configure Kopete.../Appearance/Emoticons/AutoMSN\n";
		print "You may need to switch out of, and back into, the theme.\n";
	}
} else {
	print "No destination specified\n";
}


sub unescape {
	my ($str) = @_;

	$str =~ s/&amp;/\&/g;
	$str =~ s/&gt;/>/g;
	$str =~ s/&lt;/</g;
	$str =~ s/&quot;/\"/g;
	$str =~ s/&apos;/\'/g;

	return $str;
}

sub escape {
	my ($str) = @_;

	$str =~ s/\&/&amp;/g;
	$str =~ s/>/&gt;/g;
	$str =~ s/</&lt;/g;
	$str =~ s/\"/&quot;/g;
	$str =~ s/\'/&apos;/g;

	return $str;
}

sub addstring {
	my ($sref, $str) = @_;
	my $tmp = '';

	$str = escape($str);
	if(!defined($$sref->{$str})) {
		$tmp .= "\t<string>$str</string>\n";
		$$sref->{$str} = 1;
	}
	return $tmp;
}

sub addgroup {
	my ($sref, $str) = @_;
	my $tmp = '';

	my $top = unescape($str);
	$tmp .= addstring($sref, uc($top));
	$tmp .= addstring($sref, lc($top));

	my @eyes = ( ':', ';', '%', '8' );
	foreach my $eye (@eyes) {
		if($str =~ /^(.*)$eye([^\-]+)$/) {
			my ($crown, $mouth) = ($1, $2);
			my $alt = unescape($crown.$eye.'-'.$mouth);
			$tmp .= addstring($sref, uc($alt));
			$tmp .= addstring($sref, lc($alt));
		}

		if($str =~ /^(.*)$eye\-(.+)$/) {
			my ($crown, $mouth) = ($1, $2);
			my $alt = unescape($crown.$eye.$mouth);
			$tmp .= addstring($sref, uc($alt));
			$tmp .= addstring($sref, lc($alt));
		}

	}
	return $tmp;
}

sub buildset {
	my ($dir, $sref, $set, $cref) = @_;

	my %eset = ();

	while($set =~ m#<img src="(emoticons/[^"]+)"></td><td>(.*?)</td><td>(.*?)</td>#sg) {
		my ($img, $origdesc, $str) = ($1, $2, $3);

		$str =~ s/<\/?nobr>//g;
		$str =~ s/<\/?span.*?>//g;
		$str =~ /^([^\s]+)/;
		$str = $1;

		$origdesc =~ s/[^a-z]//gi;
		my $desc = lc($origdesc);

		my $gif = geturl("http://messenger.msn.com/resource/$img");
		if($gif) {
			my $cnt = 0;
			
			while(-e "$dir/automsn_$desc") {
				$cnt++;
				$desc = $origdesc . $cnt;
			}

			if(open(GIF, ">$dir/automsn_$desc.gif")) {
				print GIF $gif;
				close(GIF);

				my $ustr = unescape($str);
				print "  $desc $ustr\n";	
				my $tmp = '';
				$tmp .= qq(<emoticon file="automsn_$desc">\n);
				$tmp .= addgroup($sref, $str);
				$tmp .= qq(</emoticon>\n);
				$eset{$desc} = $tmp;
			}
		}
	}

	my @sorted = sort { $a cmp $b } keys %eset;

	my $xml = '';
	foreach my $emoticon (@sorted) {
		$xml .= $eset{$emoticon};
	}

	$$cref += scalar(@sorted);
	return $xml;
}

sub tempdir {
	my ($pat) = @_;

	$pat =~ /^(.*?)(X+)(.*?)$/;
	my ($pre, $x, $post) = ($1, $2, $3);
	my $rnd = length($x) || 4;

	my @set = ('A'..'Z', 'a'..'z', '0'..'9');
	my $td = '';
	do {
		my $xs = ( join '', map $set[rand @set], 0..$rnd );
		$td = $pre . $xs . $post;
	} while(-e "$td");

	mkdir "$td";
	return $td;
}

sub geturl {
	my ($url, $cookies) = @_;
	$cookies = '' if !defined($cookies);

	$url =~ m#http://([^/:]+):?(\d*)(/.*)$#;
	my ($host, $port, $path) = ($1, $2, $3);
	$port = 80 if !$port;

	my $client = IO::Socket::INET->new(PeerAddr => "$host:$port");
	die "Cannot connect to $host:$port" unless $client;

	print $client "GET $path HTTP/1.0\r\n";
	print $client "User-Agent: Mozilla/5.0 (compatible; AES/1.1.2; Linux)\r\n";
	print $client "Host: $host\r\n";
	print $client $cookies if $cookies;
	print $client "\r\n";

	my $response = "";
	while(<$client>) {
		$response .= $_;
	}
	close($client);

	$response =~ /^(.*?)\r?\n\r?\n(.+)$/s;
	my ($head, $body) = ($1, $2);

	if($response =~ m#^HTTP/\d\.\d 302#s) {
		$head =~ /Location: (\S+)/s;
		my $newurl = $1 || '';
		if($newurl) {
			$newurl = "http://$host:$port".$newurl;
			my $cookies = '';
			while($head =~ /Set-(Cookie: [^\r\n]+\r?\n)/sg) {
				$cookies .= $1;
			}
			return geturl($newurl, $cookies);
		} else {
			print "Cannot redirect $url\n";
			return '';
		}
	} elsif($response !~ m#^HTTP/\d\.\d 200#s) {
		print "Unable to read $url\n";
		return '';
	} else {
		return $body;
	}
}