#!/usr/bin/perl -w

use strict;
use vars qw($VERSION %IRSSI);

$VERSION = "20041007";

%IRSSI = (
	authors					=>	"eo",
	contact					=>	'irssi@eosin.org',
	name						=>	"shorturl.pl",
	description			=>	"Public url reduction script.",
	license					=>	"GPLv2",
	changed					=>	"$VERSION"
);

use Irssi;
use Irssi::Irc;
#
# If you dont have either of these,
# I suggest: perl -MCPAN -e 'install "Bundle::LWP" '
# or whatever perl module install method you find
# suitable.
use LWP::Simple;
use LWP::UserAgent;

# Each one of these have different methods of 
# getting a url back. So dont go adding any 
# others unless you wish to write in the retrieval
# code for it. Or email me. -
my @lookups = (
	"metamark",
	"tinyurl"
);

# settings.. this script will translate urls for any channel
# unless you /set shorturl_chans inside irssi.
# the list of channels must be separated by commas
# example: #linuxhelp,#news,#yowser 
# or for one channel only: #linuxhelp
# no comma needed.
#

# Max chars per url. No sense in translating already short urls :)
my $minurllen = 35;

# Debug (just says when a translation is done and what channel its on)
my $debug = 1;

sub GotUrl {
	my ($server, $data, $nick, $addr, $target) = @_;
	return unless(goodchan($target));	
	$data =~ s/^\s+//;
	$data =~ s/\s+$//;
	my @urls = ();
	my ($url, $a, $return, $char, $ch, $result, $choice) = "";;
	my $same = 0;
	my $sitewas = "t";
	my @chars = ();

	return unless ($data =~ /\bhttp\:/);

	# split on whitespace and get the url(s) out
	# done this way in case there are more than 
	# one url per line.
	foreach(split(/\s/, $data)) {
		if ($_ =~ /^http\:/){
			foreach $a (@urls) {
				if ($_ eq $a) {
					# incase they use the same url on the line.
					$same = 1;
					next;
				}
			}

			if ($same == 0) {
				$same = 0;
				push(@urls, $_);
			}
		}
	}

	# Go through the resulting urls
	foreach (@urls) {

		#Minimum url length.
		return unless (count($_) > $minurllen);
		@chars = split(//, $_);
		
		# Originally I used uri_escape() for this
		# But tinyurl didnt like it.. might be because
		# of the post method I was using at the time.
		foreach $char (@chars) {
			if ($char !~ /[A-Za-z0-9]/) {
				$ch = sprintf("%%%02x",ord($char));
				$result .= $ch;
			} else {
				$result .= $char;
			}
		}

		deb("url for $target");
		# Get a random provider from the list.
		$choice = $lookups[ rand(@lookups) ];
		if ($choice eq "metamark") {
			$url = "http://metamark.net/api/rest/simple?long_url=" . $result;
			eval { $return = get($url) };
			next unless ($return);
			next if ($return =~ /ERROR\:/);
			$server->command("msg $target $return");
		} else {
			tinyurl($server, $target, $result);
		}
		
	}
	return;
}

# Had to add this function to fetch tiny url's as 
# Apparently fetching without either a useragent
# or not using the POST method makes tinyurl do 
# some not very nice redirects.
sub tinyurl {
	my ($server, $chan, $url) = @_;
 	my $ua = LWP::UserAgent->new;
  my $nurl;

	$ua->agent("tinyurl for irssi/1.1 ");
  	
	my $req = HTTP::Request->new(POST => 'http://tinyurl.com/create.php');
  	$req->content_type('application/x-www-form-urlencoded');
  	$req->content("url=$url");
  	
	my $res = $ua->request($req);

 	if ($res->is_success) {
		$nurl = $res->content;

		$nurl =~ /(.*)(tinyurl\svalue=\")(.*)(\")(.*)/;
		$server->command("msg $chan $3");
	}
}

# conditinal print.
sub deb($) {
	Irssi::print(shift) if ($debug == 1);
}

# returns the character count.
sub count($) {
	my @array = split(//, shift);
	return($#array + 1);
}

# Checks if we should be translating 
# urls for the requesting channel.
# returns True if the list is not set
# thus, it will translate for ALL channels.
# returns True if channel matches one in the list.
# returns undef otherwise.
sub goodchan {
	my $chan = shift;
	my $list = Irssi::settings_get_str("urlshort_chans");
	return("OK") if (! $list);
	foreach(split(/\,/, $list)) {
		return("$_") if ($_ =~ /$chan/i);
	}
	return undef;
}

Irssi::signal_add_last("message public", "GotUrl");
Irssi::signal_add_last("ctcp action", "GotUrl");
Irssi::settings_add_str("urlshort", "urlshort_chans", "");