#/*
# *  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: BBS.pm 2002 2010-02-21 13:28:07Z hikarin $
#

package Img0ch::App::BBS;

use strict;
use Img0ch::BBS qw();
use Img0ch::Template qw();
use Img0ch::Thread qw();

BEGIN {
    my $pkg = __PACKAGE__;
    for my $at (qw(form confirm index mobile_index subback error redirect)) {
        my $attr = '__template_tag_' . $at;
        no strict 'refs';
        *{"${pkg}::add_${at}_tag"} = sub {
            my ( $iApp, $tagset ) = @_;
            ( ref $tagset || '' ) eq 'HASH' or return;
            push @{ $iApp->{$attr} }, $tagset;
            return;
            }
    }
}

sub new {
    my ( $iClass, $iKernel, @args ) = @_;
    bless {
        __annotation                => {},
        _config                     => $iKernel->get_config(),
        _host                       => '',
        _ip                         => '',
        _ip_int                     => 0,
        _request                    => Img0ch::Request->new(@args),
        _serial                     => '',
        __agent                     => 0,
        __bbs                       => undef,
        __cap                       => undef,
        __error                     => '',
        __error_args                => {},
        __kernel                    => $iKernel,
        __key                       => 0,
        __mkthread                  => 0,
        __meta                      => undef,
        __param_FROM                => '',
        __param_MESSAGE             => '',
        __param_date                => '',
        __param_mail                => '',
        __param_id                  => '',
        __param_subject             => '',
        __resmax                    => 0,
        __setting                   => undef,
        __sage                      => 0,
        __stash                     => {},
        __subject                   => undef,
        __template_tag_confirm      => [],
        __template_tag_error        => [],
        __template_tag_form         => [],
        __template_tag_index        => [],
        __template_tag_mobile_index => [],
        __template_tag_redirect     => [],
        __template_tag_subback      => [],
        __thread                    => undef,
        __thread_posision           => 'age',
    }, $iClass;
}

sub run {
    my ($iApp) = @_;

    $iApp->init()         or return $iApp->redirect_error('error');
    $iApp->_switch()      or return 0;
    $iApp->get_host()     or return $iApp->redirect_error('error');
    $iApp->validate()     or return $iApp->redirect_error('error');
    $iApp->is_writeable() or return $iApp->redirect_error('error');
    $iApp->get_date();
    $iApp->post() or return $iApp->redirect_error('error');
    $iApp->update_subback( undef, 1, 0 )
        or return $iApp->redirect_error('error');
    $iApp->update_index( undef, 1, 0 );
    $iApp->redirect_success();

    return 1;
}

sub init {
    my ($iApp)   = @_;
    my $iConfig  = $iApp->{_config};
    my $iRequest = $iApp->{_request};

    $iConfig->get('Maintenance')
        and die 'img0ch MAINTENANCE: Please try again later.', "\n";
    $iRequest->init($iConfig);

    my $iBBS
        = Img0ch::BBS->new( $iApp->{__kernel}, { bbs => $iRequest->bbs(), } );
    if ( !$iBBS->get_id() ) {
        $iApp->{__error} = 'INVALID_POST';
        return 0;
    }
    $iApp->{__bbs}     = $iBBS;
    $iApp->{__setting} = $iBBS->get_setting_instance();

    my $now = $iRequest->now();
    $iApp->{__agent} = $iRequest->agent();
    $iApp->{__now}   = $now;

    my $key = $iRequest->param('key');
    if ( !$iConfig->get('DisableThread924') and $key =~ /\A924\d+\z/xms ) {
        $iApp->{__error} = 'POST_SPECIAL_THREAD';
        return 0;
    }

    my $iThread;
    if ( !$key ) {
        $key     = $now;
        $iThread = $iBBS->get_thread_instance($key);
        if ( $iThread->count() ) {
            $iApp->{__error} = 'THREAD_HAS_BEEN_CREATED';
            return 0;
        }
        $iApp->{__mkthread} = 1;
    }
    else {
        $iThread = $iBBS->get_thread_instance($key);
        if ( !$iThread->count() ) {
            $iApp->{__error} = 'THREAD_NOT_FOUND';
            return 0;
        }
        $iApp->{__mkthread} = 0;
    }

    $iApp->{__key}    = $key;
    $iApp->{__thread} = $iThread;
    $iApp->_plugin( $iBBS, $iConfig, 'bbs.init', 'DisableBBSInitPlugin' )
        or return 0;

    return 1;
}

sub get_host {
    my ($iApp)   = @_;
    my $iRequest = $iApp->{_request};
    my $host     = $iRequest->get_remote_host();
    my $re       = qr/\A(\d+)\.(\d+)\.(\d+)\.(\d+)\z/xms;

    if (   $iRequest->get_header('via') =~ $re
        || $iRequest->get_header('x-forwarded-for') =~ $re
        || $iRequest->get_header('forwarded') =~ $re )
    {
        my $proxy = gethostbyaddr( pack( 'C4', ( $1, $2, $3, $4 ) ), 2 )
            || join( '.', $1, $2, $3, $4 );
        $host .= '&lt;' . $proxy . '&gt;';
    }
    $iApp->{_host}   = $host;
    $iApp->{_ip}     = $iRequest->ip();
    $iApp->{_ip_int} = $iRequest->ip_int();

    my $mode = $iApp->{__agent};
    $mode == 4 and return 1;

    if ( $iRequest->is_mobile_device($mode) ) {
        my $serial = $iApp->{_serial} = $iRequest->get_device_id($mode);
        if ($serial) {
            if (!$iApp->config()->get('DisableBBMCheck')
                and $iApp->is_bbm(
                    $iApp->_imode_id_for_dns( $serial, $mode ),
                    $iRequest->now()
                )
                )
            {
                $iApp->{__error} = 'DENY_FROM_BBM_LISTED_HOST';
                return 0;
            }
        }
        else {
            $iApp->{__error} = 'POST_WITHOUT_SERIAL';
            return 0;
        }
    }

    return 1;
}

