# word-index プラグイン ver.1.0 (c) 蒼井拓.
# 一応安定動作してるみたいなのでv1とします.
# ページ出力をUTF-8に設定している場合は,
# ファイルのエンコードを'UTF-8'に変更してください.
# (でないと検索が上手くできません).
# ちなみにコメントの末尾に.とか,を打ってあるのは,
# 'くせ'です(sjisだと2byte文字が改行文字を食っちゃうことがあるので).
# @history:
# 2008.05.04 : Created.
package word_index;

$main::inline_plugin{'windex'} = (\&word_index::plugin_index);

$main::action_plugin{'wordindex'} = (\&word_index::action_index);

### &word_index::plugin_index();
### @call  : inline - '((windex))'.
### @in    : nothing.
### @out   : nothing.
### @return: $buf / HTML文字列, 索引のHTMLを返します.
# 索引出力用インラインプラグイン.
# ((windex))で索引を出力します.
sub plugin_index{
    my @chars = (
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(あ い う え お)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(か き く け こ)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(さ し す せ そ)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(た ち つ て と)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(な に ぬ ね の)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(は ひ ふ へ ほ)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(ま み む め も)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(や ゆ よ)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(ら り る れ ろ)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(わ ゐ ゑ を ん)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(A B C D E F G)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(H I J K L M N)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(O P Q R S T U)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(V W X Y Z)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(0 1 2 3 4)],
        [map{&main::anchor($_,{p=>$_,a=>wordindex})}qw(5 6 7 8 9)],
    );
    my $buf = '<ul class="wordindex">' .
    join("\r\n",
        map{'<li>'."@{$_}".'</li>'} @chars
    ). '</ul>';
}

