Hi,
The URL given by Jonas works again, here's the diff to the version in
irssi-scripts 20090810. It's mostly whitespace, but at the end there's a
comment about "tinyurl.com changed their HTML output" and a changed
regex. I didn't test either version, however.
HTH,
Jan
--
() ascii ribbon campaign - against html e-mail
/\ www.asciiribbon.org - against proprietary attachments
--- /usr/share/irssi/scripts/tinyurl.pl 2009-08-10 22:23:07.000000000 +0200
+++ tinyurl.pl 2010-01-04 19:54:53.000000000 +0100
@@ -1,6 +1,8 @@
#!/usr/bin/perl
#
-# by Atoms
+# Maintained by Stuart Powers
+# [email protected]
+# http://sente.cc/misc/tinyurl.pl
use strict;
use IO::Socket;
@@ -9,62 +11,60 @@
use vars qw($VERSION %IRSSI);
use Irssi qw(command_bind active_win);
-$VERSION = '1.0';
+$VERSION = '1.1';
%IRSSI = (
- authors => 'Atoms',
- contact => '[email protected]',
- patch => '[email protected]',
- name => 'tinyurl',
- description => 'create a tinyurl from a long one',
- license => 'GPL',
+ authors => 'Stuart Powers, previously Atoms',
+ contact => '[email protected]',
+ name => 'tinyurl',
+ description => 'create a tinyurl from a long one',
+ license => 'GPL',
);
command_bind(
- tinyurl => sub {
+ 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);
- }
+ 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 $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 $url = shift;
+
+ #added to fix URLs containing a '&'
+ $url=url_encode($url);
+
+ 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 "";
+ }
}
-#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.
+#added because the URL was not being url_encoded. This would cause URLS
+#which contained &'s and other characters to not be properly sent
sub url_encode {
- my $url = shift;
- $url =~ s/([\W])/"%" . uc(sprintf("%2.2x",ord($1)))/eg;
- return $url;
+ my $url = shift;
+ $url =~ s/([\W])/"%" . uc(sprintf("%2.2x",ord($1)))/eg;
+ return $url;
}
-
+#added because tinyurl.com changed their HTML output
sub get_tiny_url($) {
-
- my $tiny_url_body = shift;
- $tiny_url_body =~ /(.*)(tinyurl\svalue=\")(.*)(\")(.*)/;
-
- return $3;
+ my $tiny_url_body = shift;
+ $tiny_url_body =~ />(\w*?:\/\/)preview.(tinyurl.com\/.*?)</;
+ return "$1$2";
}
