kanji-dictionary

#!/usr/bin/env perl
use 5.14.0;
use warnings;
use utf8::all;
use Anki::Database;
use List::MoreUtils 'uniq';

# http://forum.koohii.com/viewtopic.php?pid=194634

my $anki = Anki::Database->new;

my %sentences_for_kanji;
my %readings_for_kanji;
my @cards;

$anki->each_card(sub {
    my ($card) = @_;
    my $model_name = $card->model->name;

    if ($model_name eq '文') {
        my $sentence = $card->field('日本語');
        for my $kanji ($sentence =~ /\p{Han}/g) {
            push @{ $sentences_for_kanji{ $kanji } }, $sentence;
        }

        my @readings = split /<.*?>/, $card->field('読み');
        for my $line (grep length, @readings) {
            for my $kanji ($line =~ /\p{Han}/g) {
                push @{ $readings_for_kanji{$kanji} }, $line;
            }
        }
    }
    elsif ($model_name eq '漢字') {
        push @cards, $card;
    }
});

say '<?xml version="1.0" encoding="UTF-8"?>
<d:dictionary xmlns="http://www.w3.org/1999/xhtml" xmlns:d="http://www.apple.com/DTDs/DictionaryService-1.0.rng">';

my $id = 0;
for my $card (@cards) {
    my $kanji     = $card->field('漢字');
    my $english   = $card->field('英語');
    my @sentences = uniq @{ $sentences_for_kanji{ $kanji } || [] };
    my @readings  = uniq @{ $readings_for_kanji{ $kanji } || [] };

    ++$id;

    say qq{
        <d:entry id="kanji_$id" d:title="$kanji">
        <d:index d:value="$kanji"/>
        <d:index d:value="$english"/>
        <h1>$kanji</h1>
        <h2>$english</h2>
    };

    if (@readings) {
        say q{<ul style="margin-bottom:1em">};
        for (@readings) {
            say "<li>$_</li>";
        }
        say "</ul>";
    }

    if (@sentences) {
        say "<ul>";
        for (@sentences) {
            s{$kanji}{<b>$kanji</b>}g;
            say "<li>$_</li>";
        }
        say "</ul>";
    }

    say qq{
        </d:entry>
    };
}

say '</d:dictionary>';