File Coverage

blib/lib/Lingua/JA/WordNet.pm

Criterion	Covered	Total	%
statement	122	122	100.0
branch	38	38	100.0
condition	24	24	100.0
subroutine	20	20	100.0
pod	11	11	100.0
total	215	215	100.0

package Lingua::JA::WordNet;

use 5.008_008;
use strict;
use warnings;

use DBI;
use Carp ();
use File::ShareDir  ();
use List::MoreUtils ();

our $VERSION = '0.21';

my $DB_FILE = 'wnjpn-1.1_and_synonyms-1.0.db';


sub _options
{
    return {
        data        => File::ShareDir::dist_file('Lingua-JA-WordNet', $DB_FILE),
        enable_utf8 => 0,
        verbose     => 0,
    };
}

sub new
{
    my $class = shift;

    my $options = $class->_options;

    if (scalar @_ == 1) { $options->{data} = shift; }
    else
    {
        my %args = @_;

        for my $key (keys %args)
        {
            if ( ! exists $options->{$key} ) { Carp::croak "Unknown option: '$key'"; }
            else                             { $options->{$key} = $args{$key};       }
        }
    }

    Carp::croak 'WordNet data file is not found' unless -f $options->{data};

    my $dbh = DBI->connect("dbi:SQLite:dbname=$options->{data}", '', '', {
        #Warn           => 0, # get rid of annoying disconnect message
        # The Warn attribute enables useful warnings for certain bad practices.
        # It is enabled by default and should only be disabled in rare circumstances.
        # (see http://search.cpan.org/dist/DBI/DBI.pm#Warn)

        RaiseError     => 1,
        PrintError     => 0,
        AutoCommit     => 0,
        sqlite_unicode => $options->{enable_utf8},
    });

    bless { dbh => $dbh, verbose => $options->{verbose} }, $class;
}

sub DESTROY { shift->{dbh}->disconnect; }

sub Word
{
    my ($self, $synset, $lang) = @_;

    $lang = 'jpn' unless defined $lang;

    my $sth
        = $self->{dbh}->prepare
        (
            'SELECT lemma FROM word JOIN sense ON word.wordid = sense.wordid
              WHERE synset     = ?
                AND sense.lang = ?'
        );

    $sth->execute($synset, $lang);

    my @words = map { $_->[0] =~ tr/_/ /; $_->[0]; } @{$sth->fetchall_arrayref};

    Carp::carp "Word: there are no words for $synset in $lang" if $self->{verbose} && ! scalar @words;

    return @words;
}

sub Synset
{
    my ($self, $word, $lang) = @_;

    $lang = 'jpn' unless defined $lang;

    my $sth
        = $self->{dbh}->prepare
        (
            'SELECT synset FROM word LEFT JOIN sense ON word.wordid = sense.wordid
              WHERE lemma      = ?
                AND sense.lang = ?'
        );

    $sth->execute($word, $lang);

    my @synsets = map {$_->[0]} @{$sth->fetchall_arrayref};

    Carp::carp "Synset: there are no synsets for '$word' in $lang" if $self->{verbose} && ! scalar @synsets;

    return @synsets;
}

sub SynPos
{
    my ($self, $word, $pos, $lang) = @_;

    $lang = 'jpn' unless defined $lang;

    my $sth
        = $self->{dbh}->prepare
        (
            'SELECT synset FROM word LEFT JOIN sense ON word.wordid = sense.wordid
              WHERE lemma      = ?
                AND word.pos   = ?
                AND sense.lang = ?'
        );

    $sth->execute($word, $pos, $lang);

    my @synsets = map {$_->[0]} @{$sth->fetchall_arrayref};

    Carp::carp "SynPos: there are no synsets for '$word' corresponding to '$pos' and '$lang'" if $self->{verbose} && ! scalar @synsets;

    return @synsets;
}

sub Pos
{
    my ($self, $synset) = @_;
    return $1 if $synset =~ /^[0-9]{8}-([arnv])$/;
    Carp::carp "Pos: '$synset' is wrong synset format" if $self->{verbose};
    return;
}

sub Rel
{
    my ($self, $synset, $rel) = @_;

    my $sth
        = $self->{dbh}->prepare
        (
            'SELECT synset2 FROM synlink
              WHERE synset1 = ?
                AND link    = ?'
        );

    $sth->execute($synset, $rel);

    my @synsets = map {$_->[0]} @{$sth->fetchall_arrayref};

    Carp::carp "Rel: there are no $rel links for $synset" if $self->{verbose} && ! scalar @synsets;

    return @synsets;
}

sub Def
{
    my ($self, $synset, $lang) = @_;

    $lang = 'jpn' unless defined $lang;

    my $sth
        = $self->{dbh}->prepare
        (
            'SELECT sid, def FROM synset_def
              WHERE synset = ?
                AND lang   = ?'
        );

    $sth->execute($synset, $lang);

    my @defs;

    while (my $row = $sth->fetchrow_arrayref)
    {
        my ($sid, $def) = @{$row};
        $defs[$sid] = $def;
    }

    Carp::carp "Def: there are no definition sentences for $synset in $lang" if $self->{verbose} && ! scalar @defs;

    return @defs;
}

sub Ex
{
    my ($self, $synset, $lang) = @_;

    $lang = 'jpn' unless defined $lang;

    my $sth
        = $self->{dbh}->prepare
        (
            'SELECT sid, def FROM synset_ex
              WHERE synset = ?
                AND lang   = ?'
        );

    $sth->execute($synset, $lang);

    my @exs;

    while (my $row = $sth->fetchrow_arrayref)
    {
        my ($sid, $ex) = @{$row};
        $exs[$sid] = $ex;
    }

    Carp::carp "Ex: there are no example sentences for $synset in $lang" if $self->{verbose} && ! scalar @exs;

    return @exs;
}

sub AllSynsets
{
    my $self = shift;
    my $sth = $self->{dbh}->prepare('SELECT synset FROM synset');
    $sth->execute;
    my @synsets = map {$_->[0]} @{$sth->fetchall_arrayref};
    return \@synsets;
}

sub WordID
{
    my ($self, $word, $pos, $lang) = @_;

    $word =~ tr/ /_/;
    $lang = 'jpn' unless defined $lang;

    my $sth
        = $self->{dbh}->prepare
        (
            'SELECT wordid FROM word
              WHERE lemma = ?
                AND pos   = ?
                AND lang  = ?'
        );

    $sth->execute($word, $pos, $lang);

    my ($wordid) = map {$_->[0]} @{$sth->fetchall_arrayref};

    Carp::carp "WordID: there is no WordID for '$word' corresponding to '$pos' and '$lang'" if $self->{verbose} && ! defined $wordid;

    return $wordid;
}

sub Synonym
{
    my ($self, $wordid) = @_;

    my $sth
        = $self->{dbh}->prepare
        (
            'SELECT lemma FROM word JOIN wordlink ON word.wordid = wordlink.wordid2
              WHERE wordid1 = ?
                AND link    = ?'
        );

    $sth->execute($wordid, 'syns');
    my @synonyms = map {$_->[0]} @{$sth->fetchall_arrayref};

    Carp::carp "Synonyms: there are no Synonyms for $wordid" if $self->{verbose} && ! scalar @synonyms;

    # 一応順番を保持したいのでハッシュスライスは使わない
    # uniq: The order of elements in the returned list is the same as in LIST.
    return List::MoreUtils::uniq @synonyms;
}

1;

__END__