#  shorten
#
#  Created by Tamara Temple on 2010-05-10.
#  Copyright (c) 2010 Tamara Temple Development. All rights reserved.
#

use Irssi qw(command_bind);
use Data::Dumper::Names;
use URI::Escape;
#use LWP::UserAgent;					# Using curl(1) now.

use strict;
use vars qw($VERSION %IRSSI $URL_LENGTH_THRESHHOLD $BITLY_LOGIN $BITLY_APIKEY $TPTGO_SIGNATURE);

$VERSION = "2.0";

%IRSSI = (
    authors     => 'Tamara Temple',
    contact     => 'tamouse@gmail.com',
    name        => 'shorten',
    description => 'shorten urls with tptgo.us',
    license     => 'GPLv2',
);

my $debug = 0;

sub debug ($) {
	my $msg = shift;
	Irssi::active_win()->print("%Y$IRSSI{name} %R[DEBUG] %Y".irc_safe($msg)) if $debug;
}

$URL_LENGTH_THRESHHOLD = 50;
#$BITLY_LOGIN = "tamouse";
#$BITLY_APIKEY = "R_c3edbed08b5b15460f677725b9035e72";
$TPTGO_SIGNATURE = '0715fe6819';

my $empty_re = qr/^\s*$/;

sub irc_safe {
	my ($s) = @_;
	return undef if (!$s || $s =~ $empty_re);
	$s =~ s/%/%%/g;
	return $s;
}



sub fetchurl ($) {
	my ($url) = @_;
	return undef if (!$url || $url =~ $empty_re);
	my $cmd='curl --max-time 10 --fail --connect-timeout 5 --user-agent "Irssi '.$IRSSI{name}.'" --silent '."\'".$url."\'";
	debug("cmd=$cmd");
	my $content;								# declare $content before using it in next statement. ah, strict.
	chomp($content=`$cmd`);
	return $content;
	
}

sub extracturl ($) {	
	my ($text) = @_;
	return undef if (!$text || $text =~ $empty_re);
	
	if($text =~ /\b((ftp|https?):\/\/[a-zA-Z0-9\/\\\:\?\%\.\&\;=#\-\_\!\+\~\,]*)/i){
		debug("extracturl first match \$1=$1");
	  return $1;
   }elsif($text =~ /\b(www\.[a-zA-Z0-9\/\\\:\?\%\.\&\;=#\-\_\!\+\~\,]*)/i){
		debug("extracturl second match: \$1=$1");
	  return "http://".$1;
   }
   return undef;
   
}

sub shorten {
	my ($url) = @_;
	return undef if (!$url || $url =~ m!(^http://tptgo.us/|^\s*$)!) ;
	
	my $opaque_url = uri_escape($url);
	debug("opaque_url=$opaque_url");
	
#	my $biturl = "http://api.bit.ly/v3/shorten?login=" . $BITLY_LOGIN . "&apiKey=" . $BITLY_APIKEY . "&uri=" . $opaque_url . "&format=txt";
	my $tptgourl = 'http://tptgo.us/yourls-api.php?signature='.$TPTGO_SIGNATURE.'&action=shorturl&url='.$opaque_url.'&format=simple';

#	Irssi::active_win()->print("$IRSSI{name} \$biturl = " . irc_safe($biturl)) if $debug;
	debug("tptgourl=$tptgourl");

	my $content = fetchurl($tptgourl);
	chomp($content);
	return $content;

}

my %debugOptions = (
	'on' => 1,
	'off' => 0
);

sub cmd_shortendebug {
	my ($data, $server, $witem) = @_;

	$debug = $debugOptions{lc $data} || !$debug;
	

}

sub cmd_shorten {
	my ($data, $server, $witem) = @_;
	my $shorturl = irc_safe(shorten(extracturl($data)));
	return undef if (!$shorturl || $shorturl =~ $empty_re);
	if ($shorturl =~ /\<HTML\>/i) {
		$witem->print("%RBad return from tptgo.us for ".irc_safe($data));
	} else {
		$witem->print("Short Url: %Y" . $shorturl);
	}

}

sub sig_publicmsg {
	my ($server, $msg, $nick, $address, $target) = @_;
	$target = $nick if $target eq "";

	my $url = extracturl($msg);
	if (($url) && (length($url) > $URL_LENGTH_THRESHHOLD)) {
		my $shorturl = irc_safe(shorten($url));
		return undef if (!$url || $url =~ $empty_re);
		if ($shorturl =~ /\<HTML\>/i) {
			$server->print($target,"%RBad return from tptgo.us for ".irc_safe($url));
			return;
		}
		$server->print($target,"Short URL: %Y" . $shorturl);
	} else {
		$server->print($target,"Too short") if $url && $debug;
	}

}

Irssi::signal_add_last("message public", "sig_publicmsg");
Irssi::signal_add_last("message private", "sig_publicmsg");

Irssi::command_bind('shorten', 'cmd_shorten');
Irssi::command_bind('shortendebug', 'cmd_shortendebug');

Irssi::active_win()->print($IRSSI{name} . ' ' . $VERSION . ' loaded.');