#/*
# *  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: Subject.pm 970 2007-08-21 14:52:15Z hikarin $
#

package Img0ch::Pool::Subject;

use strict;

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

    bless {
        _bbs      => $iBBS->get_name(),
        _count    => 0,
        _encoding => $iKernel->get_encoding(1),
        _kernel   => $iKernel,
        __path    => $repos,
        _repos    => $iKernel->get_repos($repos),
    }, $iClass;
}

sub load { $_[0]->{_repos}->load(); return 1 }

sub save { $_[0]->{_repos}->save(); return 1 }

sub get {
    my ( $iSubject, $key ) = @_;
    my $iRepos = $iSubject->{_repos};
    my $bbs    = $iSubject->{_bbs};
    my $prefix = "I:P:T.${bbs}.${key}";

    if ( my $res = $iRepos->get_int("${prefix}.res") ) {
        my $subject = $iRepos->get("${prefix}.subject");
        return [ $subject, $res ];
    }
    else {
        return [ '', 0 ];
    }
}

sub get_utf8 {
    my ( $iPool,   $key ) = @_;
    my ( $subject, $res ) = @{ $iPool->get($key) };

    $subject = $iPool->{_kernel}
        ->get_encoded_str( $subject, 'utf8', $iPool->{_encoding} );

    return [ $subject, $res ];
}

*get_subject = \&get;

sub flush {0}

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

#*stay = \&set;

#*sage = \&set;

#*raise = \&set;

#*age = \&set;

sub set {
    my ( $iSubject, $key, $res, $subject ) = @_;
    my $iRepos = $iSubject->{_repos};
    my $bbs    = $iSubject->{_bbs};
    my $prefix = "I:P:T.${bbs}.${key}";

    if ( !$iRepos->get("${prefix}.res") ) {
        $iSubject->{_count}++;
    }
    $iRepos->set( "${prefix}.res",     $res );
    $iRepos->set( "${prefix}.subject", $subject );
    1;
}

sub remove {
    my ( $iSubject, $key ) = @_;
    my $iRepos = $iSubject->{_repos};
    my $bbs    = $iSubject->{_bbs};
    my $prefix = "I:P:T.${bbs}.${key}";

    if ( $iRepos->remove("${prefix}.res") ) {
        $iRepos->remove("${prefix}.subject");
        $iSubject->{_count}--;
        return 1;
    }
    else {
        return 0;
    }
}

sub search {
    my ( $iSubject, $regex ) = @_;
    require ShiftJIS::Regexp;
    my $re  = ShiftJIS::Regexp::re($regex);
    my $ret = {};

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

sub to_array {
    my ($iSubject) = @_;
    my $bbs        = $iSubject->{_bbs};
    my $key_table  = {};
    my $regex      = qr/\AI:P:T.$bbs.(.+?)\.\w+\z/xms;

    $iSubject->{_repos}->iterate(
        sub {
            my ( $key, $value, $key_table, $regex ) = @_;
            if ( $key =~ /$regex/xms ) {
                my $thread = $1;
                $key_table->{$thread} = 1;
            }
            return 0;
        },
        $key_table,
        $regex
    );
    my $ret = [ keys %{$key_table} ];
    $iSubject->{_count} = scalar @$ret;

    return $ret;
}

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

1;
__END__

=head1 NAME

Img0ch::Pool::Subject - プールされたスレッドのサブジェクトを管理するクラス

=head1 SYNOPSYS

  use Img0ch::Pool::Subject

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

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

=head2 new

=over 4

=item Arguments

$iBBS (Img0ch::BBS)

=item Return Value

$iSubject (Img0ch::Pool::Subject itself)

=back

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

=head2 load

=over 4

=item Arguments

none

=item Return Value

1

=back

レポジトリを読み込みます。

=head2 save

=over 4

=item Arguments

none

=item Return Value

1

=back

設定された内容をレポジトリに保存します。

=head2 get

=over 4

=item Arguments

$key

=item Return Value

[ $subject, $res ]

=back

スレッドキーからサブジェクト及びレス数の配列を返します。
get_subject()はget()のエイリアスです。

=head2 flush

=over 4

=item Arguments

$key?

=item Return Value

none

=back

オブジェクトに保存されているキャッシュを削除します。スレッドキーが指定されている場合はそのスレッドキーのキャッシュを、
指定されていない場合は全てのキャッシュを削除します。
(2.1.x-3.xではスタブ関数として実装しています。すなわち、何も実行しません)

=head2 count

=over 4

=item Arguments

none

=item Return Value

$count_of_subjects

=back

レポジトリに保存されているスレッド数を返します。

=head2 set

=over 4

=item Arguments

$key, $resno, $subject

=item Return Value

1

=back

指定されたプールスレッドのレス数とサブジェクトを更新します。
存在しないプールスレッドの場合はその過去ログを新たに追加して更新します。

=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_pool_repository

=back

プールスレッドの一覧を格納するレポジトリのパスを返します。
この関数はバージョンが2.1.x-3.xでのみ使用可能です。

=head1 AUTHOR

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

=cut
