File Coverage

blib/lib/Protocol/Yadis/Document.pm

Criterion	Covered	Total	%
statement	16	19	84.2
branch			n/a
condition			n/a
subroutine	6	7	85.7
pod			n/a
total	22	26	84.6

package Protocol::Yadis::Document;

use strict;
use warnings;

use overload '""' => sub { shift->to_string }, fallback => 1;

use Protocol::Yadis::Document::Service;
use Protocol::Yadis::Document::Service::Element;

use XML::LibXML;

sub new {
    my $class = shift;
    my %param = @_;

    my $self = {};
    bless $self, $class;

    $self->{_services} ||= [];

    return $self;
}

sub services {
    my $self = shift;

    if (@_) {
        $self->{_services} = [];

        return $self;
    }
    else {
        my @priority =
          grep { defined $_->attr('priority') } @{$self->{_services}};
        my @other =
          grep { not defined $_->attr('priority') } @{$self->{_services}};

        my @sorted =
          sort { $a->attr('priority') cmp $b->attr('priority') } @priority;
        push @sorted, @other;

        return [@sorted];
    }

    return $self->{_services};
}

sub parse {
    my $class = shift;
    my $document = shift;

    my $self = $class->new;

    return unless $document;

    my $parser = XML::LibXML->new;
    my $doc;
    eval {$doc = $parser->parse_string($document); };
    return if $@;

    # Get XRDS
    my $xrds = shift @{$doc->getElementsByTagName('xrds:XRDS')};
    $xrds = shift @{$doc->getElementsByTagName('XRDS')} unless $xrds;
    return unless $xrds;

    # Get /last/ XRD
    my @xrd = $xrds->getElementsByTagName('XRD');
    my $xrd = $xrd[-1];
    return unless $xrd;

    my $services = [];
    my @services = $xrd->getElementsByTagName('Service');
    foreach my $service (@services) {
        my $s =
          Protocol::Yadis::Document::Service->new(attrs =>
              [map { $_->getName => $_->getValue } $service->attributes]);

        my $elements = [];
        my @nodes = $service->childNodes;
        foreach my $node (@nodes) {
            next unless $node->isa('XML::LibXML::Element');

            my @attrs = $node->attributes;
            my $content = $node->textContent;
            $content =~ s/^\s*//s;
            $content =~ s/\s*$//s;

            my $element = Protocol::Yadis::Document::Service::Element->new(
                name    => $node->getName,
                content => $content,
                attrs   => [map { $_->getName => $_->getValue } @attrs]
            );

            push @$elements, $element;
        }

        $s->elements($elements);

        next unless $s->Type;

        push @{$self->{_services}}, $s;
    }

    return $self;
}

sub to_string {
    my $self = shift;

    my $string = '';

    $string .= '' . "\n";

    $string .= '
    $string .= '     xmlns:openid="http://openid.net/xmlns/1.0">' . "\n";

    $string .= " \n";

    foreach my $service (@{$self->services}) {
        $string .= $service->to_string;
    }

    $string .= " \n";
    $string .= "\n";

    return $string;
}

1;
__END__