#/*
# *  Copyright 2007-2009 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 1826 2009-04-08 15:23:25Z hikarin $
#

package Img0ch::ModPerl2::Request;

use strict;
use base qw(Img0ch::Request::Interface);
use mod_perl2 qw();
use Apache2::Connection qw();
use Apache2::Const qw(-compile);
use Apache2::Request qw();
use Apache2::RequestIO qw();
use Apache2::RequestRec qw();
use Apache2::RequestUtil qw();
use Apache2::Response qw();
use Apache2::Upload qw();

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

sub new {
    my ( $iClass, $r ) = @_;
    my $apreq = Apache2::Request->new($r);
    bless { __apache => $r, __apreq => $apreq }, $iClass;
}

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

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

*credit = \&signature;

sub init {
    my ( $iRequest, $iConfig ) = @_;
    my $r    = $iRequest->{__apache};
    my $ip   = $r->connection()->remote_ip() || '0.0.0.0';
    my $time = substr $r->request_time(), 0, 10;
    $iRequest->SUPER::init( $iConfig, $ip, time(), 'mod_perl2' );
    1;
}

sub handler : method {
    my ( $iClass, $r ) = @_;
    $r->header_only() and return Apache2::Const::OK();

    eval {
        my $iConfig = Img0ch::Config->new();
        $iConfig->load( $r->dir_config('Img0chConfigPath') );
        my $iKernel = Img0ch::Kernel->new($iConfig);
        $r->dir_config('Img0chApplicationClass')->new( $iKernel, $r )->run();
    };
    if ( my $errstr = $@ ) {
        $errstr = Img0ch::Kernel::escape_html_entities($errstr);
        $errstr =~ s/<br>/\n/gxms;
        $r->content_type('text/html');
        $r->print($errstr);
    }
    return Apache2::Const::OK();
}

sub param {
    my ( $iRequest, $key, $unescape ) = @_;
    my $q = $iRequest->{__apreq};
    $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 ($iRequest) = @_;
    my $buffer;
    my $r = $iRequest->{__apache};
    my $length
        = Img0ch::Kernel::intval( $r->headers_in()->get('content-length') )
        || 1;
    $r->read( $buffer, $length, 0 );
    return \$buffer;
}

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

sub set_header {
    my ( $iRequest, $key, $value ) = @_;
    $iRequest->{__apache}->headers_out()->set( $key, $value );
    return;
}

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

sub request_uri { $_[0]->get_header('request-uri') }

sub query { $_[0]->{__apache}->args() }

sub path_info { substr $_[0]->{__apache}->path_info(), 1 }

sub is_uploadable {
    my ( $iRequest, $key ) = @_;
    my $q = $iRequest->{__apreq};
    my $u = $q->upload($key) || return 0;
    $iRequest->{__fsize} = $u->size();
    $iRequest->{__file}  = $u->filename();
    $iRequest->{__tmp}   = $u->tempname();
    return 1;
}

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

    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;
        Apache2::Cookie->new(
            $r,
            -name    => $key,
            -value   => $value,
            -expires => $expires,
            -path    => $path,
            -secure  => $secure
        )->bake($r);
    }

    my $jar    = Apache2::Cookie::Jar->new($r);
    my $cookie = $jar->cookies($key);
    return $cookie ? $cookie->value() : undef;
}

sub enable_compress {
    $_[0]->{__apache}->content_encoding('gzip');
    return;
}

sub enable_binary {
    return;
}

sub send_http_header {
    my ( $iRequest, $type, $charset, $extend ) = @_;
    my $r = $iRequest->{__apache};

    $type ||= 'text/html';
    $charset = defined $charset ? $charset : 'Shift_JIS';
    ( index( $type, 'text/' ) == 0 ) and $type .= '; charset=' . $charset;
    $r->content_type($type);
    return;
}

sub print {
    shift->{__apache}->print( map { ${$_} } @_ );
    return;
}

package Img0ch::Request;

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

1;
__END__
