Courriel

 view release on metacpan or  search on metacpan

lib/Courriel/Headers.pm  view on Meta::CPAN

#
# So we store headers as an array ref. When we add additional values for a
# header, we will put them after the last header of the same name in the array
# ref. If no such header exists yet, then we just put them at the end of the
# arrayref.

has _key_indices => (
    traits   => ['Hash'],
    isa      => HashRef [ ArrayRef [NonEmptyStr] ],
    init_arg => undef,
    lazy     => 1,
    builder  => '_build_key_indices',
    clearer  => '_clear_key_indices',
    handles  => {
        __key_indices_for => 'get',
    },
);

override BUILDARGS => sub {
    my $class = shift;

    my $p = super();

    return $p unless $p->{headers};

    # Could this be done as a coercion for the HeaderArray type? Maybe, but
    # it'd probably need structured types, which seems like as much of a
    # hassle as just doing this.
    if ( reftype( $p->{headers} ) eq 'ARRAY' ) {
        my $headers = $p->{headers};

        ## no critic (ControlStructures::ProhibitCStyleForLoops)
        for ( my $i = 1; $i < @{$headers}; $i += 2 ) {
            next if blessed( $headers->[ $i - 1 ] );

            my $name = $headers->[ $i - 1 ];

            next unless defined $name;

            $headers->[$i] = $class->_inflate_header( $name, $headers->[$i] );
        }
    }
    elsif ( reftype( $p->{headers} ) eq 'HASH' ) {
        for my $name ( keys %{ $p->{headers} } ) {
            next if blessed( $p->{headers}{$name} );

            $p->{headers}{$name}
                = $class->_inflate_header( $name, $p->{headers}{$name} );
        }
    }

    return $p;
};

sub _inflate_header {
    my $class = shift;
    my $name  = shift;
    my $value = shift;

    my ( $header_class, $method )
        = lc $name eq 'content-type'
        ? ( 'Courriel::Header::ContentType', 'new_from_value' )
        : lc $name eq 'content-disposition'
        ? ( 'Courriel::Header::Disposition', 'new_from_value' )
        : ( 'Courriel::Header', 'new' );

    return $header_class->$method(
        name  => $name,
        value => $value,
    );
}

sub _build_key_indices {
    my $self = shift;

    my $headers = $self->_headers;

    my %indices;
    ## no critic (ControlStructures::ProhibitCStyleForLoops)
    for ( my $i = 0; $i < @{$headers}; $i += 2 ) {
        push @{ $indices{ lc $headers->[$i] } }, $i + 1;
    }

    return \%indices;
}

{
    my $validator = validation_for(
        params => [ { type => NonEmptyStr } ],
    );

    sub get {
        my $self = shift;
        my ($name) = $validator->(@_);

        return @{ $self->_headers }[ $self->_key_indices_for($name) ];
    }
}

{
    my $validator = validation_for(
        params => [ { type => NonEmptyStr } ],
    );

    sub get_values {
        my $self = shift;
        my ($name) = $validator->(@_);

        return
            map { $_->value }
            @{ $self->_headers }[ $self->_key_indices_for($name) ];
    }
}

sub _key_indices_for {
    my $self = shift;
    my $name = shift;

    return @{ $self->__key_indices_for( lc $name ) || [] };
}



( run in 1.266 second using v1.01-cache-2.11-cpan-524268b4103 )