view release on metacpan or  search on metacpan

lib/HTTP/Headers/ActionPack/ContentNegotiation.pm  view on Meta::CPAN

package HTTP::Headers::ActionPack::ContentNegotiation;
BEGIN {
  $HTTP::Headers::ActionPack::ContentNegotiation::AUTHORITY = 'cpan:STEVAN';
}
{
  $HTTP::Headers::ActionPack::ContentNegotiation::VERSION = '0.09';
}
# ABSTRACT: A class to handle content negotiation

use strict;
use warnings;

use Carp         qw[ confess ];
use Scalar::Util qw[ blessed ];
use List::Util   qw[ first ];

sub new {
    my $class       = shift;
    my $action_pack = shift;

    (blessed $action_pack && $action_pack->isa('HTTP::Headers::ActionPack'))
        || confess "You must supply an instance of HTTP::Headers::ActionPack";

    bless { action_pack => $action_pack } => $class;
}

sub action_pack { (shift)->{'action_pack'} }

sub choose_media_type {
    my ($self, $provided, $header) = @_;
    my $requested       = blessed $header ? $header : $self->action_pack->create( 'MediaTypeList' => $header );
    my $parsed_provided = [ map { $self->action_pack->create( 'MediaType' => $_ ) } @$provided ];

    my $chosen;
    foreach my $request ( $requested->iterable ) {
        my $requested_type = $request->[1];
        $chosen = _media_match( $requested_type, $parsed_provided );
        return $chosen if $chosen;
    }

    return;
}

sub choose_language {
    my ($self, $provided, $header) = @_;

    return $self->_make_choice(
        choices => $provided,
        header  => $header,
        class   => 'AcceptLanguage',
        matcher => \&_language_match,
    );
}

sub choose_charset {
    my ($self, $provided, $header) = @_;

    # NOTE:
    # Making the default charset UTF-8, which
    # is maybe sensible, I dunno.
    # - SL
    return $self->_make_choice(
        choices => $provided,
        header  => $header,
        class   => 'AcceptCharset',
        default => 'UTF-8',
        matcher => \&_simple_match,
    );
}

sub choose_encoding {
    my ($self, $provided, $header) = @_;

    return $self->_make_choice(
        choices => $provided,
        header  => $header,
        class   => 'PriorityList',
        default => 'identity',
        matcher => \&_simple_match,
    );
}

sub _make_choice {
    my $self = shift;