File Coverage

blib/lib/XRI/Resolution/Lite.pm

Criterion	Covered	Total	%
statement	22	24	91.6
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	30	32	93.7

package XRI::Resolution::Lite;

use strict;
use warnings;
use parent qw(Class::Accessor::Fast);

__PACKAGE__->mk_accessors(qw/resolver ua parser/);

use Carp;
use HTTP::Request;
use LWP::UserAgent;
use URI;
use XML::LibXML;

=head1 NAME

XRI::Resolution::Lite - The Lightweight client module for XRI Resolution

=head1 VERSION

version 0.04

=cut

our $VERSION = '0.04';

my %param_map = (
    format => '_xrd_r',
    type   => '_xrd_t',
    media  => '_xrd_m',
);

=head1 SYNOPSIS

  use XML::LibXML::XPathContext;
  use XRI::Resolution::Lite;

  my $r = XRI::Resolution::Lite->new;
  my $xrds = $r->resolve('=zigorou'); ### XML::LibXML::Document
  my $ctx = XML::LibXML::XPathContext->new($xrds);
  my @services = $ctx->findnodes('//Service');

=head1 METHODS

=head2 new

=over 2

=item $args

This param must be HASH reference. Available 2 fields.

=over 2

=item ua

(Optional) L object or its inheritance.

=item resolver

(Optional) URI string of XRI Proxy Resolver.
If this param is omitted, using XRI Global Proxy Resolver, "http://xri.net/", as resolver.

=back

=back

=cut

sub new {
    my ( $class, $args ) = @_;

    $args ||= +{};
    $args = +{
        ua => $args->{ua} || LWP::UserAgent->new,
        resolver => ( $args->{resolver} )
        ? ( UNIVERSAL::isa( $args->{resolver}, 'URI' )
            ? $args->{resolver}
            : URI->new( $args->{resolver} ) )
        : URI->new('http://xri.net/'),
        parser => XML::LibXML->new,
    };

    my $self = $class->SUPER::new($args);
    return $self;
}

=head2 resolve($qxri, \%params, \%media_flags)

When type parameter is substituted "application/xrds+xml" or "application/xrd+xml", the result would be returned as L object.
Substituted "text/uri-list" to type parameter, the result would be returned as url list ARRAY or ARRAYREF.

=over 2

=item $qxri

Query XRI string. For example :

  =zigorou
  @linksafe
  @id*zigorou

=item $params

This param must be HASH reference. Available 3 fields.
See Section 3.3 of XRI Resolution 2.0.
L

=over 2

=item format

Resolution Output Format. This param would be '_xrd_r' query parameter.

=item type

Service Type. This param would be '_xrd_t' query parameter.

=item media

Service Media Type. This param would be '_xrd_m' query parameter.

=back

=item $media_flags

If you want to specify flag on or off, then substitute to 1 as true, 0 as false.

=over 2

=item https

Specifies use of HTTPS trusted resolution. default value is 0.

=item saml

Specifies use of SAML trusted resolution. default value is 0.

=item refs

Specifies whether Refs should be followed during resolution (by default they are followed), default value is 1.

=item sep

Specifies whether service endpoint selection should be performed. default value is 0.

=item nodefault_t

Specifies whether a default match on a Type service endpoint selection element is allowed. default value is 1.

=item nodefault_p

Specifies whether a default match on a Path service endpoint selection element is allowed. default value is 1.

=item nodefault_m

Specifies whether a default match on a MediaType service endpoint selection element is allowed. default value is 1.

=item uric

Specifies whether a resolver should automatically construct service endpoint URIs. default value is 0.

=item cid

Specifies whether automatic canonical ID verification should performed. default value is 1

=back

=back

=cut

sub resolve {
    my ( $self, $qxri, $params, $media_flags ) = @_;

    $params      ||= {};
    $media_flags ||= {};

    $qxri =~ s|^xri://||;    ### normalize

    my %query = ();
    %query = (
        _xrd_r => 'application/xrds+xml',
        map { ( $param_map{$_}, $params->{$_} ) } keys %$params
    );

    my %flags = (
        https       => 0,
        saml        => 0,
        refs        => 1,
        sep         => 0,
        nodefault_t => 1,
        nodefault_p => 1,
        nodefault_m => 1,
        uric        => 0,
        cid         => 1,
    );

    $query{'_xrd_r'} .=
      ';' . join ';' => map { $_->[0] . '=' . $_->[1] ? 'true' : 'false' }
      map { [ $_, $media_flags->{$_} || $flags{$_} ] }
      keys %flags;

    my $hxri = $self->resolver->clone;
    $hxri->path($qxri);
    $hxri->query_form(%query);

    my $req = HTTP::Request->new( GET => $hxri );
    $req->header( Accept => $params->{type} || 'application/xrds+xml' );

    my ( $res, $e );

    eval { $res = $self->ua->request($req); };
    if ( $e = $@ ) {
        $@ = undef;
        croak($e);
    }

    croak( $res->status_line ) unless ( $res->is_success );    ### HTTP error
    croak( $res->content )
      if ( $res->header('Content-Type') =~ m#^text/plain# )
      ;    ### Invalid Content-Type

    unless ( defined $params->{format} && $params->{format} eq 'text/uri-list' )
    {      ## XRDS or XRD format
        my $doc = $self->parser->parse_string( $res->content );
        return $doc;
    }
    else {    ## URL List format
        my @url_list = split "\n" => $res->content;
        wantarray ? @url_list : \@url_list;
    }
}

=head1 SEE ALSO

=over 2

=item http://docs.oasis-open.org/xri/xri-resolution/2.0/specs/cd03/xri-resolution-V2.0-cd-03.html

There are XRI Resolution spec in OASIS.

=back

=head1 AUTHOR

Toru Yamaguchi, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to
C, or through the web interface at
L.  I will be notified, and then you'll automatically be
notified of progress on your bug as I make changes.

=head1 COPYRIGHT & LICENSE

Copyright 2008 Toru Yamaguchi, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;    # End of XRI::Resolution::Lite