File Coverage

blib/lib/WWW/Expand/More.pm

Criterion	Covered	Total	%
statement	9	32	28.1
branch	0	10	0.0
condition	0	8	0.0
subroutine	3	7	42.8
pod	2	2	100.0
total	14	59	23.7

package WWW::Expand::More;
use strict;
use warnings;

use Furl;

our $VERSION = '0.01';

sub _default_ua {
    my $args = shift;

    Furl->new(
        timeout => $args->{timeout} || 5,
        agent   => $args->{agent}   || __PACKAGE__."/$VERSION",
    );
}

our %CACHE = ();

sub expand {
    my ($class, $url, $opt) = @_;

    return $CACHE{$url} if exists $CACHE{$url};

    my @urls;

    $class->_expand($url, \@urls);

    if ($opt->{cache}) {
        $CACHE{$url} = $urls[-1];
    }

    return $urls[-1];
}

sub expand_all {
    my ($class, $url, $opt) = @_;

    return $CACHE{$url} if exists $CACHE{$url};

    my @urls;

    $class->_expand($url, \@urls);

    if ($opt->{cache}) {
        $CACHE{$url} = [@urls];
    }

    return @urls;
}

sub _expand {
    my ($class, $url, $urls, $opt) = @_;

    $opt->{ua} ||= _default_ua();

    push @{$urls}, $url;

    my $res = $opt->{ua}->request(
        method        => 'HEAD',
        url           => $url,
        max_redirects => 0,
        headers       => [ Connection => 'close' ],
    );

    if (my $next_url = $res->headers->header('location')) {
        return $class->_expand($next_url, $urls, $opt);
    }
}

1;

__END__