File Coverage

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

Criterion	Covered	Total	%
statement	53	53	100.0
branch	6	8	75.0
condition			n/a
subroutine	17	17	100.0
pod	12	12	100.0
total	88	90	97.7

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

use strict;
use warnings;

use HTTP::Headers::ActionPack::Util qw[
    split_header_words
    join_header_words
];

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

sub BUILDARGS { +{ 'index' => {}, 'items' => {} } }

sub BUILD {
    my ($self, @items) = @_;
    foreach my $item ( @items ) {
        $self->add( @$item )
    }
}

sub index { (shift)->{'index'} }
sub items { (shift)->{'items'} }

sub new_from_string {
    my ($class, $header_string) = @_;
    my $list = $class->new;
    foreach my $header ( split_header_words( $header_string ) ) {
        $list->add_header_value( $header );
    }
    $list;
}

sub as_string {
    my $self = shift;
    join ', ' => map {
        my ($q, $subject) = @{ $_ };
        join_header_words( $subject, q => $q );
    } $self->iterable;
}

sub add {
    my ($self, $q, $choice) = @_;
    # XXX - should failure to canonicalize be an error? or should
    # canonicalize_choice itself throw an error on bad values?
    $choice = $self->canonicalize_choice($choice)
        or return;
    $q += 0; # be sure to numify this
    $self->index->{ $choice } = $q;
    $self->items->{ $q } = [] unless exists $self->items->{ $q };
    push @{ $self->items->{ $q } } => $choice;
}

sub add_header_value {
    my $self = shift;
    my ($choice, %params) = @{ $_[0] };
    $self->add( exists $params{'q'} ? $params{'q'} : 1.0, $choice );
}

sub get {
    my ($self, $q) = @_;
    $self->items->{ $q };
}

sub priority_of {
    my ($self, $choice) = @_;
    $choice = $self->canonicalize_choice($choice)
        or return;
    $self->index->{ $choice };
}

sub iterable {
    my $self = shift;
    map {
        my $q = $_;
        map { [ $q, $_ ] } @{ $self->items->{ $q } }
    } reverse sort keys %{ $self->items };
}

sub canonicalize_choice {
    return $_[1];
}

1;

__END__