File Coverage

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

Criterion	Covered	Total	%
statement	47	47	100.0
branch	25	30	83.3
condition	17	21	80.9
subroutine	15	15	100.0
pod	9	9	100.0
total	113	122	92.6

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

use strict;
use warnings;

use Scalar::Util qw[ blessed ];

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

sub type  { (shift)->subject }
sub major { (split '/' => (shift)->type)[0] }
sub minor { (split '/' => (shift)->type)[1] }

sub matches_all {
    my $self = shift;
    $self->type eq '*/*' && $self->params_are_empty
        ? 1 : 0;
}

# must be exactly the same
sub equals {
    my ($self, $other) = @_;
    $other = (ref $self)->new_from_string( $other ) unless blessed $other;
    $other->type eq $self->type && _compare_params( $self->params, $other->params )
        ? 1 : 0;
}

# types must be compatible and params much match exactly
sub exact_match {
    my ($self, $other) = @_;
    $other = (ref $self)->new_from_string( $other ) unless blessed $other;
    $self->type_matches( $other ) && _compare_params( $self->params, $other->params )
        ? 1 : 0;
}

# types must be be compatible and params should align
sub match {
    my ($self, $other) = @_;
    $other = (ref $self)->new_from_string( $other ) unless blessed $other;
    $self->type_matches( $other ) && $self->params_match( $other->params )
        ? 1 : 0;
}

## ...

sub type_matches {
    my ($self, $other) = @_;
    return 1 if $other->type eq '*' || $other->type eq '*/*' || $other->type eq $self->type;
    $other->major eq $self->major && $other->minor eq '*'
        ? 1 : 0;
}

sub params_match {
    my ($self, $other) = @_;
    my $params = $self->params;
    foreach my $k ( keys %$other ) {
        next if $k eq 'q';
        return 0 if not exists $params->{ $k };
        return 0 if $params->{ $k } ne $other->{ $k };
    }
    return 1;
}

## ...

sub _compare_params {
    my ($left, $right) = @_;
    my @left_keys  = sort grep { $_ ne 'q' } keys %$left;
    my @right_keys = sort grep { $_ ne 'q' } keys %$right;

    return 0 unless (scalar @left_keys) == (scalar @right_keys);

    foreach my $i ( 0 .. $#left_keys ) {
        return 0 unless $left_keys[$i] eq $right_keys[$i];
        return 0 unless $left->{ $left_keys[$i] } eq $right->{ $right_keys[$i] };
    }

    return 1;
}

1;

__END__