User:Dschwen/TinyurlResolver

This little perl script finds TinyURLs and replaces them with the original URLs. This is needed to copy texts containing TinyURLs to Wikimedia sites, as tinyurl.com is blocked by the Wikimedia spam filter.

#!/usr/bin/perl

use LWP::Simple;

while(<STDIN>)
{
  $line = $_;
  while( $line =~ /(http:\/\/tinyurl\.com\/......)/ )
  {
    $url = $1;

    $preview = $url;
    $preview =~ s/\/tinyurl.com/\/preview.tinyurl.com/;
    $page = get $preview;

    $expanded = $page;
    $expanded =~ s/\n//g;
    $expanded =~ s/.*<a\sid="redirecturl"\shref="([^"]+)">.*/\1/g;
    $line =~ s/$url/[$expanded]/g;
  }
  print $line;
}