#/*
# *  Copyright 2007-2010 hkrn <hikarin@users.sourceforge.jp>
# *
# *  Licensed under the Apache License, Version 2.0 (the "License");
# *  you may not use this file except in compliance with the License.
# *  You may obtain a copy of the License at
# *
# *      http://www.apache.org/licenses/LICENSE-2.0
# *
# *  Unless required by applicable law or agreed to in writing, software
# *  distributed under the License is distributed on an "AS IS" BASIS,
# *  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# *  See the License for the specific language governing permissions and
# *  limitations under the License.
# */
#
# $Id: Request.pm 1958 2010-01-23 11:33:09Z hikarin $
#

package Img0ch::PSGI::Request;

use strict;
use base qw(Img0ch::Request::Interface);

BEGIN { $INC{'Img0ch/Request.pm'} = __FILE__ }

sub new {
    my ( $iClass, $q ) = @_;
    $q and $q->delete( 'img0ch.psgi.headers', 'img0ch.psgi.body' );
    bless { __buffer => [], __cgi => $q, __cookie => [] }, $iClass;
}

sub request { $_[0]->{__cgi} }

sub signature {
    my ( $iRequest, $module_type, $token_type ) = @_;
    my $sign = $iRequest->{__sign};
    if ( !$sign ) {
        $sign = $iRequest->SUPER::signature( 'PSGI', $token_type );
        $iRequest->{__sign} = $sign;
    }
    return $sign;
}

*credit = \&signature;

sub init {
    my ( $iRequest, $iConfig ) = @_;
    my $ip = $iRequest->{__cgi}->remote_addr() || '0.0.0.0';
    $iRequest->SUPER::init( $iConfig, $ip, time(), 'PSGI' );
    1;
}

sub param {
    my ( $iRequest, $key, $unescape ) = @_;
    my $q = $iRequest->{__cgi};
    $unescape ||= 0;

    if ( !wantarray ) {
        my $value = $q->param($key);
        if ( !$unescape ) {
            $value = Img0ch::Kernel::escape_html_entities($value);
        }
        return $value;
    }
    elsif ( wantarray and !$key ) {
        my @result = $q->param();
        return @result;
    }
    else {
        my @r = $q->param($key);
        return
            map { $unescape ? $_ : Img0ch::Kernel::escape_html_entities($_) }
            @r;
    }
}

sub rawdata { my $buffer = $_[0]->{__cgi}->param('POSTDATA'); \$buffer }

sub get_header {
    my ( $iRequest, $key ) = @_;
    return $iRequest->{__cgi}->http($key) || '';
}

sub set_header {
    my ( $iRequest, $key, $value ) = @_;
    $key =~ tr/\-/_/;
    $iRequest->{__header}->{$key} = $value;
    return;
}

sub request_by_post { $_[0]->{__cgi}->request_method() eq 'POST' ? 1 : 0 }

sub request_uri { $_[0]->{__cgi}->request_uri() }

sub query { $_[0]->{__cgi}->query_string() }

sub path_info {
    my $path_info = $_[0]->{__cgi}->path_info();
    $path_info =~ s{\A[\w\-]+\.cgi(/)?}{$1}xms;
    $path_info;
}

sub is_uploadable {
    my ( $iRequest, $key ) = @_;
    my $q = $iRequest->{__cgi};
    my $file = $q->upload($key) || return 0;
    if ( my $error = $q->cgi_error() ) {
        die $error, "\n";
    }

    $iRequest->{__file}  = $file;
    $iRequest->{__fsize} = -s $file;
    $iRequest->{__tmp}   = $q->tmpFileName($file);
    return 1;
}

sub cookie {
    my ( $iRequest, $key, $hash ) = @_;
    my $q = $iRequest->{__cgi};

    if ( ( ref $hash || '' ) eq 'HASH' ) {
        my $value   = $hash->{value};
        my $path    = $hash->{path} || '/';
        my $expires = $iRequest->{__now} + ( $hash->{expires} || 2592000 );
        my $secure  = $hash->{secure} || 0;
        push @{ $iRequest->{__cookie} },
            $q->cookie(
            {   -name    => $key,
                -value   => $value,
                -expires => $expires,
                -path    => $path,
                -secure  => $secure
            }
            );
    }
    return $q->cookie($key) || undef;
}

sub enable_compress {
    $_[0]->{__header}->{'content-encoding'} = 'gzip';
    return;
}

sub enable_binary {
    binmode STDOUT;
    return;
}

sub send_http_header {
    my ( $iRequest, $type, $charset ) = @_;
    $type ||= 'text/html';
    $charset = defined $charset ? $charset : 'Shift_JIS';
    ( index( $type, 'text/' ) == 0 ) and $type .= '; charset=' . $charset;
    $iRequest->{__header}->{'Cookie'}       = $iRequest->{__cookie};
    $iRequest->{__header}->{'Content-Type'} = $type;
    $iRequest->{__cgi}->param( 'img0ch.psgi.headers', $iRequest->{__header} );
    return;
}

sub print {
    my $iRequest = shift;
    my $q        = $iRequest->{__cgi};
    my $buffer   = $q->param('img0ch.psgi.body') || [];
    map { push @{$buffer}, ${$_} } @_;
    $q->param( 'img0ch.psgi.body', $buffer );
    return;
}

package Img0ch::Request;

use strict;
@Img0ch::Request::ISA = qw(Img0ch::PSGI::Request);

1;
__END__
