File Coverage

blib/lib/CGI/Application/Plugin/Header.pm

Criterion	Covered	Total	%
statement	57	58	98.2
branch	24	26	92.3
condition	2	3	66.6
subroutine	11	11	100.0
pod	3	4	75.0
total	97	102	95.1

package CGI::Application::Plugin::Header;
use 5.008_009;
use strict;
use warnings;
use parent 'Exporter';
use CGI::Header;
use Carp qw/carp croak/;

our $VERSION = '0.63008';
our @EXPORT  = qw( header header_add header_props );

sub import {
    my ( $class ) = @_;
    my $caller = caller;
    $caller->add_callback( init => \&BUILD );
    $class->export_to_level( 1, @_ );
}

sub BUILD {
    my $self = shift;
    my @args = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;

    while ( my ($key, $value) = splice @args, 0, 2 ) {
        $self->{+__PACKAGE__} = $value if lc $key eq 'header';
    }

    return;
}

sub header {
    my $self = shift;
    return $self->{+__PACKAGE__} = shift if @_;
    $self->{+__PACKAGE__} ||= CGI::Header->new( query => $self->query );
}

sub header_add {
    my $self   = shift;
    my @props  = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
    my $header = $self->header;

    carp "header_add called while header_type set to 'none'" if $self->header_type eq 'none';
    croak "Odd number of elements passed to header_add" if @props % 2;

    while ( my ($key, $value) = splice @props, 0, 2 ) {
        if ( ref $value eq 'ARRAY' ) {
            if ( $header->exists($key) ) {
                my $existing_value = $header->get( $key );
                if ( ref $existing_value eq 'ARRAY' ) {
                    $value = [ @$existing_value, @$value ];
                }
                else {
                    $value = [ $existing_value, @$value ];
                }
            }
            else {
                $value = [ @$value ];
            }
        }

        $header->set( $key => $value );
    }

    return;
}

sub header_props {
    my $self   = shift;
    my @props  = ref $_[0] eq 'HASH' ? %{$_[0]} : @_;
    my $header = $self->header;
    my $props  = $header->header;

    if ( @_ ) {
        carp "header_props called while header_type set to 'none'" if $self->header_type eq 'none';
        croak "Odd number of elements passed to header_props" if @props % 2;
        $header->clear->set(@props); # replace
    }

    map { ( "-$_" => $props->{$_} ) } keys %$props; # 'type' -> '-type'
}

1;

__END__