#/*
# *  Copyright 2007 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 367 2007-03-18 14:18:26Z hikarin $
#

package Img0ch::CGI::Request;

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

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

sub new {
    my ( $iClass, $param ) = @_;
    CGI::Minimal::max_read_size(16777216);
    my $q = CGI::Minimal->new();
    $param and $q->param($param);
    bless { __cgi => $q, __header => {} }, $iClass;
}

sub DESTROY { $_[0]->{__cgi}->reset_globals(); return }

sub request { }

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

*credit = \&signature;

sub init {
    my ( $iRequest, $iConfig ) = @_;
    my $ip = $ENV{REMOTE_ADDR} || '0.0.0.0';
    $iRequest->SUPER::init( $iConfig, $ip, time(), 'CGI' );
    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 { \$_[0]->{__cgi}->raw() }

sub get_header {
    my ( $iRequest, $key ) = @_;
    $key =~ tr/\-/_/;
    $key = 'HTTP_' . uc $key;
    return $ENV{$key} || '';
}

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

sub request_by_post { $ENV{REQUEST_METHOD} eq 'POST' ? 1 : 0 }

sub request_uri { $ENV{REQUEST_URI} }

sub query { $ENV{QUERY_STRING} }

sub path_info { $ENV{PATH_INFO} }

sub is_uploadable {
    my ( $iRequest, $key ) = @_;
    my $q = $iRequest->{__cgi};
    if ( $q->truncated() ) {
        print 'Content-type: text/html', "\n", 'Status: 500', "\n\n";
        exit 0;
    }
    my $file = $q->param_filename($key) || return 0;
    require File::Temp;
    my ( $fh, $filename ) = File::Temp::tempfile( UNLINK => 1 );
    binmode $fh;
    print {$fh} $q->param($key) or die Img0ch::Kernel->throw_exception($!);
    close $fh;

    $iRequest->{__file}  = $file;
    $iRequest->{__fsize} = -s $filename;
    $iRequest->{__tmp}   = $filename;
    return 1;
}

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

    if ( !$jar ) {
        $jar = {};
        my @pairs = split /;\s?/, ( $ENV{HTTP_COOKIE} || '' );
        for my $pair (@pairs) {
            $pair =~ s/\A\s+//xms;
            $pair =~ s/\s+\z//xms;
            my ( $key, $value ) = split '=', $pair;
            $value or next;
            my @values = map { $q->url_decode($_) } split /[&;]/, $value;
            $key = $q->url_decode($key);
            $jar->{$key} = @values > 1 ? [@values] : $q->url_decode($value);
        }
        %{ $iRequest->{__cookie_jar} } = %$jar;
    }
    if ( ( ref $hash || '' ) eq 'HASH' ) {
        my $q       = $iRequest->{__cgi};
        my $value   = $q->url_encode( $hash->{value} || '' );
        my $path    = $hash->{path} || '/';
        my $expires = $iRequest->{__now} + ( $hash->{expires} || 2592000 );
        my $secure  = $hash->{secure} || 0;
        my @cookie  = ( $q->url_encode($key) . '=' . $value );
        push @cookie, "path=${path}";
        push @cookie, 'expires=' . $q->date_rfc1123($expires);
        $secure and push @cookie, "secure=${secure}";
        push @{ $iRequest->{__cookie} }, join( '; ', @cookie );
    }
    return $jar->{$key} || undef;
}

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

sub send_http_header {
    my ( $iRequest, $type, $charset ) = @_;
    $type ||= 'text/html';
    $charset = defined $charset ? $charset : 'Shift_JIS';

    my $header = $iRequest->{__header};
    while ( my ( $key, $value ) = each %$header ) {
        print ucfirst($key), ': ', $value, "\n";
    }
    map { print 'Set-Cookie: ', $_, "\n" } @{ $iRequest->{__cookie} || [] };

    my $ctype = 'Content-Type: ' . $type;
    ( index( $type, 'text/' ) == 0 ) and $ctype .= '; charset=' . $charset;
    print $ctype, "\n\n";
    return;
}

sub print {
    shift;
    map { print ${$_} } @_;
    return;
}

package Img0ch::Request;

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

1;
__END__
