File Coverage

blib/lib/HTTP/Headers/Fancy.pm

Criterion	Covered	Total	%
statement	14	31	45.1
branch	2	22	9.0
condition			n/a
subroutine	3	5	60.0
pod	4	4	100.0
total	23	62	37.1

use strictures 2;

package HTTP::Headers::Fancy;

# ABSTRACT: Fancy naming schema of HTTP headers

our $VERSION = '0.001';    # VERSION

sub decode_key {
    shift if $_[0] eq __PACKAGE__;
    my $k = shift;
    $k =~ s{^([^-]+)}{ucfirst(lc($1))}e;
    $k =~ s{-+([^-]+)}{ucfirst(lc($1))}ge;
    return ucfirst($k);
}

sub decode_hash {
    shift if $_[0] eq __PACKAGE__;
    my %headers = @_ == 1 ? %{ +shift } : @_;
    while ( my ( $old, $val ) = each %headers ) {
        my $new = decode_key($old);
        if ( $old ne $new ) {
            $headers{$new} = delete $headers{$old};
        }
    }
    wantarray ? %headers : \%headers;
}

sub encode_key {
    shift if $_[0] eq __PACKAGE__;
    my $k = +shift =~ s{_}{-}gr;
    $k =~ s{([^-])([A-Z])}{$1-$2} while $k =~ m{([^-])([A-Z])};
    return lc($k);
}

sub encode_hash {
    shift if $_[0] eq __PACKAGE__;
    my %headers = @_ == 1 ? %{ +shift } : @_;
    while ( my ( $old, $val ) = each %headers ) {
        delete $headers{$old} unless defined $val;
        my $new = encode_key($old);
        if ( $old ne $new ) {
            $headers{$new} = delete $headers{$old};
        }
    }
    wantarray ? %headers : \%headers;
}

1;

__END__