/var/www/www.irssi.org-old/scripts/html/tinyurl.pl

• package main
  • tinyurl
  • url_encode
  • get_tiny_url
• EOF

   1 #!/usr/bin/perl
   2 #
   3 # by Atoms
   4 
   5 use strict;
   6 use IO::Socket;
   7 use LWP::UserAgent;
   8 
   9 use vars qw($VERSION %IRSSI);
  10 
  11 use Irssi qw(command_bind active_win);
  12 $VERSION = '1.0';
  13 %IRSSI = (
  14     authors	=> 'Atoms',
  15     contact	=> 'atoms@tups.lv',
  16 	patch   => 'spowers@dimins.com',
  17     name	=> 'tinyurl',
  18     description	=> 'create a tinyurl from a long one',
  19     license	=> 'GPL',
  20 );
  21 
  22 command_bind(
  23     tinyurl => sub {
  24       my ($msg, $server, $witem) = @_;
  25       my $answer = tinyurl($msg);
  26       if ($answer) {
  27         print CLIENTCRAP "$answer";
  28         if ($witem && ($witem->{type} eq 'CHANNEL' || $witem->{type} eq 'QUERY')) {
  29   	      $witem->command("MSG " . $witem->{name} ." ". $answer);
  30         }
  31       }
  32     }
  33 );
  34 
  35 sub tinyurl {
  36 	my $url = shift;
  37         
  38         #added to fix URLs containing a '&'
  39         $url=url_encode($url);
  40 
  41   my $ua = LWP::UserAgent->new;
  42   $ua->agent("tinyurl for irssi/1.0 ");
  43   my $req = HTTP::Request->new(POST => 'http://tinyurl.com/create.php');
  44   $req->content_type('application/x-www-form-urlencoded');
  45   $req->content("url=$url");
  46   my $res = $ua->request($req);
  47 
  48   if ($res->is_success) {
  49 	  return get_tiny_url($res->content);
  50   } else {
  51     print CLIENTCRAP "ERROR: tinyurl: tinyurl is down or not pingable";
  52 		return "";
  53 	}
  54 }
  55 
  56 #added because the URL was not being url_encoded. This would cause only 
  57 #the portion of the URL before the first "&" to be properly sent to tinyurl.
  58 sub url_encode {
  59         my $url = shift;
  60         $url =~ s/([\W])/"%" . uc(sprintf("%2.2x",ord($1)))/eg;
  61         return $url;
  62 }
  63 
  64 sub get_tiny_url($) {
  65 	
  66 	my $tiny_url_body = shift;
  67 	$tiny_url_body =~ /(.*)(tinyurl\svalue=\")(.*)(\")(.*)/;
  68 
  69 	return $3;
  70 }