#!/usr/bin/perl -w

#todo: subtitle masih mengandung singkatan, mis: "bagai minyak dng air". ini dari kbbi sendiri.
#todo: babylon support tag apa aja selain <br>?

use strict;
use Data::Dumper;
use HTML::Entities;
use List::MoreUtils qw/uniq/;

=head1 DESCRIPTION

format babylon dapat diinput ke stardict-editor untuk dijadikan
dictionary stardict. selain format babylon terdapat juga format tab
tapi tidak support alias.

=head1 FORMAT HTML

 <p>LEMA:lerang (1)<br>
 <b><sup>1</sup>le&#183;rang</b> /l&#233;rang/ <i>n</i> jalur tepi (pd kain batik atau tenun); setrip; pias
 </p>

 <p>LEMA:lerang (2)<br>
 <b><sup>2</sup>le&#183;rang</b> /l&#233;rang/, <b>le&#183;rang-le&#183;rang</b> <i>n</i> tandu; usungan
 </p>

LEMA adalah akar kata. homograf dipisah dalam entri berbeda (contoh di
atas). untuk stardict gw ingin menyatukan kedua entri di atas dalam 1
entri.

setiap baris adalah "subentri" bisa berisi varian: ditambahi imbuhan
(men-cari), peribahasa (main air basah main api hangus, pb), kiasan,
frase dua kata. sebelnya, dalam satu baris bisa ada lebih dari satu
untuk yang mengandung --.

resenya, ";" dipakai sebagai pemisah subentri dan juga pemisah arti
dalam 1 subentri yang sama. lalu <b> atau <i> juga ditutupnya kadang
gak pas. mis: <b>~ teritorial 1</b> definisi 1 <b>2</b> definisi
2... tanda2x dibuatnya di word processor (ms word maybe).

<p>LEMA:abdi<br>
 <b>ab&#183;di</b> <i>n</i> <b>1</b> orang bawahan; pelayan; hamba; <b>2</b> budak tebusan;
 <br>--<b> dalem</b> <i>Jw</i> pegawai keraton; --<b> masyarakat</b> pegawai pemerintah yg pada dasarnya mempunyai kewaj...;
 <br><b>meng&#183;ab&#183;di</b> <i>v</i> menghamba; menghambakan diri; berbakti: <i>mereka berjanji akan benar-benar ~ ...
 <br></i><b>meng&#183;ab&#183;di&#183;kan</b> <i>v</i> <b>1</b> menjadikan diri abdi; memperhambakan: <i>kami ~ diri kpd ...
 <br><b>peng&#183;ab&#183;di</b> <i>n</i> orang yg mengabdi: <i>jangan kamu menjadi ~ harta benda; ...
 <br></i><b>peng&#183;ab&#183;di&#183;an</b> <i>n</i> proses, cara, perbuatan mengabdi atau mengabdikan: <i>ia memperlih ...
 </p>

untuk stardict, gw ingin membuatkan entri terpisah untuk setiap
subentri tersebut.

=head1 FORMAT TAB

 lerang|baris pertama\nbaris kedua

jika ingin encode "\" literal, gunakan "\\".

teks dalam encoding UTF8.

=head1 FORMAT BABYLON

 lerang
 arti pertama<br>arti kedua

 abdi|abdi dalem|mengabdi|pengabdi|pengabdian
 bla bla bla

=cut

my $mdash_sub;
my $tilde_sub;

