inital commit
[irssi-scripts.git] / rdrto.pl
1 #!/usr/bin/perl
2 #
3 # by CowboyNeal
4 #
5
6 use strict;
7
8 use LWP::UserAgent;
9 use Irssi qw(command_bind);
10
11 use vars qw($VERSION %IRSSI);
12
13 $VERSION = '1.0';
14 %IRSSI = (
15         authors         => 'CowboyNeal',
16         contact         => 'cowboyneal@gmail.com',
17         name            => 'rdrto',
18         description     => 'create a rdr.to link from a long one',
19         license         => 'GPL',
20 );
21
22 command_bind(rdr => sub {
23         my ($msg, $server, $witem) = @_;
24
25         $msg =~ s/(http:\/\/\S+)/rdrto($1)/egi;
26
27         if ($msg && $witem && ($witem->{type} eq 'CHANNEL'
28                 || $witem->{type} eq 'QUERY')) {
29                 $witem->command('MSG ' . $witem->{name} . " $msg");
30         }
31 });
32
33 sub rdrto {
34         my $url = shift;
35         
36         # fix URLs containing a '&'
37         $url =~ s/([\W])/'%' . uc(sprintf('%2.2x',ord($1)))/eg;
38         return $url if $url =~ m/^http:\/\/rdr\.to\//i;
39
40         my $ua = LWP::UserAgent->new;
41         $ua->agent("rdr.to for irssi/$VERSION");
42         my $req = HTTP::Request->new(POST => 'http://rdr.to/');
43         $req->content_type('application/x-www-form-urlencoded');
44         $req->content("url=$url");
45         my $res = $ua->request($req);
46
47         if ($res->is_success) {
48                 $res->content =~ /(.*)(holdtext\.innerText=\")(.*)(\";)(.*)/;
49                 return $3;
50         } else {
51                 print CLIENTCRAP 'ERROR: rdrto: rdr.to is not responding.';
52                 return $url;
53         }
54 }