File Coverage

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

Criterion	Covered	Total	%
statement	41	41	100.0
branch	19	22	86.3
condition	2	2	100.0
subroutine	12	12	100.0
pod	6	6	100.0
total	80	83	96.3

package HTTP::Headers::ActionPack::MediaTypeList;
BEGIN {
  $HTTP::Headers::ActionPack::MediaTypeList::AUTHORITY = 'cpan:STEVAN';
}
{
  $HTTP::Headers::ActionPack::MediaTypeList::VERSION = '0.09';
}
# ABSTRACT: A Priority List customized for Media Types

use strict;
use warnings;

use Scalar::Util qw[ blessed ];

use HTTP::Headers::ActionPack::MediaType;

use parent 'HTTP::Headers::ActionPack::PriorityList';

sub BUILD {
    my ($self, @items) = @_;
    foreach my $item ( @items ) {
        $self->add( ref $item eq 'ARRAY' ? @$item : $item )
    }
}

sub add {
    my $self     = shift;
    my ($q, $mt) = scalar @_ == 1 ? ((exists $_[0]->params->{'q'} ?$_[0]->params->{'q'} : 1.0), $_[0]) : @_;
    $self->SUPER::add( $q, $mt );
}

sub add_header_value {
    my $self = shift;
    my $mt   = HTTP::Headers::ActionPack::MediaType->new( @{ $_[0] } );
    my $q    = $mt->params->{'q'} || 1.0;
    $self->add( $q, $mt );
}

sub as_string {
    my $self = shift;
    join ', ' => map { $_->[1]->as_string } $self->iterable;
}

sub iterable {
    my $self = shift;
    # From RFC-2616 sec14
    # Media ranges can be overridden by more specific
    # media ranges or specific media types. If more
    # than one media range applies to a given type,
    # the most specific reference has precedence.
    sort {
        if ( $a->[0] == $b->[0] ) {
            $a->[1]->matches_all
                ? 1
                : ($b->[1]->matches_all
                    ? -1
                    : ($a->[1]->minor eq '*'
                        ? 1
                        : ($b->[1]->minor eq '*'
                            ? -1
                            : ($a->[1]->params_are_empty
                                ? 1
                                : ($b->[1]->params_are_empty
                                    ? -1
                                    : 0)))))
        }
        else {
            $b->[0] <=> $a->[0]
        }
    } map {
        my $q = $_;
        map { [ $q+0, $_ ] } reverse @{ $self->items->{ $q } }
    } keys %{ $self->items };
}

sub canonicalize_choice {
    return blessed $_[1]
        ? $_[1]
        : HTTP::Headers::ActionPack::MediaType->new( $_[1] );
}

1;

__END__