# subentri2x yg sudah diketahui sebetulnya adalah contoh kalimat
my @kalimat = (
    '</i> paham: ~<i> terlarang',
    '<i>rupanya orang-orang di kampung ini kurang --',
    '</i> <i>pohon -- yg kautanam?',
    '<i>seorang -- muda ingin memperistrinya',
    '</i> <i>kantor pos --',
    '<i>Amarantus</i>',
    '--<i> sayangnya kpd kekasihnya sehingga dia tega',
    '</i> <i>usahanya adalah menjual dan membeli mobil --',

    '<i>Mugil cephalus</i>',
    '<i>Picidae</i> (banyak macamnya spt',
    '<i>Alocasia indica</i> (ada bermacam-macam',
    '<i>Erythrina</i> (ada bermacam-macam',
    '<i>Dyena costulata</i>, ada banyak macam',
    '<i>Colocasia esculenta</i> (ada bermacam-macam',
    '<i>Cucurbitaceae</i> (banyak macamnya',
    '<i>Cyprus rotundus,</i> banyak macamnya',
    '<i> Scomberomorus </i>(jenisnya bermacam-macam',
    '<i>Solanum melongena</i> (spt',
    '<i>Ipomoea batatas </i>(banyak macamnya',
    
    '</i> (ada bermacam-macam, spt --<b> belanda',
    '<i>belum terbayang dl -- saya, bagaimana memecahkan persoalan itu',
    '</i> <i>Ayah tidak kuasa menahan -- nya melihat anaknya dipukul orang',
    '</i> <i>kalau penyakit sudah -- susah diobati',
    '--<i> nya gelap</i> buruk nasibnya (sial, tidak beruntung)',
    '</i> --<i> tembaga',
    '--<i> melati',
    '<i>pipanya sampai ~ krn tidak pernah dibersihkan',
    '<i> rumah ini hanya -- untuk restoran',
    '</i> <i>ban mobil itu --',
    '<i>lantainya ~',
    '~<i> tuah</i> untung-untungan saja',
    '--<i> kesenian daerah dl rangka peringatan 17 Agustus',
    '~<i> perahu yg rusak',
    '<i>ia sudah tidak ~ lagi</i>, ia sudah tidak berkuasa',
    '</i> ~<i> waktu',
    '--<i> kuda dng bunyi tembakan</i> (melatih',
    '</i> --<i> tenang, jangan gelisah',
    '</i> --<i> panas',
    '</i> tetap bergerak terus: <i>arloji saya masih',
    '-- , -- bendi, putih, putih sadah, pb</i>', # sambungan peribahasa sebelumnya
    '~ tak cukup sebelit pinggang; tak ~ sehelai benang', # sambungan peribahasa sebelumnya
    '-- makan perut lapar), pb</i>', # sambungan peribahasa sebelumnya
    '-- tongkat bertelekan), pb</i>', # sambungan peribahasa sebelumnya
    '</i>~<i> muka dng tedung, pb</i>', # sambungan peribahasa sebelumnya
    '<i>hantu ~; perempuan ~; laki-laki ~',
    '<i>dia merasa ~ dng peraturan baru itu',
    '<i>apakah pekerjaanmu kemari hanya untuk ~ ?',
    '<i>Argusianus argus</i> (ada bermacam-macam spt',
    '</i> --<b> karang',
    '~<i> hak demokrasi',
    '~<i> modal, kita bisa gulung tikar',
    '<i>obat ~',
    'gi: <i>sekrupnya --', # terjadi pemotongan pada "la-gi"
    '<i>sebelum praktik mengajar, para calon guru mengadakan -- ke sekolah-sekolah',
    '~<i> ikan',
    '--<i> hatinya krn temannya tidak menepati janjinya',
    '<i>dng --',
    '</i> berlekuk-lekuk: <i>memakai topi yg ~',
    '<i>apa -- dimakannya (jua)',
    '~<i> muatan',
    '<i>air ~ pd bagian sungai yg dalam',
    '</i> ~<i> kejadian yg satu dng kejadian yg lain',
    '~<i> hasil rapat',
    '<i>alam (jagat) --',
    '</i> --<i> madat',
    '</b> --<b> pondoh</b> salak yg berbuah kecil-kecil, rasanya gurih dan manis',
    '</i>kabar --',
    '<i>cerita --',
    '</i> (menurut jurusannya, ada) --<i> dagang',
    '--<i> nanas',
    '<i>Bhinneka Tunggal Ika&#148; ialah -- Republik Indonesia',
    '<i>seniman tari sering juga menciptakan -- susastra yg indah',
    '--<i> melejang',
    '--<i> Eropa',
    '--<i> babi',
    'berpesan: <i>neneknya ~ kpd cucu-cucunya agar mereka rukun',
    '<i>dr -- yg halus dapat dibuat pakaian yg halus pula',
    '<b>c</b> bahan tertulis untuk dasar memberikan pelajaran',
    '~<i> muka dan bertukar pikiran dng golongan tua telah diadakannya',
    '</i> --<i> rumah',
    '</i> menyajikan: <i>pengarang itu ~ gagasannya dl karangannya',
    '<i>kakak ~ saya menjaga anak-anak di rumah',
    '<i>dl surat ini ~ surat Pak Guru',
    '<i>mereka ~ rukun Islam yg kelima, yaitu melaksanakan ibadah haji',
    '~<b><i> </b>daun johar',
    '-- , siapa nama gurumu?&#148',
    '<i>-- lampu',
    '<i>-- kuk ke leher lembu',
    '',
);
my $kalimat_re = join "|", map { quotemeta($_) } grep {/\S/} @kalimat;
$kalimat_re = qr/^(?:$kalimat_re)/;

