package main;
use CGI qw(header);
our $header_ref = { -type => 'text/html' };

# loads plugins

print header( $header_ref );

##</code><code>##

$header_ref = {
    'content-length'  => 1234,
    'content_length'  => 1234,
    '-content-length' => 1234,
    '-content_length' => 1234,
    'Content-Length'  => 1234,
    'Content_Length'  => 1234,
    '-Content-Length' => 1234,
    '-Content_Length' => 1234,
};

##</code><code>##

# plugins/foo
package foo;
$main::header_ref->{'-status'} = '304 Not Modified';

##</code><code>##

# plugins/bar
package bar;
$main::header_ref->{'Status'} = '404 Not Found';

##</code><code>##

# plugins/foo
package foo;
use Header qw(set_header);
set_header( $main::header, 'Status' => '304 Not Modified');

# Header.pm
package Header;
use Exporter 'import';
use List::Util qw(first);

our @EXPORT_OK = qw(get_header set_header exists_header delete_header);

sub get_header {
    my $header_ref = shift;
    my $key        = _lc( shift );

    if ( wantarray ) {
        my @keys = grep { _lc( $_ ) eq $key } keys %{ $header_ref };
        return @{ $header_ref }{ @keys };
    }
    else {
        my $first_key = first { _lc( $_ ) eq $key } keys %{ $header_ref };
        return $header_ref->{ $first_key };
    }
}

sub set_header {
    my $header_ref = shift;
    my $key        = shift;
    my $value      = shift;
    my @keys       = grep { _lc( $_ ) eq _lc( $key ) } keys %{ $header_ref };

    if ( @keys ) {
        $key = shift @keys;
        delete @{ $header_ref }{ @keys };
    }

    $header_ref->{ $key } = $value;

    return;
}

sub exists_header {
    my $header_ref = shift;
    my $key        = _lc( shift );
    my @keys       = grep { _lc( $_ ) eq $key } keys %{ $header_ref };

    return scalar @keys;
}

sub delete_header {
    my $header_ref = shift;
    my $key        = _lc( shift );

    # deletes elements whose key matches $key
    my @keys = grep { _lc( $_ ) eq $key } keys %{ $header_ref };
    delete @{ $header_ref }{ @keys };

    return;
}

# returns a lowercased version of a given string
sub _lc {
    my $key = lc shift;

    # get rid of an initial dash if exists
    $key =~ s{^\-}{};

    # use dashes instead of underscores
    $key =~ tr{_}{-};

    return $key;
}