File Coverage

blib/lib/Data/Riak/Fast/Link.pm

Criterion	Covered	Total	%
statement	12	28	42.8
branch	0	16	0.0
condition			n/a
subroutine	4	6	66.6
pod	0	2	0.0
total	16	52	30.7

package Data::Riak::Fast::Link;

use Mouse;

use URL::Encode qw/url_encode url_decode/;
use HTTP::Headers::ActionPack::LinkHeader;

has bucket => (
    is => 'ro',
    isa => 'Str',
    required => 1
);

has key => (
    is => 'ro',
    isa => 'Str',
    predicate => 'has_key'
);

has riaktag => (
    is => 'ro',
    isa => 'Str',
    predicate => 'has_riaktag'
);

has params => (
    is => 'ro',
    isa => 'HashRef',
    default => sub { +{} }
);

sub from_link_header {
    my ($class, $link_header) = @_;

    my ($bucket, $key, $riaktag);

    # link to another key in riak
    if ($link_header->href =~ /^\/buckets\/(.*)\/keys\/(.*)/) {
        ($bucket, $key) = ($1, $2);
    }
    # link to a bucket
    elsif ($link_header->href =~ /^\/buckets\/(.*)/) {
        $bucket = $1;
    }
    else {
        confess "Incompatible link header URL (" .  $link_header->href . ")";
    }

    my %params = %{ $link_header->params };

    $riaktag = url_decode( delete $params{'riaktag'} )
        if exists $params{'riaktag'};

    $class->new(
        bucket => $bucket,
        ($key ? (key => $key) : ()),
        ($riaktag ? (riaktag => $riaktag) : ()),
        params => \%params
    );
}

sub as_link_header {
    my $self = shift;
    if ($self->has_key) {
        return HTTP::Headers::ActionPack::LinkHeader->new(
            sprintf('/buckets/%s/keys/%s', $self->bucket, $self->key),
            ($self->has_riaktag ? (riaktag => url_encode($self->riaktag)) : ()),
            %{ $self->params }
        );
    }
    else {
        return HTTP::Headers::ActionPack::LinkHeader->new(
            sprintf('/buckets/%s', $self->bucket),
            ($self->has_riaktag ? (riaktag => url_encode($self->riaktag)) : ()),
            %{ $self->params }
        );
    }
}


__PACKAGE__->meta->make_immutable;
no Mouse;

1;

__END__