#/*
# *  Copyright 2007-2008 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: Subject.pm 1645 2008-02-06 15:40:18Z hikarin $
#

package Img0ch::Subject;

use strict;

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

    bless {
        _bbs    => $iBBS->get_id(),
        _cache  => {},
        _count  => 0,
        _kernel => $iKernel,
        _order  => [],
        __path  => $iBBS->path('subject.txt'),
    }, $iClass;
}

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

    $path ||= $iSubject->path();
    my $fh = $iKernel->get_read_file_handle($path) || return 0;

    while ( my $line = <$fh> ) {
        $line =~ /\A(\d+)\.dat<>(.+?)\s?\((\d+)\)\n\z/xms or next;
        my ( $key, $subject, $res ) = ( $1, $2, $3 );
        $buffer->{$key} = [ $subject, $res ];
        push @{$order}, $key;
    }
    close $fh or $iKernel->throw_io_exception($path);

    %{ $iSubject->{_cache} } = %{$buffer};
    my $count = @{ $iSubject->{_order} } = @{$order};
    $iSubject->{_count} = $count;
    return $count;
}

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

    $path ||= $iSubject->{__path};
    my $temp = $path . '.tmp';

    eval {
        my $fh   = $iKernel->get_write_file_handle($temp);
        my $keys = $iSubject->to_array();
        for my $key (@$keys) {
            my $rs = $iSubject->get($key);
            print ${fh} $key, '.dat<>', $rs->[0], ' (', $rs->[1], ')', "\n"
                or $iKernel->throw_io_exception($path);
        }
        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";
    }
    1;
}

sub get {
    my ( $iSubject, $key ) = @_;
    my $cache = $iSubject->{_cache}->{$key};
    return $cache ? $cache : [ '', 0 ];
}

*get_subject = \&get;

sub flush {0}

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

*stay = \&sage;

sub sage {
    my ( $iSubject, $key, $res, $subject ) = @_;
    if ( !$subject ) {
        my $old = $iSubject->get($key);
        $old->[1] or return 0;
        $subject = $old->[0];
    }
    $iSubject->{_cache}->{$key} = [ $subject, $res ];
    1;
}

*raise = \&age;

sub age {
    _shift( sub { unshift @{ $_[0] }, $_[1] }, @_ );
}

*drop = \&dame;

sub dame {
    _shift( sub { push @{ $_[0] }, $_[1] }, @_ );
}

sub _shift {
    my ( $subref, $iSubject, $key, $res, $subject ) = @_;
    my $order = $iSubject->{_order};

    for ( my $i = 0; $i < @{$order}; $i++ ) {
        if ( $order->[$i] == $key ) {
            splice @$order, $i, 1;
            last;
        }
    }

    $subref->( $order, $key );
    my $old = $iSubject->get($key);
    $iSubject->{_cache}->{$key} = [ ( $old->[0] || $subject ), $res ];
    1;
}

sub search {
    my ( $iThread, $word ) = @_;
    defined $ShiftJIS::Regexp::VERSION or require ShiftJIS::Regexp;
    return $iThread->_search( ShiftJIS::Regexp::re($word) );
}

sub grep {
    my ( $iThread, $word ) = @_;
    return $iThread->_search(qr/\Q$word\E/xms);
}

sub _search {
    my ( $iSubject, $re ) = @_;
    my $ret = {};

    for my $key ( @{ $iSubject->to_array() } ) {
        my $rs = $iSubject->get($key);
        $rs->[0] =~ $re and $ret->{$key} = $rs;
    }

    return $ret;
}

sub to_array { $_[0]->{_order} }

sub path { $_[0]->{__path} }

1;
__END__

=head1 NAME

Img0ch::Subject - サブジェクト(subject.txt)を管理するクラス

=head1 SYNOPSYS

  use Img0ch::Subject

  my $iSubject = Img0ch::Subject->new($iBBS);
  $iSubject->load();
  for my $key ( @{ $iSubject->to_array() } ) {
      my $one = $iSubject->get($key);
      printf 'key: %s, subject: %s, res: %s'
          $key, $one->[0], $one->[1];
  }

  $iSubject->sage($key, $res);
  $iSubject->age($key, $res, $subject);
  $iSubject->save();

=head1 DESCRIPTION

1つのsubject.txtを1つのオブジェクトとするクラスです。

=head2 new

=over 4

=item Arguments

$iBBS (Img0ch::BBS)

=item Return Value

$iSubject (Img0ch::Subject itself)

=back

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

=head2 load

=over 4

=item Arguments

$path?

=item Return Value

1

=back

subject.txtを読み込みます。

=head2 save

=over 4

=item Arguments

$path?

=item Return Value

1

=back

指定されたI<$path>またはpath()からsubject.txtを保存します。

=head2 get

=over 4

=item Arguments

$key

=item Return Value

[ $subject, $res ]

=back

スレッドキーからサブジェクト及びレス数の配列を返します。
同じスレッドキーを二回目以降に呼び出されたときはそのキャッシュを返します。

=head2 flush

=over 4

=item Arguments

$key?

=item Return Value

none

=back

オブジェクトに保存されているキャッシュを削除します。スレッドキーが指定されている場合はそのスレッドキーのキャッシュを、
指定されていない場合は全てのキャッシュを削除します。

=head2 count

=over 4

=item Arguments

none

=item Return Value

$count_of_subjects

=back

subject.txtに保存されているスレッド数を返します。

=head2 sage

=over 4

=item Arguments

$key, $resno, $subject

=item Return Value

1 or 0(not-exist)

=back

指定されたスレッドのsubject.txtにおける位置を固定させたままレス数を更新します。
存在しないスレッドにこのメソッドが呼ばれると0を返します。

=head2 age

=over 4

=item Arguments

$key, $resno, $subject

=item Return Value

1

=back

指定されたスレッドのsubject.txtにおける位置を上げてレス数を更新します。
存在しないスレッドの場合はそのスレッドを新たに追加して更新します。

=head2 search

=over 4

=item Arguments

$word

=item Return Value

$hash_reference_of_found_threads

=back

I<$word>からサブジェクト情報に基づいて検索します。
返す値はハッシュキーにスレッドキー、中身にget()で取得した値で返します。

=head2 to_array

=over 4

=item Arguments

none

=item Return Value

$reference_to_all_thread_keys

=back

subject.txtに存在する全てのスレッドキーを配列のリファレンスとして返します。

=head2 path

=over 4

=item Arguments

none

=item Return Value

$path_to_subject_txt

=back

subject.txtの物理的なファイルパスを返します。

=head1 AUTHOR

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

=cut
