File Coverage

blib/lib/HTTP/Headers/ActionPack/LinkHeader.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	8	10	80.0
condition			n/a
subroutine	12	12	100.0
pod	4	6	66.6
total	68	72	94.4

package HTTP::Headers::ActionPack::LinkHeader;
BEGIN {
  $HTTP::Headers::ActionPack::LinkHeader::AUTHORITY = 'cpan:STEVAN';
}
{
  $HTTP::Headers::ActionPack::LinkHeader::VERSION = '0.09';
}
# ABSTRACT: A Link

use strict;
use warnings;

use URI::Escape                     qw[ uri_escape uri_unescape ];
use HTTP::Headers::ActionPack::Util qw[ join_header_words ];

use parent 'HTTP::Headers::ActionPack::Core::BaseHeaderType';

sub BUILDARGS {
    my $class = shift;
    my ($href, @params) = @_;

    $href =~ s/^
    $href =~ s/>$//;

    $class->SUPER::BUILDARGS( $href, @params );
}

sub BUILD {
    my $self = shift;
    foreach my $param ( grep { /\*$/ } @{ $self->_param_order } ) {
        my ($encoding, $language, $content) = ( $self->params->{ $param } =~ /^(.*)\'(.*)\'(.*)$/);
        $self->params->{ $param } = {
            encoding => $encoding,
            language => $language,
            content  => uri_unescape( $content )
        };
    }
}

sub href { (shift)->subject         }
sub rel  { (shift)->params->{'rel'} }

sub relation_matches {
    my ($self, $relation) = @_;

    if ( my $rel = $self->params->{'rel'} ) {
        # if it is an extension rel type
        # then it is a URI and it should
        # not be compared in a case-insensitive
        # manner ...
        if ( $rel =~ m!^\w+\://! ) {
            $self->params->{'rel'} eq $relation ? 1 : 0;
        }
        # if it is not a URI, then compare
        # it case-insensitively
        else {
            (lc $self->params->{'rel'} ) eq (lc $relation) ? 1 : 0;
        }
    }
}

sub as_string {
    my $self = shift;

    my @params;
    foreach my $param ( @{ $self->_param_order } ) {
        if ( $param =~ /\*$/ ) {
            my $complex = $self->params->{ $param };
            push @params => ( $param,
                join "'" => (
                    $complex->{'encoding'},
                    $complex->{'language'},
                    uri_escape( $complex->{'content'} ),
                )
            );
        }
        else {
            push @params => ( $param, $self->params->{ $param } );
        }
        my ($encoding, $language, $content) = ( $self->params->{ $param } =~ /^(.*)\'(.*)\'(.*)$/);
    }

    join_header_words( '<' . $self->href . '>', @params );
}

1;

__END__