#/*
# *  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: Thread.pm 1065 2007-09-05 14:03:51Z hikarin $
#

package Img0ch::Thread;

use strict;

sub new {
    my ( $iClass, $iBBS, $key ) = @_;
    my $iKernel = $iBBS->get_kernel();

    bless {
        _bbs          => $iBBS->get_id(),
        _count        => 0,
        _kernel       => $iKernel,
        _key          => ( $key || 0 ),
        _line         => [],
        __path        => $iBBS->path('dat'),
        __xhtml_break => 0,
    }, $iClass;
}

sub load {
    my ( $iThread, $path ) = @_;
    my $iKernel = $iThread->{_kernel};
    my $buffer  = [];

    $path ||= $iThread->path();
    if ( !-r $path ) {
        @{ $iThread->{_line} } = ();
        $iThread->{_count} = 0;
        return 0;
    }

    local ( $!, *FH );
    open *FH, "<${path}" or $iKernel->throw_io_exception($path);  ## no critic
    while ( my $line = <FH> ) {
        push @{$buffer}, $line;
    }
    close *FH or $iKernel->throw_io_exception($path);

    my $count = @{ $iThread->{_line} } = @{$buffer};
    $iThread->{_count} = $count;
    return $count;
}

sub save {
    my ( $iThread, $path ) = @_;
    my $iKernel = $iThread->{_kernel};

    $path ||= $iThread->path();
    my $temp    = $path . '.tmp';
    my $LOCK_EX = 2;
    eval {
        require Fcntl;
        $LOCK_EX = Fcntl::LOCK_EX();
    };

    eval {
        local ( $!, *FH );
        open *FH, ">${temp}"    ## no critic
            or $iKernel->throw_io_exception($path);
        flock *FH, $LOCK_EX;
        my $count = 0;
        for my $line ( @{ $iThread->{_line} } ) {
            print {*FH} $line or $iKernel->throw_io_exception($path);
            $count++;
        }
        $iThread->{_count} = $count;
        close *FH or $iKernel->throw_io_exception($path);
        rename $temp, $path or $iKernel->throw_io_exception($path);
    };
    if ( my $exception = $@ ) {
        if ( -e $temp ) {
            unlink $temp or $iKernel->throw_io_exception($temp);
        }
        die $exception, "\n";
    }
    return 1;
}

sub get {
    my ( $iThread, $resno ) = @_;
    $resno = Img0ch::Kernel::intval($resno) - 1;
    my $line = $iThread->{_line}->[$resno];
    if ( $resno >= 0 and $line ) {
        chomp $line;
        my @element = split '<>', $line;
        my ( $date, $id )
            = ( $element[2] || '' ) =~ /\A(.+?)\s?((ID|HOST):.+)?\z/xms;
        my $text = $element[3];
        $iThread->{__xhtml_break} and $text =~ s{<br>}{<br />}gxms;
        [ $element[0], $element[1], $date, ( $id || '' ), $text ];
    }
    else {
        [ '', '', '', '', '' ];
    }
}

sub get_key { $_[0]->{_key} }

*get_subject = \&subject;

sub set {
    my ( $iThread, $element ) = @_;
    my $subject = $iThread->{_count} ? '' : ( $element->[5] || '' );
    my $id = $element->[3] ? " $element->[3]" : '';
    push @{ $iThread->{_line} }, "$element->[0]<>$element->[1]<>$element->[2]"
        . "$id<>$element->[4]<>${subject}\n";
    return;
}

sub enable_xhtml_break { $_[0]->{__xhtml_break} = 1; return; }

sub disable_xhtml_break { $_[0]->{__xhtml_break} = 0; return; }

sub set_key {
    my ( $iThread, $key ) = @_;
    $iThread->{_key} = $key;
    $iThread->load();
    return;
}

sub count { $_[0]->{_count} }

sub subject {
    my ($iThread) = @_;
    $iThread->count() or return '';
    my $subject = [ split '<>', $iThread->{_line}->[0] ]->[4] || '';
    chomp $subject;
    return $subject;
}

sub size { -s $_[0]->path() || 0 }

sub can_write {
    my ( $iThread, $errno, $max_size, $max_line ) = @_;

    if ( $max_size and $iThread->size() > $max_size ) {
        $$errno = 4;
        return 0;
    }

    my $count = $iThread->count();
    if ( $max_line and $count > $max_line ) {
        $$errno = 3;
        return 0;
    }

    my $date = $iThread->get($count)->[2];
    if ($date) {
        my $iConfig = $iThread->{_kernel}->get_config();

        # STOP
        if ($date eq (
                $iConfig->get('multibyte.STOP')
                    || pack( 'C*', ( 0x92, 0xe2, 0x8e, 0x7e ) )
            )
            )
        {
            $$errno = 1;
            return 0;
        }

        # MOVE
        elsif (
            $date eq (
                $iConfig->get('multibyte.MOVE')
                    || pack( 'C*', ( 0x88, 0xda, 0x93, 0x5d ) )
            )
            )
        {
            $$errno = 2;
            return 0;
        }
        elsif ( $date =~ /\AOver\s+\d+\s+Thread\z/xms ) {
            $$errno = 3;
            return 0;
        }
    }
    return 1;
}

