Skip to content

Instantly share code, notes, and snippets.

@os0x os0x/reurl.pl
Created Feb 16, 2009

Embed
What would you like to do?
#!/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;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.