reurl.pl

#!/usr/bin/perl

use strict;
#use warnings;
#use CGI::Carp qw(fatalsToBrowser);
use HTTP::Lite;
use CGI;
use JSON;

my $q = CGI->new;
my $url = $q->param("url");
my $result = {'url'=>''};
if ($url =~ /^http:\/\/(tinyurl\.com|short\.to|ff\.im|is\.gd|twurl\.nl|bit.ly|bkite\.com|post\.ly|tr\.im|u2s\.me|goo\.gl|j\.mp|ow\.ly|is\.gd|ht\.ly|p\.tl|t\.co|htn\.to|tot\.to|nav\.cx|nico\.ms|ustre\.am|amzn\.to|youtu\.be|t\.co)\/[-\w]+/) {
  my $http = new HTTP::Lite;
  $http->http11_mode(1);
  $http->method('HEAD');
  $http->add_req_header("User-Agent", "HTTP::Lite/$HTTP::Lite::VERSION reurl API ver0.005");
  my $req = $http->request($url) or die "Unable to get document: $!";
  $result->{'url'} = @{$http->get_header("Location")}[0];
}
my $json = new JSON->encode($result);
if(defined (my $p = $q->param('callback'))){
  print $q->header(
    "-type" => "text/javascript",
    "-charset" => 'utf-8'
  );
  $json = "$p($json);" if($p =~ /^[a-zA-Z0-9._\[\]]+$/);
} else {
  print $q->header(
    "-type" => "application/json",
    "-charset" => 'utf-8',
    "Access-Control-Allow-Origin" => "*"
  );
}
print $json;