diff options
Diffstat (limited to 'scripts/tinyurl.pl')
| -rwxr-xr-x[-rw-r--r--] | scripts/tinyurl.pl | 67 |
1 files changed, 19 insertions, 48 deletions
diff --git a/scripts/tinyurl.pl b/scripts/tinyurl.pl index d1ecf84..829ee74 100644..100755 --- a/scripts/tinyurl.pl +++ b/scripts/tinyurl.pl @@ -3,7 +3,8 @@ # by Atoms use strict; -use HTTP::Tiny; +use WWW::Shorten::TinyURL; +use WWW::Shorten 'TinyURL'; use vars qw($VERSION %IRSSI); @@ -20,58 +21,28 @@ $VERSION = '1.1'; 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; - my $content = "url=$url"; - - #added to fix URLs containing a '&' - $url=url_encode($url); - - my %options = ( - agent => "tinyurl for irssi/1.0 " - ); - - my %form_params = ( - url => $url - ); - - my $ua = HTTP::Tiny->new(%options); - my $res = $ua->request('POST', 'http://tinyurl.com/create.php', { - content => $content, - headers => { 'content-type' => 'application/x-www-form-urlencoded' }, - }); + my $url = shift; - if ($res->{success}) { - return get_tiny_url($res->{content}); - } else { - print CLIENTCRAP "ERROR: tinyurl: tinyurl is down or not pingable"; - return ""; - } -} - -#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; -} + my $res = makeashorterlink($url); -sub get_tiny_url($) { - - my $tiny_url_body = shift; - $tiny_url_body =~ /(.*)(data\-clipboard\-text=\")(.*)(\")(.*)/; - - return $3; + if (defined $res) { + return $res; + } else { + print CLIENTCRAP "ERROR: tinyurl: tinyurl is down or not pingable"; + return ""; + } } |
