Merge pull request #281 from efuce/tinyurl-http-tiny

Updated tinyurl.pl to work with recent perl and tinyurl.com versions

2 files changed, 24 insertions, 46 deletions

diff --git a/_data/scripts.yaml b/_data/scripts.yaml
index 0d384cd..bf8588f 100644
--- a/_data/scripts.yaml
+++ b/_data/scripts.yaml
@@ -4312,10 +4312,10 @@
   description: 'create a tinyurl from a long one'
   filename: tinyurl.pl
   license: GPL
-  modified: '2008-08-29 13:51:48'
-  modules: LWP::UserAgent
+  modified: '2016-06-15 22:48:48'
+  modules: WWW::Shorten
   name: tinyurl
-  version: '1.0'
+  version: '1.1'
 -
   authors: 'Timo Sirainen, David Leadbeater'
   contact: 'tss@iki.fi, dgl@dgl.cx'
diff --git a/scripts/tinyurl.pl b/scripts/tinyurl.pl
index 31a097b..6e6c1c9 100644..100755
--- a/scripts/tinyurl.pl
+++ b/scripts/tinyurl.pl
@@ -3,17 +3,17 @@
 # by Atoms
 
 use strict;
-use IO::Socket;
-use LWP::UserAgent;
+use WWW::Shorten::TinyURL;
+use WWW::Shorten 'TinyURL';
 
 use vars qw($VERSION %IRSSI);
 
 use Irssi qw(command_bind active_win);
-$VERSION = '1.0';
+$VERSION = '1.1';
 %IRSSI = (
     authors	=> 'Atoms',
     contact	=> 'atoms@tups.lv',
-	patch   => 'spowers@dimins.com',
+    patch   => 'spowers@dimins.com',
     name	=> 'tinyurl',
     description	=> 'create a tinyurl from a long one',
     license	=> 'GPL',
@@ -21,50 +21,28 @@ $VERSION = '1.0';
 
 command_bind(
     tinyurl => sub {
-      my ($msg, $server, $witem) = @_;
-      my $answer = tinyurl($msg);
-      if ($answer) {
-        print CLIENTCRAP "$answer";
-        if ($witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) {
-  	      $witem->command("MSG " . $witem->{name} ." ". $answer);
+        my ($msg, $server, $witem) = @_;
+        my $answer = tinyurl($msg);
+        
+        if ($answer) {
+            print CLIENTCRAP "$answer";
+
+            if ($witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) {
+  	            $witem->command("MSG " . $witem->{name} ." ". $answer);
+            }
         }
-      }
     }
 );
 
 sub tinyurl {
-	my $url = shift;
-        
-        #added to fix URLs containing a '&'
-        $url=url_encode($url);
+    my $url = shift;
 
-  my $ua = LWP::UserAgent->new;
-  $ua->agent("tinyurl for irssi/1.0 ");
-  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) {
-	  return get_tiny_url($res->content);
-  } else {
-    print CLIENTCRAP "ERROR: tinyurl: tinyurl is down or not pingable";
-		return "";
-	}
-}
+    my $res = makeashorterlink($url);
 
-#added because the URL was not being url_encoded. This would cause only 
-#the portion of the URL before the first "&" to be properly sent to tinyurl.
-sub url_encode {
-        my $url = shift;
-        $url =~ s/([\W])/"%" . uc(sprintf("%2.2x",ord($1)))/eg;
-        return $url;
-}
-
-sub get_tiny_url($) {
-	
-	my $tiny_url_body = shift;
-	$tiny_url_body =~ /(.*)(tinyurl\svalue=\")(.*)(\")(.*)/;
-
-	return $3;
+    if (defined $res) {
+        return $res;
+    } else {
+        print CLIENTCRAP "ERROR: tinyurl: tinyurl is down or not pingable";
+        return "";
+    }
 }