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

package Img0ch::Archive;
use strict;

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

    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 ( $iArchive, $key ) = @_;
    my $iRepos = $iArchive->{_repos};
    my $bbs    = $iArchive->{_bbs};
    my $prefix = "I:A.${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 ( $iArchive, $key ) = @_;
    my ( $subject,  $res ) = @{ $iArchive->get($key) };

    $subject = $iArchive->{_kernel}
        ->get_encoded_str( $subject, 'utf8', $iArchive->{_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 ( $iArchive, $key, $res, $subject ) = @_;
    my $iRepos = $iArchive->{_repos};
    my $bbs    = $iArchive->{_bbs};
    my $prefix = "I:A.${bbs}.${key}";

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

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

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

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

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

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

    $iArchive->{_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} ];
    $iArchive->{_count} = scalar @$ret;

    return $ret;
}

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

1;
__END__

=head1 NAME

Img0ch::Archive - 過去ログのサブジェクトを管理するクラス

=head1 SYNOPSYS

  use Img0ch::Archive

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

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

=head1 DESCRIPTION

掲示板単体の過去ログのインデックスを1つのオブジェクトとするクラスです。

=head2 new

=over 4

=item Arguments

$iBBS (Img0ch::BBS)

=item Return Value

$iArchive (Img0ch::Archive itself)

=back

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

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

=over 4

=item Arguments

$key

=item Return Value

[ $subject_utf8_encoded, $res ]

=back

サブジェクト部分がUTF8で返される点以外はI<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

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

=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
