view release on metacpan or  search on metacpan

lib/CGI/Header.pm  view on Meta::CPAN

package CGI::Header;
use 5.008_009;
use strict;
use warnings;
use Carp qw/croak/;

our $VERSION = '0.63';

sub new {
    my $class = shift;
    my %args = @_ == 1 ? %{$_[0]} : @_;
    ( bless \%args => $class )->_rehash;
}

sub header {
    $_[0]->{header} ||= {};
}

sub query {
    my $self = shift;
    $self->{query} ||= $self->_build_query;
}

sub _build_query {
    require CGI;
    CGI::self_or_default();
}

sub _alias {
    my $self = shift;
    $self->{alias} ||= $self->_build_alias;
}

sub _build_alias {
    +{
        'content-type' => 'type',
        'cookie'       => 'cookies',
    };
}

sub _normalize {
    my ( $self, $key ) = @_;
    my $alias = $self->_alias;
    my $prop = lc $key;
    $prop =~ s/^-//;
    $prop =~ tr/_/-/;
    $prop = $alias->{$prop} if exists $alias->{$prop};
    $prop;
}

sub _rehash {
    my $self   = shift;
    my $header = $self->header;

    for my $key ( keys %$header ) {
        my $prop = $self->_normalize( $key );
        next if $key eq $prop; # $key is normalized
        croak "Property '$prop' already exists" if exists $header->{$prop};
        $header->{$prop} = delete $header->{$key}; # rename $key to $prop
    }

    $self;
}

sub get {
    my ( $self, @keys ) = @_;
    my @props = map { $self->_normalize($_) } @keys;
    @{ $self->header }{ @props };
}

sub set {
    my ( $self, @pairs ) = @_;