#/*
# *  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: Host.pm 1317 2007-10-06 14:54:49Z hikarin $
#

package Zeromin2::Translate::Img0ch::v2::Log::Host;

use strict;
use Img0ch::Log qw();
use Img0ch::Thread qw();
use Time::Local qw();
use Zeromin::BBS qw();

sub work {
    my ( $zClass, $iKernel ) = @_;

    my $zBBS = Zeromin::BBS->new( $iKernel, { id => 0 } );
    my $bbs_all = $zBBS->all();

    foreach my $bbs (@$bbs_all) {
        my $iBBS = Img0ch::BBS->new( $iKernel, { id => $bbs->{id} } );
        _parse( $iBBS, $iKernel ) or return { code => 1 };
    }

    return { code => 0 };
}

sub _parse {
    my ( $iBBS, $iKernel ) = @_;

    my $iConfig = $iKernel->get_config();
    my ( $id, $dir ) = ( $iBBS->get_id(), $iBBS->get_name() );
    my $path = join '/', $iConfig->get('BBSPath'), $dir, 'log/HOSTs.cgi';
    -r $path or return { code => 0 };

    my $idx    = {};
    my $thread = {};
    my $log    = {};
    my $datdir = join '/', $iConfig->get('BBSPath'), $dir, 'dat';
    _index( $iKernel, $datdir, $idx );

    local $SIG{__WARN__} = sub { };
    my $fh = $iKernel->get_read_file_handle($path);
    while ( my $line = <$fh> ) {
        chomp $line;
        my ( $stamp, $key, undef, $host ) = split '<>', $line;
        my $resno = $idx->{ ( join '-', $key, $stamp ) } || next;

        my $iLog = $log->{$key};
        if ( !$iLog ) {
            $iLog = $iBBS->get_log_instance($key);
            $log->{$key} = $iLog;
        }
        my $iThread = $thread->{$key};
        if ( !$iThread ) {
            $iThread = $iBBS->get_thread_instance($key);
            $thread->{$key} = $iThread;
        }

        my $article = $iThread->get($resno);
        if ($article) {
            my $ip;
            if ( $host =~ /\A(\d+)\.(\d+)\.(\d+)\.(\d+)\z/xms ) {
                $ip = join '.', $1, $2, $3, $4;
            }
            else {
                $ip = join '.', unpack( 'C*', gethostbyname $host );
            }
            $host =~ /\s([\w\-]+)\z/xms;
            my $serial = $1 || '';
            $iLog->set( $resno, [ $stamp, $ip, $serial, '' ] );
        }
    }
    close $fh or $iKernel->throw_io_exception($path);
    map { $_->save() } values %$log;

    return 1;
}

sub _index {
    my ( $iKernel, $datdir, $index ) = @_;

    opendir my $fh, $datdir or $iKernel->throw_io_exception($datdir);
    my @datfiles = readdir $fh;
    closedir $fh or $iKernel->throw_io_exception($datdir);

DAT_SCAN:
    for my $datfile (@datfiles) {
        $datfile =~ /\A(\d{9,10})\.dat\z/xms or next DAT_SCAN;
        my $key     = $1;
        my $datpath = join '/', $datdir, $datfile;
        my $i       = 0;

        $fh = $iKernel->get_read_file_handle($datpath);
    DAT_READ:
        while ( my $line = <$fh> ) {
            $i++;
            $line =~ /\A.*?<>.*?<>(.*?)<>.*?<>.*\z/xms or next DAT_READ;
            my $date = $1;
            $date
                =~ /.*?(\d{4}).*?(\d{2}).*?(\d{2}).*?(\d{2}):(\d{2}):(\d{2})/xms
                or next DAT_READ;
            my ( $year, $month, $day, $hour, $minute, $second )
                = map { Img0ch::Kernel::intval($_) }
                ( $1, $2, $3, $4, $5, $6 );
            my $stamp = Time::Local::timelocal( $second, $minute, $hour, $day,
                $month - 1, $year - 1900 );
            $index->{ ( join '-', $key, $stamp ) } = $i;
        }
        close $fh or $iKernel->throw_io_exception($datpath);
    }
    return;
}

1;
__END__