sub validate {
    my ($iApp)   = @_;
    my $iBBS     = $iApp->{__bbs};
    my $iConfig  = $iApp->{_config};
    my $iKernel  = $iApp->{__kernel};
    my $iSetting = $iApp->{__setting};
    my $iRequest = $iApp->{_request};
    my $charset  = $iBBS->get_encoding();
    my $utf8 = $iRequest->param('utf8') ? 'utf8' : undef;
    my ( $comment, $subject );

    my $name = $iRequest->param( 'FROM', 1 );
    $name =~ tr/\r\n\t//d;
    $iApp->escape_chars( \$name, 1 );
    $iApp->trip(
        \$name,
        $iSetting->get_int('BBS_TRIPCOLUMN'),
        $iKernel->get_encoded_str(
            $iKernel->translate_symbol('TrueTrip'),
            $charset, 'utf8'
        )
    );

    my $mail = $iRequest->param('mail');
    $mail =~ tr/\r\n\t//d;
    $mail =~ s/&(?:amp;)?\#(\d+;)/&&$1/gxms;
    $mail =~ s/\#(.+)\z//xms;
    my $pass = $1 || '';
    my $iCap = $iBBS->get_cap_instance($pass);
    $iCap->load();
    $iCap->is_valid();

    if ( $charset eq 'sjis' ) {

        # code from ShiftJIS::String by SADAHIRO tomoyuki
        my $is_sjis_function = sub {
            my $str = shift || return 1;
            $str =~ s/[\x00-\x7F\xA1-\xDF]|
                [\x81-\x9F\xE0-\xFC][\x40-\x7E\x80-\xFC]//gxms;
            return length $str ? 0 : 1;
        };
        ( $utf8 or !$is_sjis_function->($name) )
            and $name = $iKernel->get_encoded_str( $name, $charset, $utf8 );
        ( $utf8 or !$is_sjis_function->($mail) )
            and $mail = $iKernel->get_encoded_str( $mail, $charset, $utf8 );
        $comment = $iRequest->param('MESSAGE');
        ( $utf8 or !$is_sjis_function->($comment) )
            and $comment
            = $iKernel->get_encoded_str( $comment, $charset, $utf8 );
        $subject = $iRequest->param('subject');
        ( $utf8 or !$is_sjis_function->($subject) )
            and $subject
            = $iKernel->get_encoded_str( $subject, $charset, $utf8 );
    }
    else {
        $name = $iKernel->get_encoded_str( $name, $charset, $utf8 );
        $mail = $iKernel->get_encoded_str( $mail, $charset, $utf8 );
        $comment = $iKernel->get_encoded_str( $iRequest->param('MESSAGE'),
            $charset, $utf8 );
        $subject = $iKernel->get_encoded_str( $iRequest->param('subject'),
            $charset, $utf8 );
    }

    my $enable_unicode = $iSetting->get('BBS_UNICODE') eq 'change' ? 0 : 1;
    $enable_unicode
        ? $mail =~ s/&&(\d+;)/&#$1/gxms
        : $mail =~ s/&&(\d+;)/&amp;#$1/gxms;

    my $limitless = $iCap->can_post_without_limit();
    if ( !$limitless ) {
        if ( $iSetting->get_int('BBS_MAIL_COUNT') < length $mail ) {
            $iApp->{__error} = 'TOO_LONG_MAIL';
            return 0;
        }
    }

    my $mkthread = $iApp->{__mkthread};
    if ( !$mkthread and index( $mail, 'sage' ) >= 0 ) {
        $iApp->{__sage}            = 1;
        $iApp->{__thread_posision} = 'sage';
    }

    if ( !$limitless ) {
        if ( $iSetting->get_int('BBS_NAME_COUNT') < length $name ) {
            $iApp->{__error} = 'TOO_LONG_NAME';
            return 0;
        }
    }
    if ( !$limitless ) {
        if ( $iSetting->is_checked('NANASHI_CHECK') and $name eq '' ) {
            $iApp->{__error} = 'NO_NAME';
            return 0;
        }
    }

    my $capn;
    if ( $iCap->can_add_cap_name() ) {
        $capn = $iCap->get_name();
    }
    if ( !$name and !$capn ) {
        $name = $iSetting->get('BBS_NONAME_NAME');
        $iApp->{__param_FROM} = $name;
    }

    my $host = $iApp->{_host};
    $name =~ s|\Afusianasan|</b>$host<b>|xms;
    $name =~ s|fusianasan| </b>$host<b>|gxms;

    if ($capn) {
        my $atmark
            = $iKernel->get_encoded_str( $iKernel->translate_symbol('Atmark'),
            $charset, 'utf8' );
        my $star
            = $iKernel->get_encoded_str(
            $iKernel->translate_symbol('TrueCap'),
            $charset, 'utf8' );
        if ($name) {
            $name .= $atmark . $capn . ' ' . $star;
        }
        else {
            $name = join ' ', $capn, $star;
        }
    }

    my $len = length $comment;
    if ( $len == 0 ) {
        $iApp->{__error} = 'NO_MESSAGE';
        return 0;
    }
    if ( !$limitless ) {
        if ( $iSetting->get_int('BBS_MESSAGE_COUNT') < $len ) {
            $iApp->{__error} = 'TOO_LONG_MESSAGE';
            return 0;
        }
    }
    my ( $ln, $cl ) = $iApp->get_text_info( \$comment );
    if ( !$limitless ) {
        if ( $iSetting->get_int('BBS_LINE_NUMBER') * 2 < $ln ) {
            $iApp->{__error} = 'TOO_MANY_BREAKS';
            return 0;
        }
    }
    if ( !$limitless ) {
        if ( $iSetting->get_int('BBS_COLUMN_NUMBER') < $cl ) {
            $iApp->{__error} = 'TOO_LONG_LINE';
            return 0;
        }
    }
    my $ank = $iConfig->get_int('Ankers') || 15;
    if ( !$limitless and $iApp->count_anchors($comment) > $ank ) {
        $iApp->{__error} = 'TOO_MANY_ANKERS';
        return 0;
    }
    if ( $iSetting->is_checked('BBS_ENABLE_ANNOTATION') ) {
        my @new_comment;
        my $hash = {};
        my $seen = {};
        for my $line ( split "\n", $comment ) {
            if ( $line !~ /\A\@([\w:]+)\s*[\s=]\s*(.+)\r?\z/xms ) {
                push @new_comment, $line;
                next;
            }
            my ( $key, $value ) = ( $1, $2 );
            $value =~ s/\s+\z//xms;
            if ( $seen->{$key} ) {
                push @new_comment, $line;
                next;
            }
            $seen->{$key} = 1;
            $hash->{$key} = $value;
            $line =~ s/\A\@(\w+)[\s=]\s*(.+)\r?\z//xms;
        }
        %{ $iApp->{__annotation} } = %$hash;
        $comment = join "\n", @new_comment;
    }

    $comment =~ s/\A[ \f\t]+//xms;
    $comment =~ s/[ \f\t]+\z//xms;
    $comment =~ s/\r\n/\n/gxms;
    $comment =~ s/\n/<br>/gxms;
    $comment =~ tr/\r\t//d;
    $enable_unicode and $comment =~ s/&amp;(\#?\w+;)/&$1/gxms;

    if ($mkthread) {
        if ( $subject eq '' ) {
            $iApp->{__error} = 'NO_SUBJECT';
            return 0;
        }
        if ( !$limitless ) {
            if ( $iSetting->get_int('BBS_SUBJECT_COUNT') < length $subject ) {
                $iApp->{__error} = 'TOO_LONG_SUBJECT';
                return 0;
            }
        }
        $subject =~ tr/\r\n\t//d;
        $iApp->{__param_subject} = $subject;
    }

    $iApp->{__cap}           = $iCap;
    $iApp->{__param_FROM}    = $name;
    $iApp->{__param_mail}    = $mail;
    $iApp->{__param_MESSAGE} = $comment;

    return 1;
}

sub is_writeable {
    my ($iApp) = @_;

    my $iBBS    = $iApp->{__bbs};
    my $iConfig = $iApp->{_config};
    $iApp->_plugin( $iBBS, $iConfig, 'bbs.filter', 'DisableBBSFilterPlugin' )
        or return 0;

    my $iCap     = $iApp->{__cap};
    my $iSetting = $iApp->{__setting};
    my $rdonly   = $iSetting->get('BBS_READONLY');
    if ( $rdonly ne 'none' ) {
        if ($rdonly eq 'on'
            or ( $rdonly eq 'caps'
                and !$iCap->can_post_to_readonly() )
            )
        {
            $iApp->{__error} = 'POST_READONLY_BBS';
            return 0;
        }
    }

    my $resmax 
        = $iApp->{__resmax} 
        = $iConfig->get_int('ResMAX')
        || $iSetting->get_int('BBS_RES_MAX')
        || 1000;
    if ( $iApp->{__mkthread} ) {
        if ( $iSetting->is_checked('BBS_THREADCAPONLY')
            and !$iCap->can_create_thread_to_readonly() )
        {
            $iApp->{__error} = 'POST_CAPONLY_BBS';
            return 0;
        }
        if ( !$iCap->can_create_thread_limitless() ) {
            my $args = {
                ip    => $iApp->{_ip_int},
                max   => $iSetting->get_int('BBS_THREAD_TATESUGI'),
                pass  => $iCap->can_create_thread_limitless(),
                stamp => $iApp->{__now},
            };
            defined &{'Img0ch::Filter::Thread::write_ok'}
                or require Img0ch::Filter::Thread;
            if ( !Img0ch::Filter::Thread->write_ok( $args, $iBBS ) ) {
                $iApp->{__error} = $args->{error};
                return 0;
            }
        }
    }
    else {
        my $iThread  = $iApp->{__thread};
        my $mkthread = $iApp->{__mkthread};
        my $error    = 0;
        my $max_size = $iSetting->get_int('BBS_DATMAX') * 1024;
        if (    !$mkthread
            and !$iThread->can_write( \$error, $max_size, $resmax ) )
        {
            $iApp->{__error} = [
                'UNKNOWN_ERROR',     'POST_STOPPED_THREAD',
                'POST_MOVED_THREAD', 'POST_OVER_THREAD',
                'LIMIT_THREAD_SIZE',
            ]->[$error];
            %{ $iApp->{__error_args} } = ( RESMAX => $resmax );
            return 0;
        }
        my $samba = $iConfig->get_int('SambaCount') || 30;
        my $args = {
            duplicate_ok => $iCap->can_double_post(),
            ip           => $iApp->{_ip_int},
            digest       => _sha1_b64( $iApp->{__param_MESSAGE} ),
            samba_close  => $samba,
            samba_ok     => $iConfig->get('DisableSamba')
                || $iCap->can_post_sambaless(),
            samba_wait => ( $iConfig->get_int('SambaWait')   || 3600 ),
            serial     => $iApp->{_serial},
            stamp      => $iApp->{__now},
            store      => ( $iConfig->get_int('LogStackMAX') || 255 ),
            timeclose  => $iSetting->get_int('timeclose'),
            timecount  => $iSetting->get_int('timecount'),
            throttle_ok => $iConfig->get('DisableThrottle')
                || $iCap->can_throttled_post(),
        };
        defined &{'Img0ch::Filter::Res::write_ok'}
            or require Img0ch::Filter::Res;
        if ( !Img0ch::Filter::Res->write_ok( $args, $iBBS ) ) {
            $iApp->{__error} = $args->{error};
            %{ $iApp->{__error_args} } = (
                WAIT    => $args->{samba_rest},
                SAMBA   => $args->{samba_count},
                SAMBATM => $samba,
            );
            return 0;
        }
    }

    return 1;
}

sub get_date {
    my ($iApp)   = @_;
    my $iConfig  = $iApp->{_config};
    my $now      = $iApp->{__now};
    my $host     = $iApp->{_host};
    my $serial   = $iApp->{_serial};
    my $mode     = '';
    my $iCap     = $iApp->{__cap};
    my $iSetting = $iApp->{__setting};

    my @seed
        = $iConfig->get('FixIDFromMobile')
        ? ( $serial || $host )
        : ( $serial, $host );
    my $id = $iApp->get_poster_id( $now, @seed, $iConfig->get('Seed'),
        $iApp->{__bbs}->get_name() );

    if ( $iSetting->is_checked('BBS_SLIP') ) {
        $mode
            = $iApp->{_request}->get_device_mark( $iApp->{__agent}, $host,
            $iApp->{_request}->get_header('user-agent'),
            );
    }
    if ( $iSetting->is_checked('BBS_NO_ID') ) {
        $id = length $mode ? " ${mode}" : '';
    }
    elsif ( $iCap->can_id_to_unknown() ) {
        $id = ' ID:???' . $mode;
    }
    elsif ( $iSetting->is_checked('BBS_DISP_IP') ) {
        $id = ' HOST:' . $host;
    }
    elsif ( $iSetting->is_checked('BBS_FORCE_ID') ) {
        $id = ' ID:' . $id . $mode;
    }
    else {
        $id = $iApp->{__sage} ? " ID:???${mode}" : " ID:${id}${mode}";
    }

    my $iKernel = $iApp->{__kernel};
    my $charset = $iApp->{__bbs} ? $iApp->{__bbs}->get_encoding() : undef;
    $iApp->{__param_id}   = $id;
    $iApp->{__param_date} = $iApp->get_date_string(
        $now, $$,
        ( $iConfig->get('DateFormat') || '%Y/%m/%d(%w) %H:%M:%S' ),
        (   $iSetting->get('BBS_YMD_WEEKS') || $iKernel->get_encoded_str(
                $iKernel->translate_symbol('Week'),
                $charset, 'utf8'
            )
        )
    );

    return 1;
}

sub post {
    my ($iApp)  = @_;
    my $error   = 0;
    my $iConfig = $iApp->{_config};
    my $iThread = $iApp->{__thread};

    my $iBBS  = $iApp->{__bbs};
    my $count = $iThread->count() + 1;
    $iApp->_plugin( $iBBS, $iConfig, 'bbs.write.pre',
        'DisableBBSPresavePlugin' )
        or return 0;

    my $key        = $iApp->{__key};
    my $iRequest   = $iApp->{_request};
    my $iSetting   = $iApp->{__setting};
    my $mkthread   = $iApp->{__mkthread};
    my $mode       = $iSetting->get('BBS_MODE');
    my $uploadable = (
               ( $mode eq 'picture' and !$mkthread )
            or ( $mode eq 'news' and $mkthread )
            or
            ( $iSetting->is_checked('BBS_IMG_UPLOAD_THREAD') and $mkthread )
    );

    if ( $uploadable and $iRequest->is_uploadable('file') ) {
        $iApp->_upload( $count, $key, $iBBS, $iConfig, $iRequest, $iSetting )
            or return 0;
    }
    elsif ( $uploadable
        and $mkthread
        and $iSetting->is_checked('BBS_IMG_REQUIRE_UPLOADING_THREAD') )
    {
        $iApp->{__error} = 'UPLOAD_WITHOUT_FILE';
        return 0;
    }
    elsif ( $uploadable
        and !$mkthread
        and $iSetting->is_checked('BBS_IMG_REQUIRE_UPLOADING_RES') )
    {
        $iApp->{__error} = 'UPLOAD_WITHOUT_FILE';
        return 0;
    }

    my $iLog = $iBBS->get_log_instance($key);
    $iLog->add(
        $count,
        [   $iApp->{__now},   $iApp->{_ip_int},
            $iApp->{_serial}, $iRequest->get_header('user-agent'),
        ]
    );
    $iLog->save();

    $iThread->set(
        [   $iApp->{__param_FROM},    $iApp->{__param_mail},
            $iApp->{__param_date},    $iApp->{__param_id},
            $iApp->{__param_MESSAGE}, $iApp->{__param_subject},
        ]
    );
    $iThread->save() or return 0;

    if ( $iApp->{__resmax} <= $count ) {
        my $iMeta   = $iBBS->get_metadata_instance();
        my $content = $iMeta->thread_end();
        if ( !$content ) {
            my $iKernel = $iApp->{__kernel};
            my $path    = join '/', $iConfig->get('SystemPath'), '1000.txt';
            my $fh      = $iKernel->get_read_file_handle($path);
            $content = do { local $/ = undef; <$fh> };
            close $fh or $iKernel->throw_io_exception($path);
        }
        my $end = [ split '<>', $content ];
        $end->[4] = $end->[3];
        $end->[3] = '';
        $iThread->set($end);
        $iThread->save() or return 0;
        $count++;
    }

    my $iSubject = $iBBS->get_subject_instance();
    my $operate  = $iApp->{__thread_posision};
    $iSubject->$operate( $key, $count, $iApp->{__param_subject} );
    $iSubject->save() or return 0;
    $iApp->{__subject} = $iSubject;

    return 1;
}

sub update_subback {
    my ( $iApp, $iBBS, $execute_plugins, $nodisk ) = @_;
    $iBBS ||= $iApp->{__bbs};
    my $iConfig = $iApp->{_config};

    if ($execute_plugins) {
        $iApp->_plugin( $iBBS, $iConfig, 'bbs.write.post',
            'DisableBBSPostsavePlugin' )
            or return 0;
    }
    $iConfig->get('FastWriteMode') and return 1;

    my $stack    = [];
    my $i        = 1;
    my $iSetting = $iApp->{__setting};
    $iSetting
        or $iSetting = $iApp->{__setting} = $iBBS->get_setting_instance();
    my $iSubject = $iApp->{__subject};
    $iSubject
        or $iSubject = $iApp->{__subject} = $iBBS->get_subject_instance();

    for my $key ( @{ $iSubject->to_array() } ) {
        my $subj = $iSubject->get($key);
        push @{$stack},
            {
            'res' => $subj->[1],
            'key' => $key,
            'subject' =>
                ( $subj->[0] || $iApp->recover_thread_subject($key) ),
            'count' => $i,
            'index' => $i,
            };
        $i++;
    }

    my $iMeta = $iApp->{__meta} ||= $iBBS->get_metadata_instance();
    my $param = {
        ( map { %{$_} } @{ $iApp->{__template_tag_subback} } ),
        'Banner'            => $iMeta->main_banner(),
        'META'              => $iMeta->meta(),
        'Renderer'          => ( $iConfig->get('Renderer') || 'read.cgi' ),
        'RendererSeparator' => ( $iConfig->get('RendererSeparator') || '/' ),
        'Threads'           => $stack,
    };
    $nodisk and return $param;

    my $iTemplate = $iBBS->get_template_instance(
        {   file    => 'subback',
            request => $iApp->{_request},
            setting => $iSetting,
        }
    );
    $iTemplate->param($param);
    $iTemplate->save( $iBBS->path('subback.html') );
    1;
}

sub update_index {
    my ( $iApp, $iBBS, $execute_plugins, $nodisk ) = @_;
    my $iConfig  = $iApp->{_config};
    my $iRequest = $iApp->{_request};
    $iConfig->get('FastWriteMode') and return 1;
    $iBBS ||= $iApp->{__bbs};

    my $iPlugin = $iApp->{__plugin} || $iBBS->get_plugin_instance();
    my $plugin = $iPlugin->iterator( 'bbs.rewrite', sub { ${ $_[3] } } );

    my $iSetting = $iApp->{__setting};
    $iSetting
        or $iSetting = $iApp->{__setting} = $iBBS->get_setting_instance();
    my $iSubject = $iApp->{__subject};
    $iSubject
        or $iSubject = $iApp->{__subject} = $iBBS->get_subject_instance();
    my $iThread = $iApp->{__thread};
    $iThread or $iThread = $iApp->{__thread} = $iBBS->get_thread_instance(0);
    $iConfig->get('EnableXHTMLBreak') and $iThread->enable_xhtml_break();

    my $all_threads         = $iSubject->to_array();
    my $num                 = @{$all_threads};
    my $floatable           = $iSetting->get_int('BBS_THREAD_NUMBER');
    my $limit               = $iSetting->get_int('BBS_MAX_MENU_THREAD') + 1;
    my $cnum                = $iSetting->get_int('BBS_CONTENTS_NUMBER');
    my $first               = $num > 1 ? 2 : 1;
    my $bbs                 = $iBBS->get_name();
    my $id                  = $iBBS->get_id();
    my $float_thread_stack  = [];
    my $stored_thread_stack = [];
    my $i                   = 1;

    $floatable = $num < $floatable ? $num : $floatable;
    for my $key ( @{$all_threads} ) {
        $i == $limit and last;
        my $subj  = $iSubject->get($key);
        my $count = $subj->[1];
        if ( $i <= $floatable ) {
            my $reses = [];
            my ( $up, $down )
                = _update_index_anchors( $i, $floatable, $first );
            $iThread->set_key($key);
            $iThread->load();
            _update_index_thread( $iConfig, $iSetting, $iThread, $reses,
                $plugin, $key, $count, $cnum );
            push @{$float_thread_stack},
                {
                'res'     => $count,
                'key'     => $key,
                'subject' => $iThread->get_subject(),
                'index'   => $i,
                'reses'   => $reses,
                'Thread'  => $reses,
                'up'      => $up,
                'down'    => $down,
                };
        }
        else {
            push @{$stored_thread_stack},
                {
                'res' => $count,
                'key' => $key,
                'subject' =>
                    ( $subj->[0] || $iApp->recover_thread_subject($key) ),
                'index' => $i,
                };
        }
        $i++;
    }

    my $iMeta       = $iApp->{__meta} || $iBBS->get_metadata_instance();
    my $head        = $iMeta->head();
    my $meta        = $iMeta->meta();
    my $foot        = $iMeta->foot();
    my $index_param = {
        'Icons' => [],
        ( map { %{$_} } @{ $iApp->{__template_tag_index} } ),
        'Banner'            => $iMeta->main_banner(),
        'FOOT'              => $foot,
        'HEAD'              => $head,
        'META'              => $meta,
        'Renderer'          => ( $iConfig->get('Renderer') || 'read.cgi' ),
        'RendererSeparator' => ( $iConfig->get('RendererSeparator') || '/' ),
        'Stored'            => $stored_thread_stack,
        'SubBanner'         => $iMeta->sub_banner(),
        'Threads'           => $float_thread_stack,
    };
    my $mobile_float_thread_param
        = [ @{$float_thread_stack}, @{$stored_thread_stack}, ];
    @{$mobile_float_thread_param} = splice(
        @{$mobile_float_thread_param},
        0, $iSetting->get_int('BBS_MB_THREAD_NUMBER'),
    );
    my $mi_param = {
        ( map { %{$_} } @{ $iApp->{__template_tag_mobile_index} } ),
        'Banner'  => $iMeta->mobile_banner(),
        'Count'   => scalar @{$mobile_float_thread_param},
        'CR'      => "\n",
        'FOOT'    => $foot,
        'HEAD'    => $head,
        'META'    => $meta,
        'Next'    => 1 + $iSetting->get_int('BBS_MB_THREAD_NUMBER'),
        'Threads' => $mobile_float_thread_param,
    };
    $nodisk and return ( $index_param, $mi_param );

    my $iTemplateIndex = $iBBS->get_template_instance(
        {   file    => 'index',
            request => $iRequest,
            setting => $iSetting,
        }
    );
    $iTemplateIndex->param($index_param);
    $iTemplateIndex->save( $iBBS->path('index.html') );

    my $iTemplateMobile = $iBBS->get_template_instance(
        {   file    => 'i_index',
            request => $iRequest,
            setting => $iSetting,
        }
    );
    $iTemplateMobile->param($mi_param);
    $iTemplateMobile->save( $iBBS->path('i/index.html'),
        sub { ${ $_[0] } =~ s/\n//gxms; ${ $_[0] } } );
    1;
}

sub get_poster_id { shift->get_day_id(@_); }

sub get_day_id {
    my ( $iApp, $now, @argument ) = @_;
    my $iBBS = $iApp->{__bbs};
    my $iMeta = $iApp->{__meta} ||= $iBBS->get_metadata_instance();
    push @argument, $iMeta->random_data_ymd($now);
    return substr Digest::MD5::md5_base64(@argument), 0, 8;
}

*id = \&get_poster_id;

sub get_date_string {
    my ( $iClass, $now, $msec, $format, $week ) = @_;

    my @date = localtime($now);
    $date[5] += 1900;
    $date[4]++;
    $date[4] = sprintf '%02d', $date[4];
    $date[3] = sprintf '%02d', $date[3];
    $date[2] = sprintf '%02d', $date[2];
    $date[1] = sprintf '%02d', $date[1];
    $date[0] = sprintf '%02d', $date[0];
    my $short = substr $date[5], 2, 2;
    $week = ( split '/', $week )[ $date[6] ];

    $format =~ s/%[Ss]/$date[0]/gxms;
    $format =~ s/%[Mi]/$date[1]/gxms;
    $format =~ s/%H/$date[2]/gxms;
    $format =~ s/%d/$date[3]/gxms;
    $format =~ s/%m/$date[4]/gxms;
    $format =~ s/%Y/$date[5]/gxms;
    $format =~ s/%y/$short/gxms;
    $format =~ s/%w/$week/gxms;
    $format =~ s/%u/sprintf('%02d', $msec)/gexms;
    $format;
}

*date = \&get_date_string;

sub trip {
    my ( $iClass, $name, $column, $trip ) = @_;
    $trip ||= pack( 'C*', ( 0x81, 0x9f ) );

    if ( $$name =~ /\A(.*?)\#(.+)\z/xms ) {
        my ( $nm, $key ) = ( Img0ch::Kernel::escape_html_entities($1), $2 );
        my $t;
        if ( length $key >= 12 ) {
            my $mark = ord($key);
            if ( $mark == ord('#') || $mark == ord('$') ) {
                if ( $key
                    =~ m{\A\#([[:xdigit:]]{16})([\./0-9A-Za-z]{0,2})\z}xms )
                {
                    $t = substr crypt( pack( 'H*', $1 ), $2 . '..' ),
                        -1 * $column;
                }
                else {
                    $t = '???';
                }
            }
            else {
                $t = substr _sha1_b64($key), 0, 12;
                $t =~ tr/+/./;
            }
        }
        else {
            my $salt = substr( substr( $key, 0, 8 ) . 'H.', 1, 2 );
            $salt =~ s/[^\.-z]/\./gxms;
            $salt =~ tr/\x3A-\x40\x5B-\x60\x00-\x2D\x7B-\xFF/A-Ga-f./;
            $t = substr crypt( $key, $salt ), -1 * $column;
        }
        $nm = Img0ch::Kernel::escape_html_entities($nm);
        $$name = $nm ? "${nm} </b>${trip}${t} <b>" : "</b>${trip}${t} <b>";
        return 1;
    }
    $$name = Img0ch::Kernel::escape_html_entities($$name);

    return 0;
}

sub escape_chars {
    my ( $iApp, $data, $f ) = @_;
    my $iKernel = $iApp->{__kernel};
    my $charset = $iApp->{__bbs} ? $iApp->{__bbs}->get_encoding() : undef;

    my $cap1
        = $iKernel->get_encoded_str( $iKernel->translate_symbol('TrueCap'),
        $charset, 'utf8' );
    my $cap0
        = $iKernel->get_encoded_str( $iKernel->translate_symbol('FalseCap'),
        $charset, 'utf8' );
    my $tr1
        = $iKernel->get_encoded_str( $iKernel->translate_symbol('TrueTrip'),
        $charset, 'utf8' );
    my $tr0
        = $iKernel->get_encoded_str( $iKernel->translate_symbol('FalseTrip'),
        $charset, 'utf8' );
    my $rcv1
        = $iKernel->get_encoded_str( $iKernel->translate_symbol('Recover'),
        $charset, 'utf8' );
    my $rcv0
        = $iKernel->get_encoded_str(
        $iKernel->translate_symbol('RecoverEscaped'),
        $charset, 'utf8' );
    my $del1
        = $iKernel->get_encoded_str( $iKernel->translate_symbol('Deleter'),
        $charset, 'utf8' );
    my $del0
        = $iKernel->get_encoded_str(
        $iKernel->translate_symbol('DeleterEscaped'),
        $charset, 'utf8' );
    my $ldr1
        = $iKernel->get_encoded_str( $iKernel->translate_symbol('Leader'),
        $charset, 'utf8' );
    my $ldr0
        = $iKernel->get_encoded_str(
        $iKernel->translate_symbol('LeaderEscaped'),
        $charset, 'utf8' );
    $$data =~ s/\Q$cap1\E/$cap0/gxms;
    $$data =~ s/\Q$tr1\E/$tr0/gxms;
    $$data =~ s/\Q$rcv1\E/$rcv0/gxms;
    $$data =~ s/\Q$del1\E/$del0/gxms;
    $$data =~ s/\Q$ldr1\E/$ldr0/gxms;

    if ($f) {
        my $adm1
            = $iKernel->get_encoded_str( $iKernel->translate_symbol('Admin'),
            $charset, 'utf8' );
        my $adm0
            = $iKernel->get_encoded_str(
            $iKernel->translate_symbol('AdminEscaped'),
            $charset, 'utf8' );
        my $adn1
            = $iKernel->get_encoded_str( $iKernel->translate_symbol('Adnin'),
            $charset, 'utf8' );
        my $adn0
            = $iKernel->get_encoded_str(
            $iKernel->translate_symbol('AdninEscaped'),
            $charset, 'utf8' );
        $$data =~ s/\Q$adm1\E/$adm0/gxms;
        $$data =~ s/\Q$adn1\E/$adn0/gxms;
    }

    return 1;
}

sub is_referer {
    my ($iApp)   = @_;
    my $iRequest = $iApp->{_request};
    my $svr      = $iApp->{_config}->get('Server');

    $iRequest->get_header('referer')    =~ /$svr/xms      and return 1;
    $iRequest->get_header('user-agent') =~ /Monazilla/xms and return 1;
    0;
}

sub get_text_info {
    my ( $iClass, $ptext ) = @_;

    $$ptext =~ /\n/xms || return ( 1, length $$ptext );
    my $text = $$ptext;

    defined $List::Util::VERSION or require List::Util;
    my $max = List::Util::maxstr( split "\n", $$ptext ) || '';

    return ( $text =~ tr/\n//d, length $max );
}

sub count_anchors {
    my ( $iApp, $comment ) = @_;
    my @comment = $comment =~ /&gt;&gt;(?:\d*-?\d*)/gxms;
    return scalar @comment;
}

sub is_bbm {
    my ( $iClass, $serial, $now ) = @_;
    my $addr = sprintf 'img0ch.%s.%s.%s.bbm.2ch.net', $$, ( $now || time ),
        $serial;
    $addr = gethostbyname($addr) || '';
    return join( '.', ( unpack( 'C*', $addr ) ) ) eq '127.0.0.2' ? 1 : 0;
}

sub get_plugin_config {
    my ( $iApp, $plugin_id, $name, $merge_level ) = @_;
    my $iKernel = $iApp->{__kernel};
    my $bbs     = $iApp->{__bbs}->get_id();
    my $key     = $iApp->{__key};
    my $ret     = [];

    if ( $merge_level & 2 ) {
        my $config_thread
            = Img0ch::Plugin->retrive( $plugin_id, $bbs, $key, $iKernel );
        ( ( ref $config_thread || '' ) eq 'HASH' )
            and push @$ret, $config_thread->{$name};
    }
    if ( $merge_level & 1 ) {
        my $config_bbs
            = Img0ch::Plugin->retrive( $plugin_id, $bbs, undef, $iKernel );
        ( ( ref $config_bbs || '' ) eq 'HASH' )
            and push @$ret, $config_bbs->{$name};
    }
    my $config
        = Img0ch::Plugin->retrive( $plugin_id, undef, undef, $iKernel );
    ( ( ref $config || '' ) eq 'HASH' )
        and push @$ret, $config->{$name};
    return $ret;
}

sub is_make_new_thread { $_[0]->{__mkthread} ? 1 : 0 }

*is_thread_builder = \&is_make_new_thread;

sub is_sage { $_[0]->{__sage} ? 1 : 0 }

sub get_name { $_[0]->{__param_FROM} }

sub set_name { $_[0]->{__param_FROM} = $_[1]; return; }

sub get_mail { $_[0]->{__param_mail} }

sub set_mail { $_[0]->{__param_mail} = $_[1]; return; }

sub get_comment { $_[0]->{__param_MESSAGE} }

sub set_comment { $_[0]->{__param_MESSAGE} = $_[1]; return; }

sub get_subject { $_[0]->{__param_subject} }

sub set_subject { $_[0]->{__param_subject} = $_[1]; return; }

sub get_ip { $_[0]->{_ip} }

sub get_ip_int { $_[0]->{_ip_int} }

sub get_remote_host { $_[0]->{_host} }

sub get_device_id { $_[0]->{_serial} }

sub get_date_and_id { [ $_[0]->{__param_date}, $_[0]->{__param_id} ] }

sub get_annotation { $_[0]->{__annotation}->{ $_[1] } || '' }

sub get_error { $_[0]->{__error} }

sub set_error { $_[0]->{__error} = $_[1]; return; }

sub set_error_argument { $_[0]->{__error_args} = $_[1]; return; }

sub bbs { $_[0]->{__bbs} }

sub cap { $_[0]->{__cap} }

sub config { $_[0]->{_config} }

sub kernel { $_[0]->{__kernel} }

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

sub setting { $_[0]->{__setting} }

sub subject { $_[0]->{__subject} }

sub thread { $_[0]->{__thread} }

sub upload { $_[0]->{__upload} }

sub stash {
    my ( $iApp, $key, $value ) = @_;
    if ($value) {
        $iApp->{__stash}->{$key} = $value;
        return;
    }
    return $iApp->{__stash}->{$key};
}

sub get_thread_position { $_[0]->{__thread_posision} }

sub set_thread_position {
    my ( $iApp, $pos ) = @_;
    $iApp->{__thread_posision} = {
        'age'   => 'age',
        'raise' => 'age',
        'sage'  => 'sage',
        'stay'  => 'sage',
        'dame'  => 'dame',
        'drop'  => 'dame',
        }->{$pos}
        || 'age';
    return;
}

sub recover_thread_subject {
    my ( $iApp, $key ) = @_;
    my $iBBS     = $iApp->{__bbs}     || return;
    my $iSubject = $iApp->{__subject} || $iBBS->get_subject_instance();
    my $iThread  = $iApp->{__thread}  || $iBBS->get_thread_instance($key);
    my $subject = $iThread->get_subject();
    $iSubject->sage( $key, $iThread->count(), $subject );
    return $subject;
}

sub _switch {
    my ($iApp) = @_;
    my $agent  = $iApp->{__agent};
    my $iBBS   = $iApp->{__bbs};
    my $key    = $iApp->{__key};

    if ( $iApp->{__mkthread} ) {
        my $iRequest = $iApp->{_request};
        my $iSetting = $iApp->{__setting};
        my $comment  = $iRequest->param('MESSAGE');
        my $pwcheck  = $iSetting->is_checked('BBS_PASSWORD_CHECK');
        if ( !$agent and $pwcheck and !$comment ) {
            my $iMeta     = $iBBS->get_metadata_instance();
            my $iTemplate = $iBBS->get_template_instance(
                {   file    => 't_form',
                    request => $iRequest,
                    setting => $iSetting,
                }
            );
            $iTemplate->param(
                {   ( map { %{$_} } @{ $iApp->{__template_tag_form} } ),
                    Banner => $iMeta->main_banner(),
                    META   => $iMeta->meta(),
                    HEAD   => $iMeta->head(),
                    FOOT   => $iMeta->foot(),
                }
            );
            $iRequest->send_http_header();
            $iTemplate->flush();
            return 0;
        }
    }

    return 1;
}

sub trigger_plugin {
    my ( $iApp, $at, $disable, $iBBS, $iConfig ) = @_;
    $iBBS    and $iApp->{__bbs}   = $iBBS;
    $iConfig and $iApp->{_config} = $iConfig;
    $iBBS    ||= $iApp->{__bbs};
    $iConfig ||= $iApp->{_config};
    $at =~ /\Abbs\.\w+\z/xms or return 0;
    $iApp->_plugin( $iBBS, $iConfig, $at, $disable );
}

sub _plugin {
    my ( $iApp, $iBBS, $iConfig, $at, $disable ) = @_;

    if ( !$iConfig->get($disable) ) {
        my $iPlugin = $iApp->{__plugin} || $iBBS->get_plugin_instance();
        $iPlugin->do( $at, $iApp ) or return 0;
        $iApp->{__plugin} ||= $iPlugin;
    }

    return 1;
}

sub _upload {
    my ( $iApp, $resno, $key, $iBBS, $iConfig, $iRequest, $iSetting ) = @_;
    my $filename = $iRequest->filename('file');
    my $ext;
    if (   !$iApp->{__cap}->can_post_without_limit()
        and $iRequest->fsize() > $iSetting->get_int('BBS_IMG_MAX_SIZE') )
    {
        $iApp->{__error} = 'UPLOAD_FILESIZE_OVER';
        return 0;
    }

    my $iUpload = $iBBS->get_upload_instance($key);
    $iApp->{__upload} = $iUpload;

    if ( $iUpload->count() > $iSetting->get_int('BBS_IMG_FILEMAX') ) {
        $iApp->{__error} = 'UPLOAD_LIMIT_STORE';
        return 0;
    }
    if ( !$iApp->_acceptable( $iSetting, $filename, \$ext ) ) {
        $iApp->{__error} = 'UPLOAD_INVALID_EXTENSION';
        return 0;
    }

    if ( $iSetting->is_checked('BBS_IMG_REQUIRE_DOWNLOAD_KEY') ) {
        my $download_key = $iApp->get_annotation('DOWNLOAD')
            || $iApp->get_annotation('download');
        if ( !$download_key ) {
            $iApp->{__error} = 'NO_DLKEY';
            return 0;
        }
        $iUpload->set_download_password($download_key);
    }

    my $remove_key = $iRequest->param('pass');
    if (   !$remove_key
        and $iSetting->is_checked('BBS_IMG_REQUIRE_REMOVE_KEY') )
    {
        $iApp->{__error} = 'UPLOAD_WITHOUT_REMOVE_KEY';
        return 0;
    }

    $iApp->_plugin( $iBBS, $iConfig, 'bbs.upload.pre',
        'DisableBBSPreUploadPlugin' )
        or return 0;

    $iUpload->set( $iRequest->tempfile(), $resno, $ext );
    if ( $iUpload->is_removed() ) {
        $iApp->{__error} = 'UPLOAD_REMOVED_FILE';
        return 0;
    }

    $iUpload->set_remove_password($remove_key);
    $iUpload->save();
    $iUpload->update_csv($resno);

    my $comment = $iApp->{__param_MESSAGE} || '';
    my $path = $iUpload->path( $resno, $ext );
    my $size = int( ( -s $path || 0 ) / 1024 );
    my $orig = '';
    if ( $iSetting->is_checked('BBS_IMG_DECODE_FILENAME') ) {
        $orig = ':'
            . ( pop @{ [ split /[\\\/:]/xms, $filename ] } || 'unknown' );
    }
    $comment
        = $iUpload->url( $resno, $ext ) . " (${size}KB${orig})<br>$comment";
    my $max = $iSetting->get_int('BBS_IMG_TAG_MAX');
    $iUpload->set_tags( \$comment, $max, $resno );
    $iApp->{__param_MESSAGE} = $comment;
    $iApp->_plugin( $iBBS, $iConfig, 'bbs.upload.post',
        'DisableBBSPostUploadPlugin' )
        or return 0;

    return 1;
}

sub _acceptable {
    my ( $iApp, $iSetting, $file, $ext ) = @_;
    my $allow = $iSetting->get('BBS_IMG_ALLOWED_EXT') || '';
    my @ext = split ',', $allow;
    if ( @ext == 0 or $ext[0] eq '' ) {
        @ext = qw(jpg gif png);
    }

    $file = lc $file;
    $file =~ s/\.([jm])peg?\z/.${1}pg/xms;
    foreach my $one (@ext) {
        if ( $file =~ /\.$one\z/xms ) {
            $$ext = $one;
            return 1;
        }
    }

    return 0;
}

sub _sha1_b64 {
    my ($text) = @_;
    if ( defined $Digest::SHA1::VERSION
        or eval 'require Digest::SHA1' )
    {
        return Digest::SHA1::sha1_base64($text);
    }
    else {
        defined $Digest::SHA::PurePerl::VERSION
            or require Digest::SHA::PurePerl;
        return Digest::SHA::PurePerl::sha1_base64($text);
    }
}

sub redirect_success {
    my ($iApp)   = @_;
    my $iBBS     = $iApp->{__bbs};
    my $iConfig  = $iApp->{_config};
    my $iRequest = $iApp->{_request};
    my $data = { ok => 1, error => '', errstr => '' };

    if ( $iRequest->param('js') ) {
        $iRequest->send_http_header( 'text/javascript', 'UTF-8' );
        $iRequest->print( $iRequest->get_json($data) );
    }
    elsif ( $iRequest->param('xml') ) {
        $iRequest->send_http_header( 'application/xml', 'UTF-8' );
        $iRequest->print( $iRequest->get_xml( { response => $data } ) );
    }
    else {
        my $iTemplate = $iBBS->get_template_instance(
            {   file    => 'redirect',
                request => $iRequest,
                setting => $iApp->{__setting},
            }
        );
        my $is_mobile = $iApp->{_serial} ? 1 : 0;
        my $iMeta = $iApp->{__meta} ||= $iBBS->get_metadata_instance();
        my $main_banner = $iMeta->main_banner();
        $iTemplate->param(
            {   ( map { %{$_} } @{ $iApp->{__template_tag_redirect} } ),
                'Banner'       => $main_banner,
                'IsMobile'     => $is_mobile,
                'KEY'          => $iApp->{__key},
                'RedirectWait' => ( $iConfig->get_int('RedirectWait') || 5 ),
                'Referer'      => $iRequest->get_header('referer'),
            }
        );
        $iRequest->send_http_header( 'text/html', $iBBS->get_encoding() );
        $iTemplate->flush(
            $is_mobile
            ? sub { ${ $_[0] } =~ tr/\n//d; ${ $_[0] } }
            : undef
        );
    }

    return 1;
}

sub redirect_error {
    my ( $iApp, $template, $cs, $filter, $callback ) = @_;
    my $iConfig  = $iApp->{_config};
    my $iKernel  = $iApp->{__kernel};
    my $iBBS     = $iApp->{__bbs};
    my $iObject  = $iBBS || $iKernel;
    my $iRequest = $iApp->{_request};

    defined &{'Img0ch::Error::new'} or require Img0ch::Error;
    my $key = $iApp->{__key} || $iRequest->key();
    my $iError = Img0ch::Error->new( $iObject, $key, $iApp->{_ip_int} );
    my $error = $iApp->{__error} || 'UNKNOWN_ERROR';
    my $long = $iError->get($error);

    $iError->add();
    while ( my ( $subs, $value ) = each %{ $iApp->{__error_args} } ) {
        $long =~ s/{!$subs!}/$value/gxms;
    }

    my $charset = $iBBS ? $iBBS->get_encoding() : $iKernel->get_encoding(1);
    my $ip = $iApp->{_host} || $iApp->{_ip} || $iRequest->ip();
    my $message = $iApp->{__param_MESSAGE}
        || $iKernel->get_encoded_str( ( $iRequest->param('MESSAGE') || '' ),
        $charset );
    my $data = {
        ok     => 0,
        error  => $error,
        errstr => $iKernel->get_encoded_str( $long, 'utf8' ),
    };
    $callback and $callback->( $iApp, $long );

    if ( $iRequest->param('js') ) {
        $iRequest->send_http_header( 'text/javascript', 'UTF-8' );
        $iRequest->print( $iRequest->get_json($data) );
    }
    elsif ( $iRequest->param('xml') ) {
        $iRequest->send_http_header( 'application/xml', 'UTF-8' );
        $iRequest->print( $iRequest->get_xml( { response => $data } ) );
    }
    else {
        my $iSetting = $iApp->{__setting};
        my $name     = $iApp->{__param_FROM};
        if ( !$name ) {
            $name = $iRequest->param( 'FROM', 1 );
            $iApp->escape_chars( \$name, 1 );
            $iApp->trip(
                \$name,
                ( $iSetting ? $iSetting->get_int('BBS_TRIPCOLUMN') : 10 ),
                $iKernel->get_encoded_str(
                    $iKernel->translate_symbol('TrueTrip'), $charset,
                    'utf8'
                )
            );
            $iKernel->get_encoded_str( $name, $charset );
        }
        my $mail = $iApp->{__param_mail}
            || $iKernel->get_encoded_str( ( $iRequest->param('mail') || '' ),
            $charset );
        $mail =~ s/\#.*//xms;
        my $iTemplate = Img0ch::Template->new(
            $iObject,
            {   file => ( $template || 'error' ),
                request => $iRequest,
                setting => $iApp->{__setting},
            }
        );
        my $is_mobile = $iRequest->is_mobile_device();
        $is_mobile and $filter = sub { ${ $_[0] } =~ tr/\n//d; ${ $_[0] } };
        $iTemplate->param(
            {   ( map { %{$_} } @{ $iApp->{__template_tag_error} } ),
                'Flag'          => 1,
                'Host'          => $ip,
                'IsMobile'      => $is_mobile,
                'KEY'           => $iApp->{__key},
                'LongErrorStr'  => $long,
                'Name'          => $name,
                'Mail'          => $mail,
                'Message'       => $message,
                'ShortErrorStr' => $long,
            }
        );
        $cs = $iBBS ? $iBBS->get_encoding() : undef;
        $iRequest->send_http_header( 'text/html', $cs );
        $iTemplate->flush($filter);
    }

    return 0;
}

sub _update_index_thread {
    my ( $iConfig, $iSetting, $iThread, $reses, $iter, $key, $count, $cnum )
        = @_;
    my $start = ( $count - $cnum ) > 1 ? $count - $cnum + 1 : 2;

    {
        my $first = $iThread->get(1);
        my $text  = $first->[4];
        $iter->( $key, $count, 1, \$text, $first );
        my $id = $first->[3];
        my $date = $id ? ( join ' ', $first->[2], $id ) : $first->[2];
        push @{$reses},
            {
            'num'     => 1,
            'resno'   => 1,
            'name'    => $first->[0],
            'mail'    => $first->[1],
            'date'    => $date,
            'text'    => $text,
            'isFirst' => 1,
            };
    }

    my $error   = 0;
    my $iterate = $count;
    if ( !$iThread->can_write( \$error ) ) {
        if ( $error == 1 ) {
            $iterate++;
        }
    }

    for ( my $i = $start; $i <= $iterate; $i++ ) {
        my $res  = $iThread->get($i);
        my $text = $res->[4];
        $iter->( $key, $count, $i, \$text, $res );
        my $id = $res->[3];
        my $date = $id ? ( join ' ', $res->[2], $id ) : $res->[2];
        push @{$reses},
            {
            'num'     => $i,
            'resno'   => $i,
            'name'    => $res->[0],
            'mail'    => $res->[1],
            'date'    => $date,
            'text'    => $text,
            'isFirst' => 0,
            };
    }

    return 1;
}

sub _update_index_anchors {
    if ( $_[0] == 1 ) { ( $_[1], $_[2] ) }
    elsif ( $_[0] == $_[1] ) { ( $_[0] - 1, 1 ) }
    else                     { ( $_[0] - 1, $_[0] + 1 ) }
}

sub _imode_id_for_dns {
    my ( $iApp, $serial, $mode ) = @_;
    if ( $mode == 1 ) {
        my $i = 0;
        my @s = unpack( 'C*', $serial );
        my $j = scalar @s;
        $serial .= '-';
        while ( $i < $j ) {
            $serial .= ( ( $s[ $i++ ] & 96 ) == 96 ) ? 1 : 0;
        }
    }
    return $serial;
}

1;
__END__

=head1 NAME

Img0ch::App::BBS - img0chの書き込みを担当するエンジン部のモジュール

=head1 SYNOPSYS

  use Img0ch::App::BBS

  my $iApp = Img0ch::App::BBS->new($iKernel);
  $iApp->run();

=head1 DESCRIPTION

1回の書き込み処理を1つのオブジェクトとするクラスです。

=head2 new

=over 4

=item Arguments

$iKernel (Img0ch::Kernel), @args?

=item Return Value

$iApp (Img0ch::App::BBS itself)

=back

I<Img0ch::App::BBS>のオブジェクトを作成します。

=head2 run

=over 4

=item Arguments

none

=item Return Value

1(success) or 0(failed)

=back

I<Img0ch::App::BBS>を実行します。
通常Img0ch::*::BootStrapから呼び出します。

=head2 init

=over 4

=item Arguments

none

=item Return Value

1(success) or 0(failed)

=back

I<Img0ch::App::BBS>のオブジェクトを初期化します。
この関数はオブジェクト作成後必ず使用する必要があります。
失敗した場合エラー内容を設定し、0を返します。

=head2 get_host

=over 4

=item Arguments

none

=item Return Value

1(success) or 0(failed)

=back

書き込みする人のIPやホストを正規化し、設定します。
通常、I<Img0ch::App::BBS->run()>から呼び出されます。

失敗した場合エラー内容を設定し、0を返します。

=head2 validate

=over 4

=item Arguments

none

=item Return Value

1(success) or 0(failed)

=back

書き込み内容が正当であるかをチェックします。
通常、I<Img0ch::App::BBS->run()>から呼び出されます。

失敗した場合エラー内容を設定し、0を返します。

=head2 is_writeable

=over 4

=item Arguments

none

=item Return Value

1(success) or 0(failed)

=back

過去の書き込み記録から書き込み出来るかを検査します。
通常、I<Img0ch::App::BBS->run()>から呼び出されます。

失敗した場合エラー内容を設定し、0を返します。

=head2 get_date

=over 4

=item Arguments

none

=item Return Value

1

=back

現在時刻から書き込み時刻を正規化します。
通常、I<Img0ch::App::BBS->run()>から呼び出されます。

=head2 post

=over 4

=item Arguments

none

=item Return Value

1(success) or 0(failed)

=back

datへの追記、subjectの更新など書き込みを実行します。
通常、I<Img0ch::App::BBS->run()>から呼び出されます。

失敗した場合エラー内容を設定し、0を返します。

=head2 update_subback

=over 4

=item Arguments

$iBBS?, $execute_plugins?, $nodisk?

=item Return Value

1 or $parameter_for_template($nodisk = true)

=back

subback.htmlを更新します。

I<$execute_plugins>があればプラグインを実行します。

I<$nodisk>があればsubback.htmlを作成せず、戻り値が1の代わりに
Img0ch::Template::param()に渡すためのパラメータを返します。

=head2 update_index

=over 4

=item Arguments

$iBBS?, $execute_plugins?, $nodisk?

=item Return Value

1 or @parameter_for_template($nodisk = true)

=back

index.html及び/i/index.htmlを更新します。

I<$execute_plugins>があればプラグインを実行します。

I<$nodisk>があればindex.html及び/i/index.htmlを作成せず、
戻り値が1の代わりにImg0ch::Template::param()に渡すための
パラメータを配列(0番目にindex.htmlの、1番目に/i/index.htmlの
パラメータが入る)を返します。

=head2 param

=over 4

=item Arguments

$key?

=item Return Value

$value

=back

未使用、廃止予定のI<Img0ch::Request::param()>のラッパー関数。

=head2 get_poster_id

=over 4

=item Arguments

$now, @argument

=item Return Value

$id

=back

引数から8桁の投稿者のID(有効期限は一日限り)を生成します。

=head2 get_date_string

=over 4

=item Arguments

$now, $msec, $format, $week

=item Return Value

$formated_time

=back

現在時刻からフォーマットに従った時刻を生成します。
I<$week>は必ず6つのスラッシュでくぎった文字列である必要があります。

I<$format>で使用できるパラメータは以下のとおりです。

=over 4

=item %[Ss]

現在時刻の秒数。%Sまたは%sが利用可能です。

=item %[Mi]

現在時刻の分数。%Mまたは%iが利用可能です。

=item %H

現在時刻の時数。

=item %d

現在時刻の日数。

=item %m

現在時刻の月。

=item %Y

現在時刻の四桁の年数。

=item %y

現在時刻の下二桁の年数。

=item %w

現在時刻の週。

=item %u

現在時刻の疑似ミリ秒(正確ではない)

=back

=head2 trip

=over 4

=item Arguments

\$name, $column, $trip

=item Return Value

1(converted), 0(not converted)

=back

名前欄にある#以下の文字列からトリップを生成します。
また、I<crypt()>を使用するため、I<$column>は必ず11以下にする必要があります。
I<$trip>にはデフォルトの「◆」の代わりを指定します。

=head2 escape_chars

=over 4

=item Arguments

\$data, $f, $iConfig?

=item Return Value

1

=back

I<$data>から指定の文字列を置換します。I<$f>を1にすると追加で置換が行われます。
置換される文字列は以下の通りです。

=over 4

=item ◆

-> ◇

=item ★

-> ☆

=item 削除

-> ”削除”

=item 復帰

-> ”復帰”

=item 案内

-> ”案内”

=item 管理

-> ”管理” ($fが1のとき)

=item 菅直

-> ”菅直” ($fが1のとき)

=back

=head2 is_referer

=over 4

=item Arguments

none

=item Return Value

1(valid) or 0(invalid)

=back

書き込み元のリファラーが書き込みした同一ドメイン内にあるかどうかを調べます。
書き込み元が同一ドメイン内にあるなら1を返し、そうでない場合は0を返します。
ユーザーエージェントにMonazillaが含まれていた場合は例外として1を返します。

=head2 get_text_info

=over 4

=item Arguments

\$ptext

=item Return Value

($num_of_breaks, $max_length_of_line)

=back

書き込みした本文の行数と最も長い一行の長さの配列を返します。

=head2 count_anchors

=over 4

=item Arguments

$text

=item Return Value

$num_of_anchors

=back

アンカー(&gt;&gt;)の数を返します。

=head2 is_bbm

=over 4

=item Arguments

$serial, $now?

=item Return Value

1(burned) or 0(not burned)

=back

指定された携帯端末番号がBBM(2chで使用されている携帯によるあらし
または広告をしたブラックリストを格納するDNSBL)に載っているかを調べます。

=head2 is_make_new_thread

=over 4

=item Arguments

none

=item Return Value

1(is new thread) or 0

=back

書き込みがスレッドの新規作成かのフラグを返します。

=head2 get_name

=over 4

=item Arguments

none

=item Return Value

$name

=back

現在の名前欄を返します。

=head2 set_name

=over 4

=item Arguments

$name

=item Return Value

none

=back

現在の名前欄を設定します。

=head2 get_mail

=over 4

=item Arguments

none

=item Return Value

$mail

=back

現在のメール欄を返します。

=head2 set_mail

=over 4

=item Arguments

$mail

=item Return Value

none

=back

現在のメール欄を設定します。

=head2 get_comment

=over 4

=item Arguments

none

=item Return Value

$comment

=back

現在の本文を返します。

=head2 set_comment

=over 4

=item Arguments

$comment

=item Return Value

none

=back

現在の本文欄を設定します。

=head2 get_subject

=over 4

=item Arguments

none

=item Return Value

$subject

=back

現在のサブジェクトを返します。

=head2 set_subject

=over 4

=item Arguments

$subject

=item Return Value

none

=back

現在のサブジェクトを設定します。

=head2 get_ip

=over 4

=item Arguments

none

=item Return Value

$ip

=back

現在のIPアドレス(*.*.*.*)の文字列を返します。

=head2 get_ip_int

=over 4

=item Arguments

none

=item Return Value

$ip_int

=back

現在のIPアドレス(*.*.*.*)の16進数のバイナリ文字列を返します。

=head2 get_remote_host

=over 4

=item Arguments

none

=item Return Value

$host

=back

現在の投稿元(リモートホスト)の文字列を返します。

=head2 get_device_id

=over 4

=item Arguments

none

=item Return Value

$device_id

=back

現在の投稿元が保有する端末固有の識別IDを返します。

=head2 get_date_and_id

=over 4

=item Arguments

none

=item Return Value

[ $date, id ]

=back

現在の時刻とID(掲示板設定に依存する)が入った配列のリファレンスを返します。

=head2 get_annotation

=over 4

=item Arguments

$annotation_key

=item Return Value

$annotation_value

=back

本文に付けられたアノテーションに対応する値を取得します。
対応する値が存在しない場合はナルストリングが返されます。

  # 本文中
  @ANNOTATION foobar
  # コード上
  $iApp->get_annotation('ANNOTATION'); # foobar

掲示板設定のI<BBS_ENABLE_ANNOTATION>がchecked(有効)でない場合
常にこの関数はナルストリングが返されます。

=head2 get_error

=over 4

=item Arguments

none

=item Return Value

$error

=back

現在のエラー内容を返します。

=head2 set_error

=over 4

=item Arguments

$error

=item Return Value

none

=back

現在のエラー内容を設定します。

=head2 bbs

=over 4

=item Arguments

none

=item Return Value

$iBBS (Img0ch::BBS)

=back

I<Img0ch::BBS>オブジェクトを返します。
I<Img0ch::App::BBS::init()>呼出し後利用可能です。

=head2 cap

=over 4

=item Arguments

none

=item Return Value

$iCap (Img0ch::Cap)

=back

I<Img0ch::Cap>オブジェクトを返します。
I<Img0ch::App::BBS::validate()>の途中から利用可能です。

=head2 config

=over 4

=item Arguments

none

=item Return Value

$iConfig (Img0ch::Config)

=back

I<Img0ch::Config>オブジェクトを返します。
I<Img0ch::App::BBS>オブジェクト生成後利用可能です。

=head2 kernel

=over 4

=item Arguments

none

=item Return Value

$iKernel (Img0ch::Kernel)

=back

I<Img0ch::Kernel>オブジェクトを返します。
I<Img0ch::App::BBS>オブジェクト生成後利用可能です。


=head2 request

=over 4

=item Arguments

none

=item Return Value

$iRequest (Img0ch::Request)

=back

I<Img0ch::Request>を返します。
I<Img0ch::App::BBS>オブジェクト生成後利用可能です。

=head2 setting

=over 4

=item Arguments

none

=item Return Value

$iSetting (Img0ch::Setting)

=back

I<Img0ch::Setting>オブジェクトを返します。
I<Img0ch::App::BBS::init()>呼出し後利用可能です。

=head2 subject

=over 4

=item Arguments

none

=item Return Value

$iSubject (Img0ch::Subject)

=back

I<Img0ch::Subject>オブジェクトを返します。
I<Img0ch::App::BBS::post()>呼出し後利用可能です。

=head2 thread

=over 4

=item Arguments

none

=item Return Value

$iThread (Img0ch::Thread)

=back

I<Img0ch::Thread>オブジェクトを返します。
I<Img0ch::App::BBS::init()>呼出し後利用可能です。

=head2 upload

=over 4

=item Arguments

none

=item Return Value

$iUpload (Img0ch::Upload)

=back

I<Img0ch::Upload>オブジェクトを返します。
アップロードされることが分かっている場合に利用可能です。

=head2 trigger_plugin

=over 4

=item Arguments

$at, $disable, $iBBS?, $iConfig?

=item Return Value

1 or 0

=back

bbsに関連するプラグインを実行させます。

=head2 stash

=over 4

=item Arguments

$key, $value?

=item Return Value

none(setter) or $value(getter)

=back

Img0ch::App::BBSのオブジェクト内部に保管されている
仮想的なグローバル値を設定または取得します。

引数にI<$value>がある場合返り値はありません。
引数がI<$key>のみの場合はそれに対応する値を返します。

=head2 add_form_tag

=over 4

=item Arguments

$hash_reference_of_new_tag_set

=item Return Value

none

=back

スレッド作成フォーム用のユーザー定義タグを追加します。
値は必ずハッシュリファレンスを渡す必要があります。

=head2 add_confirm_tag

=over 4

=item Arguments

$hash_reference_of_new_tag_set

=item Return Value

none

=back

確認画面用のユーザー定義タグを追加します。
値は必ずハッシュリファレンスを渡す必要があります。

=head2 add_index_tag

=over 4

=item Arguments

$hash_reference_of_new_tag_set

=item Return Value

none

=back

インデックス(/index.html)用のユーザー定義タグを追加します。
値は必ずハッシュリファレンスを渡す必要があります。

=head2 add_mobile_index_tag

=over 4

=item Arguments

$hash_reference_of_new_tag_set

=item Return Value

none

=back

携帯用のインデックス(/i/index.html)用のユーザー定義タグを追加します。
値は必ずハッシュリファレンスを渡す必要があります。

=head2 add_subback_tag

=over 4

=item Arguments

$hash_reference_of_new_tag_set

=item Return Value

none

=back

スレッド一覧(/subback.html)用のユーザー定義タグを追加します。
値は必ずハッシュリファレンスを渡す必要があります。

=head2 add_error_tag

=over 4

=item Arguments

$hash_reference_of_new_tag_set

=item Return Value

none

=back

エラー表示画面用のユーザー定義タグを追加します。
値は必ずハッシュリファレンスを渡す必要があります。

=head2 add_redirect_tag

=over 4

=item Arguments

$hash_reference_of_new_tag_set

=item Return Value

none

=back

書き込み成功画面用のユーザー定義タグを追加します。
値は必ずハッシュリファレンスを渡す必要があります。

=head1 AUTHOR

hkrn E<lt>hikarin@users.sourceforge.jpE<gt>

=cut
