File Coverage

blib/lib/WWW/PGXN/Distribution.pm

Criterion	Covered	Total	%
statement	89	89	100.0
branch	29	34	85.2
condition	6	10	60.0
subroutine	28	28	100.0
pod	17	17	100.0
total	169	178	94.9

package WWW::PGXN::Distribution;

use 5.8.1;
use strict;
use File::Spec;
use Carp;
our $VERSION = v0.12.4;

BEGIN {
    # XXX Use DateTime for release date?
    # XXX Use Software::License for license?
    # XXX Use SemVer for versions?
    for my $attr (qw(
        abstract
        license
        name
        version
        description
        generated_by
        date
        release_status
        sha1
        user
    )) {
        no strict 'refs';
        *{$attr} = sub {
            $_[0]->_merge_meta unless $_[0]->{version};
            $_[0]->{$attr}
        };
    }

    # Hash accessors.
    for my $attr (qw(
        no_index
        prereqs
        provides
        resources
    )) {
        no strict 'refs';
        *{$attr} = sub { +{ %{ shift->{$attr} || {} } } };
    }
}

sub new {
    my ($class, $pgxn, $data) = @_;
    $data->{_pgxn} = $pgxn;
    bless $data, $class;
}

# Merging accessors.
sub releases {
    my $self = shift;
    $self->_merge_by_dist unless $self->{releases};
    return +{ %{ $self->{releases} } };
}

sub docs {
    my $self = shift;
    $self->_merge_meta unless $self->{version};
    return +{ %{ $self->{docs} || {} } };
}

# List accessors.
sub tags          { @{ shift->{tags}             || [] } }
sub maintainers   { @{ shift->{maintainer}       || [] } }
sub special_files { @{ shift->{special_files}    || [] } }
sub versions_for  { map { $_->{version} } @{ shift->releases->{+shift} || [] } }

# Instance methods.
sub version_for  { shift->releases->{+shift}[0]{version} }
sub date_for     { shift->releases->{+shift}[0]{date} }

sub _merge_meta {
    my $self = shift;
    my $rel = $self->{releases};
    my $rels = $rel->{stable} || $rel->{testing} || $rel->{unstable};
    my $meta = $self->{_pgxn}->_fetch_json(meta => {
        version => lc $rels->[0]{version},
        dist    => lc $self->{name},
    }) || {};
    @{$self}{keys %{ $meta }} = values %{ $meta };
}

sub _merge_by_dist {
    my $self = shift;
    my $by_dist = $self->{_pgxn}->_fetch_json(dist => {
        dist => lc $self->{name}
    }) || {};
    @{$self}{keys %{ $by_dist }} = values %{ $by_dist };
}

sub download_url {
    my $self = shift;
    $self->{_pgxn}->_url_for(download => {
        dist    => lc $self->name,
        version => lc $self->version
    });
}

sub download_path {
    my $self = shift;
    $self->{_pgxn}->_path_for(download => {
        dist    => lc $self->name,
        version => lc $self->version
    });
}

sub download_to {
    my $self = shift;
    $self->{_pgxn}->_download_to(shift, {
        dist    => lc $self->name,
        version => lc $self->version
    });
}

sub source_url {
    my $self = shift;
    my $uri = $self->source_path or return;
    return URI->new($self->{_pgxn}->url . $uri);
}

sub source_path {
    my $self = shift;
    my $tmpl = $self->{_pgxn}->_uri_templates->{source} or return;
    return $tmpl->process(
        dist    => lc $self->name,
        version => lc $self->version
    );
}

sub url_for_html_doc {
    my $self = shift;
    my $uri = $self->path_for_html_doc(shift) or return;
    return URI->new($self->{_pgxn}->url . $uri);
}

sub path_for_html_doc {
    my ($self, $path) = @_;
    $self->_merge_meta unless $self->{version};
    return unless $self->{docs} && $self->{docs}{$path};

    my $tmpl = $self->{_pgxn}->_uri_templates->{htmldoc} or return;
    $tmpl->process(
        dist    => lc $self->name,
        version => lc $self->version,
        docpath => $path,
    );
}

sub body_for_html_doc {
    my $self = shift;
    my $url = $self->url_for_html_doc(shift) or return;
    my $res = $self->{_pgxn}->_fetch($url) or return;
    utf8::decode $res->{content};
    return $res->{content};
}

1;

__END__