sub search {
    my ( $iThread, $regex, $pos ) = @_;
    require ShiftJIS::Regexp;
    my $re    = ShiftJIS::Regexp::re($regex);
    my $count = $iThread->count();
    my $ret   = {};

    $pos = Img0ch::Kernel::intval($pos) || 5;
    ( $pos < 1 or $pos > 5 ) and $pos = 5;
    $pos--;

    for ( my $i = 1; $i <= $count; $i++ ) {
        my $rs = $iThread->get($i);
        ( $rs->[$pos] || '' ) =~ /$re/xms and $ret->{$i} = $rs;
    }
    $ret;
}

sub exists { -r $_[0]->path() ? 1 : 0 }

sub path { $_[0]->{__path} . '/' . $_[0]->{_key} . '.dat' }

1;
__END__

=head1 NAME

Img0ch::Thread - スレッドを管理するクラス

=head1 SYNOPSYS

  use Img0ch::Thread

  my $iThread = Img0ch::Thread->new($iBBS, $key);
  $iThread->load();

  my ($name, $mail, $date, $id, $comment) = @{ $iThread->get(1) };
  my $subject = $iThread->subject();
  my $path = $iThread->path();
  my $size = $iThread->size();

  $iThread->set([$name, $mail, $date, $id, $comment]);
  $iThread->save();

=head1 DESCRIPTION

1つのスレッド(dat)を1つのオブジェクトとするクラスです。

=head2 new

=over 4

=item Arguments

$iBBS(Img0ch::BBS), $key

=item Return Value

$iThread (Img0ch::Thread itself)

=back

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

=head2 load

=over 4

=item Arguments

$path?

=item Return Value

$count

=back

スレッドを読み込みます。返り値はレス数を返します。

=head2 save

=over 4

=item Arguments

$path?

=item Return Value

1(saved) or 0

=back

I<set()>の内容をスレッドに追記し、保存します。
I<set()>が一度も呼び出されていなければ0を返します。

=head2 get

=over 4

=item Arguments

$resno

=item Return Value

$array_reference

=back

指定されたレスの内容を配列のリファレンスとして取り出します。
名前、メール欄、時刻、ID、本文の順番に値が返されます。

enable_xhtml_break()が呼び出されている場合、E<lt>brE<gt>を
E<lt>br /E<gt>に変換します。

=head2 get_key

=over 4

=item Arguments

none

=item Return Value

$key

=back

現在のスレッドキーを返します。

=head2 get_subject

=over 4

=item Arguments

none

=item Return Value

$subject

=back

I<subject()>のエイリアスです。

=head2 set

=over 4

=item Arguments

$arrray_reference

=item Return Value

none

=back

追記する内容をオブジェクト内部に一時的に保存します。
二回目に呼び出すと前の内容が消去されます。

=head2 set_key

=over 4

=item Arguments

$key

=item Return Value

none

=back

オブジェクト内部に保存されているスレッドキーを変更します。
別のスレッドの内容を読み込む場合に利用します。

=head2 enable_xhtml_break

=over 4

=item Arguments

none

=item Return Value

none

=back

E<lt>brE<gt>をE<lt>br /E<gt>に変換するように設定します。

=head2 count

=over 4

=item Arguments

none

=item Return Value

$count

=back

現在のスレッドのレス数を返します。

=head2 subject

=over 4

=item Arguments

none

=item Return Value

$subject

=back

現在のスレッドの名前を返します。
I<get_subject()>も同様の効果を持ちます。

=head2 size

=over 4

=item Arguments

none

=item Return Value

$size

=back

現在のスレッドファイルの大きさをバイト単位で返します。

=head2 can_write

=over 4

=item Arguments

\$errno, $max_size_of_dat

=item Return Value

1(writeable) or 0

=back

現在のスレッドが書き込めるかどうかを調べます。
書き込めるなら1、書き込めなければ0を返し、I<$errno>に値を設定します。
設定される値とその意味は以下の通りです。

=over 4

=item ERROR(0)

I<$errno>が0の場合はデータが取得できなかったことを表します。

=item STOP(1)

I<$errno>が1の場合はそのスレッドが停止されていることを表します。

=item MOVE(2)

I<$errno>が2の場合はそのスレッドが移転されていることを表します。

=item OVER(3)

I<$errno>が3の場合はそのスレッドが指定されたレス数を超えていることを表します。

=item LIMIT(4)

I<$errno>が4の場合はそのスレッドの大きさがI<$max_size_of_dat>バイトを超えていることを表します。

=back

=head2 search

=over 4

=item Arguments

$regex, $pos

=item Return Value

$hash_reference_of_result

=back

現在のスレッドから$regexの正規表現で検索します。
$posを指定することで検索単位を変更することが出来ます。
デフォルトで5が指定されます。

$posで指定できる値と検索単位は以下の通りです。

=over 4

=item 1(FROM)

名前欄から検索します。

=item 2(mail)

メール欄から検索します。

=item 3(date)

時刻から検索します。

=item 4(id)

IDから検索します。

=item 5(message)

本文から検索します。

=back

=head2 path

=over 4

=item Arguments

none

=item Return Value

$path_to_dat

=back

現在のスレッドのパスを返します。

=head1 AUTHOR

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

=cut