sub info($)  { print STDERR "INFO: $_[0]\n" }
sub debug($) { print STDERR "DEBUG: $_[0]\n" }

sub strip_hyphenations {
    local $_ = shift;
    s/\xb7//g;
    $_;
}

sub process_title {
    local $_ = shift;
    #s/&#183;//g;
    $_ = decode_entities($_);
    if (/--/) { die "BUG#4: mdash_sub is undefined!" unless defined($mdash_sub); s/--/$mdash_sub/g; }
    if (/~/) { die "BUG#5: tilde_sub is undefined!" unless defined($tilde_sub); s/~/$tilde_sub/g; }
    s!^<sup>\s*\d+\s*</sup>!!;
    s/<[^>]+>//g;
    s/^\d+//;
    s/\s\d+$//;
    s/\s+$//; s/^\s+//;
    die "BUG#6: title is empty!" unless /\S/;
    s/,$//;
    #die "BUG#7: title mengandung koma di akhir!" if /,\s*$/;
    $_;
}

{
    local $/ = undef;
    $_ = <>;
    info "ukuran html mentah: ".length($_);
    # bekas2x ms word/wordprocessor
    s!<([bi])>(\s*)</\1>!$2!sg;
    s!</([bi])>(\s*)<\1>!$2!sg;
}

my @raw_entries;
my $i;
while (m!^<p>LEMA:([^<]+)<br>\s+(.+?)^</p>!msg) {
    push @raw_entries, [++$i, $1, $2];
}
info "jumlah entri: ".@raw_entries;
#debug Dumper @raw_entries;

