File Coverage

blib/lib/OpenID/Lite/RelyingParty/Discover/Fetcher/Yadis.pm

Criterion	Covered	Total	%
statement	12	36	33.3
branch	0	8	0.0
condition	0	9	0.0
subroutine	4	8	50.0
pod	0	1	0.0
total	16	62	25.8

package OpenID::Lite::RelyingParty::Discover::Fetcher::Yadis;

use Any::Moose;
with 'OpenID::Lite::Role::AgentHandler';
with 'OpenID::Lite::Role::ErrorHandler';

use OpenID::Lite::RelyingParty::Discover::Fetcher::Yadis::HTMLExtractor;
use OpenID::Lite::RelyingParty::Discover::FetchResult;
use OpenID::Lite::Constants::Yadis
    qw(XRDS_HEADER YADIS_HEADER XRDS_CONTENT_TYPE);

sub fetch {
    my ( $self, $uri ) = @_;

    my $res = $self->agent->get( $uri, 'Accept' => XRDS_CONTENT_TYPE );
    return $self->ERROR( sprintf q{Failed Yadis discovery on "%s"}, $uri )
        unless $res->is_success;

    my $result = OpenID::Lite::RelyingParty::Discover::FetchResult->new;
    $result->normalized_identifier($uri);

    my $content_type = $res->header('Content-Type');
    my $xrds_type = quotemeta XRDS_CONTENT_TYPE;
    if ( $content_type && $content_type =~ /^$xrds_type/i ) {
        $result->content_type( lc $content_type );
        $result->final_url( $res->base->as_string );
        $result->content( $res->content );
    }
    else {

        my $yadis_location = $self->_extract_location($res)
            or return $self->ERROR(
            sprintf q{Failed Yadis discovery for url "%s"}, $uri );

        $res = $self->agent->get($yadis_location);
        return $self->ERROR( sprintf q{Failed Yadis discovery for url "%s"},
            $yadis_location )
            unless $res->is_success;

        $result->content_type( lc $res->header('Content-Type') );
        $result->final_url( $res->base->as_string );
        $result->content( $res->content );
    }
    return $result;
}

sub _extract_location {
    my ( $self, $res ) = @_;
    return $self->_extract_location_from_header($res)
        || $self->_extract_location_from_html( $res->content );
}

sub _extract_location_from_header {
    my ( $self, $res ) = @_;
    return $res->header(XRDS_HEADER)
        || $res->header(YADIS_HEADER);
}

sub _extract_location_from_html {
    my ( $self, $content ) = @_;
    return
        OpenID::Lite::RelyingParty::Discover::Fetcher::Yadis::HTMLExtractor->extract($content);
}

1;