# -*- cperl -*-
package Celaenito::HyperEstraier;
use strict;
use warnings;
use Celaenito::FileStorage;
use Celaenito::DB;
use HTML::Parser;
use Date::Format;
use Encode::Guess;
use Encode;
use SQLTime;
use Smart::Comments;
use Hash::Util qw(lock_keys);
use Carp;
use constant CASKET => './casket';
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(&EST);
our $EST; # __PACKAGE__
our $EDB; # HyperEstraier::Database
our $EDB_WRITE_MODE; # 1 or undef
our $EDB_IN_USE; # 1 or undef

our $EST_AVAIL;
BEGIN {
    eval {
        require Estraier;
    };
    if ($@) {
        print "[Recommendation]\n";
        print "    You can search the Celaenito DB by content if you install HyperEstraier.\n";
    }
    else {
        $EST_AVAIL = 1;
    }
}

sub EST () {
    unless ($EST_AVAIL) {
        undef;
    }

    unless ($EST) {
        $EST = bless {} => __PACKAGE__;

        lock_keys %$EST;
    }
    $EST;
}

sub _open_db {
    my $write = shift;

    my $open_opt = do {
        if ($write) {
            Database::DBWRITER |
                Database::DBCREAT;
        }
        else {
            Database::DBREADER;
        }
    };

    $EDB = Database->new;
    $EDB->open(CASKET, $open_opt);
	
    my $err = $EDB->error;
    $err == Database::ERRNOERR or
      croak "Failed to open HyperEst DB in ".
        ($write ? 'writer' : 'reader')." mode: ".
          $EDB->err_msg($err);

    $EDB_WRITE_MODE = $write;
}

sub _close_db {
    $EDB->close;
    $EDB = undef;
}

sub read {
    $_[0] and ref($_[0]) eq __PACKAGE__ and shift;
    my $func = shift; # sub { my $db = shift; ... }

    if (not $EDB) {
        _open_db(0);
    }

    do {
        local $EDB_IN_USE = 1;
        $func->($EDB);
    };
}

sub write {
    $_[0] and ref($_[0]) eq __PACKAGE__ and shift;
    my $func = shift; # sub { my $db = shift; ... }

    # 既に reader モードで開いてゐる最中だったら、
    # 一旦それを閉じて後で開き直す。
    my $reopen;
    if ($EDB and not $EDB_WRITE_MODE) {
        $reopen = 1;
        _close_db(); # ここで $EDB が undef に。
    }
    
    if (not $EDB) {
        _open_db(1);
    }

    do {
        local $EDB_IN_USE = 1;
        $func->($EDB);
    };

    if ($EDB_IN_USE) {
        # 今囘の EST->write() を抜けてもまだ EST->read か write の中に
        # 居る。
        if ($reopen) {
            # read の中に出る
            _close_db();
            _open_db(0);
        }
        else {
            # write の中に出るので何もせず終了
        }
    }
    else {
        _close_db();
    }
}

sub doc_num {
    $_[0] and ref($_[0]) eq __PACKAGE__ and shift;

    if (-e CASKET) {
        EST->read(
            sub {
                shift->doc_num;
            });
    }
    else {
        0;
    }
}

sub word_num {
    $_[0] and ref($_[0]) eq __PACKAGE__ and shift;

    if (-e CASKET) {
        EST->read(
            sub {
                shift->word_num;
            });
    }
    else {
        0;
    }
}

sub size {
    $_[0] and ref($_[0]) eq __PACKAGE__ and shift;

    if (-e CASKET) {
        EST->read(
            sub {
                shift->size;
            });
    }
    else {
        0;
    }
}

sub delete {
    $_[0] and ref($_[0]) eq __PACKAGE__ and shift;
    my $url = shift;
    my $ret;

    EST->write(
        sub {
            my $E = shift;
            my $eid = $E->uri_to_id($url);
            if ($eid != -1) {
                $E->out_doc($eid, 0);
                $ret = 1;
            }
        });

    $ret;
}