my %entries;
for my $r (@raw_entries) {
    my $i = $r->[0];
    my $title0 = $r->[1];
    my $def = $r->[2];

    info "memroses entri #$i: $title0 ...";

    my $title = lc $title0;
    $title =~ s/ \(\d+\)//;
    $mdash_sub = $title;
    $tilde_sub = $title;

    # -- kadang ditulis -, sucks
    $def =~ s!>- !>-- !g;
    $def =~ s! - ! -- !g;
    $def =~ s! -<! --<!g;

    # kesulitan parsing ini muncul karena ; dipakai utk 2 fungsi
    my @subentries = split m!;?(?:</[bi]>)?\n?<br>|;\s*(?=--)|;\s*(?=~)|;\s*(?=<)!, $def;
    #debug Dumper(\@subentries);
    for (my $i=0; $i<@subentries; $i++) {
        next if $i == 0;
        my $alasan = "";
        my $s = $subentries[$i];
        if ($s =~ m!^(?:</i>\s*)?<b>\s*\d+\s*</b>!) { $alasan = "arti lain" }
        elsif ($s !~ m!~|--|&#183;!) { $alasan = "contoh kalimat" }
        elsif ($s =~ m!^<i>[^<]+</i>$!) { $alasan = "contoh kalimat (2)" }
        elsif ($s =~ m!^.+?</i>$! && $s !~ /&#183;/) { $alasan = "contoh kalimat (3)" }
        elsif ($s =~ m!^[^<]+$!) { $alasan = "contoh kalimat (4)" }
        elsif ($s =~ $kalimat_re) { $alasan = "contoh kalimat (manual)" }
        next unless $alasan;
        #debug "menggabungkan [".$subentries[$i-1]."] dan [".$subentries[$i]."] karena $alasan";
        $subentries[$i-1] .= "; ".$subentries[$i];
        splice @subentries, $i, 1;
        $i--;
    }
    debug Dumper(\@subentries);

    my @aliases;
    my $j;
    for my $se (@subentries) {

        $se =~ s!</b>-<b>!-!g; # oleh kbbi foo-bar diformatnya <b>foo</b>-<b>bar</b>

        my $raw_subtitle;
        my $subtitle;
        my $subtype;
        my $subdef;
        $j++;
        $se =~ s!^</i>!!;
        $se =~ s!^\s*!!;
        if ($se =~ m!^((?:--|~)?(?:<b>)(?:<sup>\s*\d+\s*</sup>)?[^<]+</b>)\s*(?:/[^/]+/)?\s*<i>\s*([^<]+)\s*</i>\s*(.+)\s*!) {
            $raw_subtitle = $1;
            $subtitle = process_title($1);
            $subtype = $2;
            $subdef = $3;
            $tilde_sub = $subtitle if $raw_subtitle =~ /&#183;/;

            if ($j == 1 && $subdef =~ /(\S+&#183;\S+)/) {
                my $t2 = process_title($1);
                $mdash_sub = $t2;
                $tilde_sub = $t2;
            }
        } elsif ($se =~ m!^((?:--|~)?.+?), (?:<i>)?(pb|pb Mk|ki|ki kas)\s*</i>\s*(.+)!) {
            $raw_subtitle = $1;
            $subtitle = process_title($1);
            $subtype = $2;
            $subdef = $3;
        } elsif ($se =~ m!^(?:</b>)?((?:--)?<b>(?:<sup>\s*\d+\s*</sup>)?[^<]+</b>)\s*(.+)\s*!) {
            $raw_subtitle = $1;
            $subtitle = process_title($1);
            $subtype = "";
            $subdef = $2;
            $tilde_sub = $subtitle if $raw_subtitle =~ /&#183;/;
        } elsif ($se =~ m!^((?:~)?\s*(?:<b>)?[^<]+</b>)\s*(.+)\s*!) {
            $raw_subtitle = $1;
            $subtitle = process_title($1);
            $subtype = "";
            $subdef = $2;
            #</b> yang gak pas
            if ($subtitle =~ /(\d+)$/) {
                $subdef = "<b>$1</b> $subdef";
                $subtitle =~ s/\d+$//;
            }
            $tilde_sub = $subtitle if $raw_subtitle =~ /&#183;/;
        } elsif ($se =~ m!^((?:--|~)?(?:<i>)?[^<]+)</i>\s*(.+)!) {
            $raw_subtitle = $1;
            $subtitle = process_title($1);
            warn "BUG#1: salah tangkap contoh menjadi subentri?: $se" unless $raw_subtitle =~ /--|~/;
            next;
            $subtype = "";
            $subdef = $2;
        } elsif ($se =~ m!^<b>((?:<sup>\d+</sup>)?[^<]+?)\s*(?:/[^/]+/)?\s*\? ([^<]+)(?:</b>)?$!) {
            # variasi ejaan
            $raw_subtitle = $1;
            $subtitle = process_title($1);
            $subtype = "Lihat {".strip_hyphenations(process_title($2))."}";
            $subdef = "";
        } else {
            warn "BUG#2: gagal parsing subentri $j: `$se'";
            next;
        }
        info "memroses subentri #$j: [$raw_subtitle] ($subtitle) [$subtype] [$subdef] ...";
        my $sts = strip_hyphenations($subtitle);
        do { warn "BUG#3: kemungkinan ada 2 subentri yang masih tergabungkan"; next }
            if $subdef =~ /&#183;/ && $title ne $sts && $sts !~ /^(sedua|menetal|setungging|rubu, merubu)$/;

        # peribahasa kan panjang2x?
        #warn "BUG#8: kemungkinan salah, title terlalu panjang? title=$subtitle" if length($subtitle) > 25;

        $entries{$subtitle} ||= {aliases=>[], defs=>[]};
        push @{ $entries{$subtitle}{aliases} }, $subtitle;
        if ($subtype) {
            $subtype =~ s/,\s*$//;
            $subdef = "[$subtype] $subdef";
        }
        push @{ $entries{$subtitle}{defs} }, $subdef;
    }

}

#debug Dumper \%entries; exit;

# output
for my $e (sort keys %entries) {
    my @aliases = uniq @{ $entries{$e}{aliases} };
    my $type = $entries{$e}{type};
    my $defs = $entries{$e}{defs};

    for (@$defs) {
        s/\n//g;
        s!<b>\s*(\d+)\s*</b>!"($1)"!eg;
        $_ = decode_entities($_);
        s/<[^>]+>//g;
        tr/\xe9\x97\x93\x94\xb4\xfe\xb7/E\-""'p./; # XXX: stardict kok gak mau nampilin \xe9 dll ya, kan UTF8?
        s!\xBD!1/2!g;
        s!\xBC!1/4!g;
        s!\x96!--!g;
        s!\xe2!a^!g;
        s!\xfb!u^!g;
        s!\xe4!a:!g;
        s!\x89!permil!g;

        #die "$e: Definisi masih mengandung karakter aneh: $_" if /[^\x00-\x7f]/;
    }

    print join("|", map { strip_hyphenations($_) } @aliases), "\n";
    my $ee = $e; $ee =~ s/\xb7/./g; # stardict gak mau nampilin \xb7?
    print "$ee<br>" if $ee ne $e;
    print join "<br><br>", @$defs;
    print "\n\n";
}