urltitle.pl for irssi

# originally posted by FourOhFour: http://paste.lisp.org/display/58040
# with message:
# stupid url titling script for irssi
# I place this into the public domain. If it breaks, bite me.
#
# modified by chiman 7/2009

use Irssi;
use Irssi::Irc;
use LWP::UserAgent;
use HTML::Entities;

use warnings;
use strict;

our %title_cache;

sub pubmsg {
        my $max_width = 99;
        my ($server, $data, $nick, $mask, $target) = @_;

        if($data =~ m{(?:^|\s)((?:http://)?([^/@\s>]+\.
                                     (com|org|net|edu|gov|mil|int
                                                |biz|pro|info|aero|coop|name
                                                |museum|[a-z][a-z]))
                                         [^\s>]*)}ix
        ) {
                my ($url, $domain) = ($1, lc($2));

                if($url !~ m/^http/) {
                        $url = 'http://' . $url;
                }

                # files and people to ignore
                if($url !~ m{\.(?:jpe?g|gif|png|tiff?|m?pkg|zip|sitx?|.ar|pdf|gz|bz2|7z|txt|js|css|mp.|aiff?|wav|snd|mod|m4a|m4p|wma|wmv|ogg|swf|mov|mpe?g|avi)$}i
                        && $nick !~ m{(?:Bot|Serv)$}i
                ) {
                        my $title = get_title($url);

                        if(length($title) > $max_width) {
                                #$title = substr($title, 0, $max_width-3) . '...';
                                $title = substr($title, 0, $max_width-1) . "\x{2026}";
                        }

                        # try to figure out if the title is just a pretty version of
                        # the URL.
                        my $baretitle = lc($title);
                        $baretitle =~ s/\W//ig; # strip all except letters and nubmers
                        $domain =~ s/www\.//;
                        $domain =~ s/\.(?:com|org|net|edu|gov|mil|int|biz|pro|info|aero|coop|name|museum|\w\w)//;
                        $baretitle =~ s/\.(?:com|org|net|edu|gov|mil|int|biz|pro|info|aero|coop|name|museum|\w\w)//;

                        if($title !~ m/^\s*$/ && $baretitle ne $domain) {
                                $server->command("msg $target Title: $title");
                                # $server->print($target, $title);
                        }
                }
        }
}

sub get_title {
        my ($url) = @_;

        if(defined $title_cache{$url}) { return $title_cache{$url}; }

        my $ua = LWP::UserAgent->new(
                max_size => 3000,
                timeout => 2,
                protocols_allowed => ['http'],
                agent => "Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.9.1.4) Gecko/20091028 Ubuntu/9.10 (karmic) Firefox/3.6.1234",
        );

        my $resp = $ua->get($url,
                Range => "0-2000");

        if($resp->decoded_content() =~ m|<title>([^<]*)</title>|i) {
                my $title = $1;

                decode_entities($title);

                $title =~ s/\s+/ /g;
                $title =~ s/^\s//;
                $title =~ s/\s$//;

                $title_cache{$url} = $title;
                return $title;
        }
}

Irssi::signal_add_last('message public', 'pubmsg');