#/*
# *  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 1901 2009-12-31 02:40:20Z hikarin $
#

package Img0ch::ModPerl::Request;

use strict;
use base qw(Img0ch::Request::Interface);
use mod_perl qw();
use Apache qw();
use Apache::Constants qw();
use Apache::Cookie qw();
use Apache::Request qw();

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

sub new {
    my ( $iClass, $r ) = @_;
    my $apreq = Apache::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_perl', $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 = $r->request_time();
    $iRequest->SUPER::init( $iConfig, $ip, $time, 'mod_perl' );
    1;
}

sub handler($$) {    ## no critic
    my ( $iClass, $r ) = @_;
    $r->header_only() and return Apache::Constants::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->send_http_header();
        $r->print($errstr);
    }
    return Apache::Constants::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->header_in('content-length') )
        || 1;
    $r->read( $buffer, $length, 0 );
    return \$buffer;
}

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

sub set_header {
    my ( $iRequest, $key, $value ) = @_;
    $iRequest->{__apache}->header_out( $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 ) = @_;

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

    my $cookies = Apache::Cookie->fetch();
    my $cookie  = $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 ) = @_;
    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);
    $r->send_http_header();
    return;
}

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

package Img0ch::Request;

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

1;
__END__