### &word_index::action_index();
### @call  : query - '?p=$from;a=wordindex'.
### @in    : nothing.
### @out   : nothing.
### @return: nothing.
# 索引処理を実行します.
# クエリに指定できるパラメータは下記の通り.
# ・1文字であること(2文字以上は想定の判外ですヨ).
# ・ひらがな(清音), 半角の大文字アルファベット, 半角数字.
# # カタカナや濁音, 促音, 全角英数、小文字アルファベットは,
# # 一応動くと思いますが, 期待したとおりの動作になりません.
# つまりタイトルが漢字や記号類で始まる場合はスルーします.
# ヒットさせるためには, 記事の頭で,
#
# '''記事名'''（きじめい）は、記事の名前のことである.
#
# のように, 読み仮名を指定してください(wikipedia風).
# タイトルはいまのところ強調しか対応してません.
# そのうち見出しとかにも対応したい. カッコは全角です.
# 基本的に((windex))で出力した索引テーブルからクエリを投げ,
# 検索結果を出力する,という流れで使うことを想定しているので,
# アドレスバー直打ちとかaタグのhrefにクエリ埋め込んだりとか,
# そういうのは出力された索引テーブルのhrefを使ってください.
# まだソートは実装できていません.
# なので, 出力結果は順不同です. そのうち対応する予定です.
sub action_index{
    my $from  = $main::form{p};
    my $efrom = &main::enc($from);
    # Configで設定したCSSページ, FrontPage,
    # および, Header, Footer, Sidebarは,
    # 索引の検索対象外にする.
    my @ignorepages = (
        $main::config{CSS},
        $main::config{FrontPage},
        'Header',
        'Footer',
        'Sidebar'
    );
    # 検索テーブルを生成.
    my @froms = @{&transletter($from)};

    &main::print_template(
        # そのうち索引ページのタイトルをConfigから読み出せるようにしたいところ.
        Title => qq(索引: "$efrom") ,
        main => sub {
            &main::begin_day( qq(索引: "$efrom") );
            &main::puts('<ul>');
            foreach my $fn ( &main::list_page() ){
                my $originaltitle = &main::fname2title( $fn );
                my $title = $originaltitle;
                $title =~ s/^([^(]+)[ ](\([^)]+\))+$/\1/;
                next if (grep(/^$title$/, @ignorepages));
                # タイトル先頭が指定された文字と一致(indexの戻り値が0).
                if( grep {index($title, $_) == 0} @froms ){
                    &main::puts('<li>' . &main::anchor($title,{ p=>$originaltitle }) . '</li>');
                }elsif( open(FP,$fn) ){
                    while( my $_title = <FP> ){
                        # 行頭字下げは無視.
                        $_title =~ s/^　//g;
                        # 強調は無視.
                        $_title =~ s/'''//g;
                        # タイトルが漢字の場合は読み仮名から.
                        # 記事の先頭に'タイトル（よみがな）'形式で読み仮名が書いてあれば,
                        # 検索結果に含める.
                        if( grep {index($_title,"$title（$_") == 0} @froms ){
                            my $offset = index($_title, '（');
                            my $length = index($_title, '）') - $offset + 3;
                            my $yomigana = substr($_title, $offset, $length);
                            &main::puts('<li>' . &main::anchor($title,{ p=>$originaltitle } ) . $yomigana .'</li>' );
                        }
                        # 最初の一行しか見ません.
                        last;
                    }
                    close(FP);
                }
            }
            &main::puts('</ul>');
            &main::end_day();
        },
    );
}

### &word_index::transletter($from);
### (internal use).
### @call  : query - '?p=$from;a=wordindex'.
### @in    : $from / 検索対象文字, 検索対象テーブルを生成するための元になる文字.
### @out   : nothing.
### @return: \@froms / 検索対象テーブルのリファレンス.
# 索引処理用のサブルーチン.
# ひらがな清音から濁音, 促音, カタカナを,
# 半角大文字アルファベットから半角小文字アルファベットを,
# それぞれ検索対象として含められるよう,　テーブルを生成します.
# なお、ヴはハ行として扱います.
# # バとヴァ, ブとヴは等価となります.
# # ただし, ハで検索するとヴから始まるものは全てヒットします.
# # 修正予定はありますが, 一応現状は仕様とします.
# # ちなみにウはヴにヒットしません. これは仕様です.
sub transletter{
    my $from = shift;
    my @froms;
    # 半角アルファベット大文字を小文字に変換してテーブルに追加．
    if ($from =~ /[A-Z]/) {
        $froms[0] = $from;
        $froms[1] = lc($from);
    # こういう一文字のマッチングは正規表現よりindexの方が速かったりする.
    # (下の場合だと3倍程度差が出る).
    } elsif (index('あいうえおかきくけこさしすせそたちてとやゆよ', $from) >= 0) {
        # テーブルの初期化.
        @froms = ($from) x 4;
        # Unicodeでは「あ-お」までの間に「ぁ」が、「か-こ」までの間に「が」が含まれるので,
        # 1文字ずつtrの対象にする. これはしょうがない...
        $froms[1] =~ tr/あいうえおかきくけこさしすせそたちてとやゆよ/ぁぃぅぇぉがぎぐげござじずぜぞだぢでどゃゅょ/;
        $froms[2] =~ tr/あいうえおかきくけこさしすせそたちてとやゆよ/アイウエオカキクケコサシスセソタチテトヤユヨ/;
        $froms[3] =~ tr/あいうえおかきくけこさしすせそたちてとやゆよ/ァィゥェォガギグゲゴザジズゼゾダヂデドャュョ/;
    } elsif ($from eq 'つ') {
        @froms = qw(つ づ っ ツ ヅ ッ);
    } elsif (index('はひふへほ', $from) >= 0) {
        # テーブルの初期化.
        @froms = ($from) x 7;
        $froms[6] = 'ヴ' . $from;
        # 「ふ」は特殊な扱いになるので、一番最後.
        $froms[1] =~ tr/はひへほふ/ばびべぼぶ/;
        $froms[2] =~ tr/はひへほふ/ぱぴぺぽぷ/;
        $froms[3] =~ tr/はひへほふ/ハヒヘホフ/;
        $froms[4] =~ tr/はひへほふ/バビベボブ/;
        $froms[5] =~ tr/はひへほふ/パピペポプ/;
        $froms[6] =~ tr/はひへほふ/ァィェォ/d;
    } elsif (index('なにぬねのまみむめもらりるれろわゐゑをん', $from) >= 0) {
        # テーブルの初期化.
        @froms = ($from) x 2;
        $froms[1] =~ tr/なにぬねのまみむめもらりるれろわゐゑをん/ナニヌネノマミムメモラリルレロワヰヱヲン/;
    }
    return \@froms;
}