File Coverage

blib/lib/HTTP/AcceptCharset.pm

Criterion	Covered	Total	%
statement	33	33	100.0
branch	12	14	85.7
condition	2	2	100.0
subroutine	5	5	100.0
pod	1	1	100.0
total	53	55	96.3

package HTTP::AcceptCharset;

# ABSTRACT: Parse the HTTP header 'Accept-Charset'

our $VERSION = '0.03';

use Moo;
use List::Util qw(first);

has string => ( is => 'ro', required => 1 );
has values => ( is => 'ro', lazy => 1, default => \&_parse_string );

sub match {
    my ($self, @values_to_check) = @_;

    @values_to_check =
        map{ lc $_ }
        grep{ defined $_ && length $_ }
        @values_to_check;

    return '' if !@values_to_check;

    my @charsets = @{ $self->values || [] };
    return $values_to_check[0] if !@charsets;


    CHARSET:
    for my $charset ( @charsets ) {
        return $values_to_check[0] if $charset eq '*';

        my $found = first { $_ eq $charset }@values_to_check;
        return $found if $found;
    }

    return '';
}

around BUILDARGS => sub {
  my ($orig, $class, @args) = @_;

  return { string => $args[0] }
    if @args == 1 && !ref $args[0];

  return $class->$orig(@args);
};

sub _parse_string {
    my ($self) = @_;

    my @charsets = split /\s*,\s*/, $self->string;
    my %weighted;

    for my $charset ( @charsets ) {
        my ($charset_name, $quality) = split /;/, $charset;

        my ($weight) = ($quality // 'q=1')  =~ m{\Aq=(.*)\z};
        push @{ $weighted{$weight} }, $charset_name;
    }

    my @charset_names = map{ @{ $weighted{$_} || [] } } sort { $b <=> $a }keys %weighted;

    return \@charset_names;
}

1;

__END__