-#!/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;