Perl - 短縮 URL の元を調べる

短縮 URL の元の URL を調べるスクリプト。短縮 URL の元が、また短縮 URL だったら、さらにその元を調べるようにしてる。

実行例

ソースコード

wget を使うバージョン （日本語化してる wget は修正必要）

#!/usr/bin/env perl
use strict;
use warnings;

my $url = shift or die "Write URL.\n";

while (1) {
    $url = get_origin($url) or exit;
    print "$url\n";
}

sub get_origin {
    my $url = shift;
    my @wget = `wget --max-redirect=0 --spider '$url' 2>&1`;
    for (@wget) {
        return $1 if /^Location: (\S+)/;
    }
    return undef;
}

wget 使わないバージョン

#!/usr/bin/env perl
use strict;
use warnings;
use LWP::UserAgent;

my $url = shift or die "Write URL.\n";
my $ua = LWP::UserAgent->new;
my @redirects = $ua->head($url)->redirects;

print $_->header('location'), "\n" for @redirects;