sub draft {
    $_[0] and ref($_[0]) eq __PACKAGE__ and shift;
    # 指定された URL ID からドラフトを生成して返す。
    # 生成されるドラフトは最新のバージョンのものである。
    # URL ID が無かったりバージョンが一つも無かったりしたら undef を返す。
    my $urlid = shift;
    my $ver = FS->get_latest_version($urlid);
    defined $ver or return;

    my $u_info = DB->selectrow_hashref(q{
        SELECT * FROM target_url WHERE urlid = ?}, undef, $urlid);
    
    my $v_info = FS->get_info($urlid, $ver);

    my $doc = Document->new;
    $doc->add_attr('@uri'   => $u_info->{url});
    $doc->add_attr('@size'  => $v_info->{data_size});
    $doc->add_attr('@mdate' => do {
        my @gmt = gmtime(sqlparsetime $u_info->{last_modified});
        strftime('%Y-%m-%dT%H:%M:%SZ', @gmt);
    });
    $doc->add_attr('#version' => $ver);

    if (defined($_ = $u_info->{label})) {
        $doc->add_attr('#label' => $_);
        $doc->add_hidden_text($_);
    }

    if (defined($_ = $u_info->{notation})) {
        $doc->add_attr('#note-len' => length);

        my $as_hidden = length(join '', @{ $doc->texts });
        foreach my $line (split /\r?\n|\r/, $_) {
            if ($as_hidden) {
                $doc->add_hidden_text($line);
            }
            else {
                $doc->add_text($line);
            }
        }
    }
    else {
        $doc->add_attr('#note-len' => 0);
    }

    my $ctype = $v_info->{content_type};
    if ($ctype) {
        if ($ctype =~ m!^text/plain!i) {
            _draft_plain_text($doc, $u_info, $v_info);
        }
        elsif ($ctype =~ m!^text/html!i or
                 $ctype =~ m!^application/xhtml+xml!i) {
            _draft_html($doc, $u_info, $v_info);
        }
        $doc->add_attr('@type' => $ctype);
    }

    $doc;
}

sub _charset {
    my ($ctype, $body) = @_;
    
    if ($ctype =~ m!charset=(\S+)!i or
          $ctype =~ m!charset="(.+?)"!i) {
        return $1;
    }

    # もしこれが HTML であり、meta http-equiv="content-type" を持ってゐ
    # るのであれば、LWP でダウンロードした時点で既にその ctype が DB に
    # 登録されてゐる。つまり今更 HTML をパースしてみても文字コードは書
    # かれてゐない。
	
    my $enc = guess_encoding(
        $body, qw/euc-jp cp932 7bit-jis utf8/);
	
    ref($enc) ? $enc->name : undef;
}

sub _get_utf8_body {
    my ($doc, $u_info, $v_info) = @_;
    my $ctype = $v_info->{content_type};

    my $body = FS->get_content($u_info->{urlid}, $v_info->{version});
    my $charset = _charset($ctype, $body);

    if (not defined $charset) {
        $doc->add_attr(
            '#warning', 'Failed to guess the charset of content.');
        return;
    }

    eval {
        Encode::from_to($body, $charset, 'UTF-8', Encode::FB_XMLCREF);
    };
    if ($@) {
        $doc->add_attr(
            '#warning',
            "Failed to transcode the content from `$charset' to UTF-8.");
        return;
    }

    $body;
}

sub _draft_plain_text {
    my ($doc, $u_info, $v_info) = @_;
    
    my $body = _get_utf8_body(@_);
    defined $body or return;

    foreach my $line (split /\r?\n|\r/, $body) {
        $doc->add_text($line);
    }
}

sub _draft_html {
    my ($doc, $u_info, $v_info) = @_;
    
    my $body = _get_utf8_body(@_);
    defined $body or return;

    my $elem_to_skip = {
        map { $_ => 1 } qw(script style)
       };
    my $in_title;
    my $in_elem_to_skip;
    my $_start_tag = sub {
        my ($tagname, $attr) = @_;

        if ($tagname eq 'title') {
            $in_title = 1;
        }
        elsif ($elem_to_skip->{$tagname}) {
            $in_elem_to_skip = 1;
        }
    };

    my $_end_tag = sub {
        my ($tagname, $attr) = @_;

        if ($tagname eq 'title') {
            $in_title = undef;
        }
        elsif ($elem_to_skip->{$tagname}) {
            $in_elem_to_skip = undef;
        }
    };
    
    my $_text = sub {
        my $text = shift;

        $text =~ s!^\s+!!;
        $text =~ s!\s+$!!;
        length $text or return;

        if ($in_title) {
            $doc->add_attr('@title' => $text);

            if (defined($_ = $u_info->{label})) {
                if ($_ ne $text) {
                    $doc->add_hidden_text($text);
                }
            }
        }
        elsif ($in_elem_to_skip) {
            # skip
        }
        else {
            $doc->add_text($text);
        }
    };
    
    my $p = HTML::Parser->new(
        api_version => 3,
        start_h     => [$_start_tag, 'tagname,attr'],
        end_h       => [$_end_tag, 'tagname'],
        text_h      => [$_text, 'dtext'],
       );

    if ($body =~ m/^\s*<\?xml/) {
        $p->xml_mode(1);
    }

    $p->parse($body);
}

1;
