File Coverage

blib/lib/FirstGoodURL.pm

Criterion	Covered	Total	%
statement	29	31	93.5
branch	9	16	56.2
condition	3	12	25.0
subroutine	6	6	100.0
pod	2	2	100.0
total	49	67	73.1

package FirstGoodURL;

$VERSION = '1.11';

use LWP::UserAgent;
use Carp;
use strict;

my $status = { 200 => 1 };
my $ctype = {};
my $ua;


sub import { $ua ||= LWP::UserAgent->new }


sub with {
  my $class = shift;
  carp "no content-type or status given" if not @_;

  $status = { 200 => 1 };
  $ctype = {};
  (/\D/ ? $ctype->{$_} : $status->{$_}) = $_ for @_;

  return $class;
}


sub in {
  shift;

  my $match;

  for (@_) {
    my $req = $ua->request(HTTP::Request->new(HEAD => $_));
    my ($rc,$rt) = ($req->code, $req->content_type);

    if (not keys %$ctype) { $match = $_ and last if $status->{$rc} }
    else { next if not $status->{$rc} }

    if (keys %$ctype == 1 and my($regex) = (each %$ctype)[1]) {
      $match = $_ and last if $rt =~ $regex;
    }

    else { for (keys %$ctype) { $match = $_ and last if $ctype->{$rt} } }
  }

  $status = { 200 => 1 };
  $ctype = {};
  return $match;
}


1;

__END__