#!/usr/bin/perl -- Just for the fscking colors.

package PLP::Headers; # Who cares.
use strict;
use Carp;

sub _lc($){
    local $_ = $_[0];
    tr/_/-/;
    return lc;
}

sub TIEHASH {
    return bless [ # Defaults.
        {
    	    'Content-Type'  => 'text/html',
    	    'X-PLP-Version' => $ENV{PLP_VERSION},
	},
	{
    	    'content-type'  => 'Content-Type',
    	    'x-plp-version' => 'X-PLP-Version',
	}
    ], $_[0];
}

sub FETCH {
    my ($self, $key) = @_;
    return $self->[0]->{ $self->[1]->{_lc $key} };
}

sub STORE {
    my ($self, $key, $value) = @_;
    croak 'Can\'t set headers after sending them!' if $main::INTERNAL{sentheaders};
    if (defined $self->[1]->{_lc $key}){
        $key = $self->[1]->{_lc $key};
    }else{
        $self->[1]->{lc $key} = $key;
    }
    return ($self->[0]->{$key} = $value);
}

sub DELETE {
    my ($self, $key) = @_;
    delete $self->[0]->{$key};
    return delete $self->[1]->{_lc $key};
}

sub CLEAR {
    my $self = $_[0];
    return (@$self = ());
}

sub EXISTS {
    my ($self, $key) = @_;
    return exists $self->[1]->{_lc $key};
}

sub FIRSTKEY {
    my $self = $_[0];
    keys %{$self->[0]};
    return each %{ $self->[0] }; # Key only, Tie::Hash doc is wrong.
}

sub NEXTKEY {
    return each %{ $_[0]->[0] };
}

package PLP::Print;
use strict;

sub TIEHANDLE {
    return bless {}, $_[0];
}

sub WRITE { undef; }

sub PRINT {
    my ($self, @param) = @_;
    main::SendHeaders() unless $main::INTERNAL{sentheaders};
    print STDOUT @param;
}

sub PRINTF {
    my ($self, @param) = @_;
    printf STDOUT @param;
}

sub READ { undef }

sub READLINE { undef }

sub GETC { '%' }

sub CLOSE { undef }

sub UNTIE { undef }

package PLP::Delay;
use strict;
no strict 'refs';

sub _replace {
    my ($self) = @_;
    untie %{$self->[0]};
    %{$self->[0]} = %{ $self->[1]->() };
}

sub TIEHASH {
    my ($class, $hash, $source) = @_;
    return bless [$hash, $source], $class;
}

sub FETCH {
    my ($self, $key) = @_;
    $self->_replace;
    return ${$self->[0]}{$key};
}

sub STORE {
    my ($self, $key, $value) = @_;
    $self->_replace;
    return ${$self->[0]}{$key} = $value;
}

sub DELETE {
    my ($self, $key) = @_;
    $self->_replace;
    return delete ${$self->[0]}{key};
}

sub CLEAR {
    my ($self) = @_;
    $self->_replace;
    return %{$self->[0]};
}

sub EXISTS {
    my ($self, $key) = @_;
    $self->_replace;
    return exists ${$self->[0]}{key};
}

sub FIRSTKEY {
    my ($self) = @_;
    $self->_replace;
    return exists ${$self->[0]}{key};
}

sub FIRSTKEY {
    my ($self) = @_;
    $self->_replace;
    return 'PLPdummy'; # perl won't use the first key's value, 
                       # damnit
}

sub NEXTKEY {
    my ($self) = @_;
    $self->_replace;
    return each %$$self;
}

sub UNTIE { undef }

1;
