File Coverage

blib/lib/Lingua/ZH/CEDICT.pm

Criterion	Covered	Total	%
statement	44	144	30.5
branch	4	18	22.2
condition	12	37	32.4
subroutine	11	26	42.3
pod	21	21	100.0
total	92	246	37.4

package Lingua::ZH::CEDICT;

# Copyright (c) 2002-2005 Christian Renz
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.

# $Id: CEDICT.pm,v 1.5 2002/08/13 19:06:07 crenz Exp $

use 5.006;
use bytes;
use strict;
use warnings;
use vars qw($VERSION @ISA);

$VERSION = '0.04';
@ISA = ();

sub new {
    my $class = shift;
    my $self = +{@_};

    $self->{source} ||= 'Storable';

    # load data interface module
    my $if = "$class\::$self->{source}";
    (my $file = $if) =~ s|::|/|g;
    require "$file.pm";

    # let others do the blessing
    return $if->new(%{$self});
}

sub exportData {
    my ($self) = @_;
    my $data;

    foreach (qw(version entry keysZh keysPinyin keysEn)) {
        $data->{$_} = $self->{$_};
    }

    return $data;
}

sub numEntries {
    my ($self) = @_;

    return scalar @{$self->{entry}};
}

sub version {
    my ($self) = @_;

    return $self->{version};
}

sub generateKeywords {
    my ($self) = @_;

    $self->{keysZh} = {};
    $self->{keysPinyin} = {};
    $self->{keysEn} = {};

    my ($zh, $p, $en);

    foreach (0..($self->numEntries - 1)) {
        my $e = $self->{entry}->[$_];
        push @{$self->{keysZh}->{$e->[0]}}, $_; $zh++;
        if (defined($e->[1]) && ($e->[1])) {
            push @{$self->{keysZh}->{$e->[1]}}, $_;
            $zh++;
        }
        push @{$self->{keysPinyin}->{$e->[3]}}, $_; $p++;

        foreach my $k ($self->englishToKeywords($e->[4])) {
            push @{$self->{keysEn}->{$k}}, $_;
            $en++;
        }
    }
}

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

    $sub ||= \&utf8Pinyin;

    foreach (0..($self->numEntries - 1)) {
        $self->{entry}->[$_]->[2] =
            &$sub($self->{entry}->[$_]->[2]);
    }
}

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

    $sub ||= \&formatEnglish;

    foreach (0..($self->numEntries - 1)) {
        $self->{entry}->[$_]->[4] =
            &$sub($self->{entry}->[$_]->[4]);
    }
}

sub addSimpChar {
    my ($self) = @_;

    $self->{HanConvert} ||= "Lingua::ZH::CEDICT::HanConvert";
    (my $filename = $self->{HanConvert} . ".pm") =~ s|::|/|g;
    my $lib = $self->{HanConvert};

    require $filename;
    import $lib 'simple';


    foreach (@{$self->{entry}}) {
        my $s = simple($_->[0]);
        $_->[1] = $s unless ($s eq $_->[0]);
    }
}

# just for completeness' sake, should not really be necessary
sub addTradChar {
    my ($self) = @_;

    $self->{HanConvert} ||= "Lingua::ZH::HanConvert";
    (my $filename = $self->{HanConvert} . ".pm") =~ s|::|/|g;
    my $lib = $self->{HanConvert};

    require $filename;
    import $lib 'trad';

    foreach (@{$self->{entry}}) {
        my $t = trad($_->[0]);
        if ($t ne $_->[0]) {
            $_->[1] = $_->[0];
            $_->[0] = $t;
        }
    }
}

# Functions for accessing the dictionary ************************************

sub entry {
    my ($self, $num) = @_;
    return $self->{entry}->[$num];
}

sub keysEn {
    my ($self) = @_;

    return $self->{keysEn};
}

sub keysZh {
    my ($self) = @_;

    return $self->{keysZh};
}

sub keysPinyin {
    my ($self) = @_;

    return $self->{keysPinyin};
}

sub startMatch {
    my ($self, $term) = @_;

    $self->{_matchPos} = 0;
    $self->{_matchTerm} = $term;
}

# returns a reference to the first/following entry that matches
sub match {
    my ($self) = @_;
    my $term = $self->{_matchTerm};

    while ($self->{_matchPos} < $self->numEntries) {
        $self->{_matchPos}++;
        my $e = $self->{entry}->[$self->{_matchPos} - 1];
        return $e
            if (($e->[0] =~ /$term/) or
                ($e->[1] =~ /$term/) or
                ($e->[2] =~ /\b$term\b/i) or
                ($e->[3] =~ /\b$term\b/i) or
                ($e->[4] =~ /\b$term\b/i));
    }

    # nothing found
    return undef;
}

sub startFind {
    my ($self, $term) = @_;

    $self->{_findPos} = 0;
    $self->{_findTerm} = $term;
}

# returns a reference to the first/following entry that matches
sub find {
    my ($self) = @_;
    my $term = $self->{_findTerm};

    while ($self->{_findPos} < $self->numEntries) {
        $self->{_findPos}++;
        my $e = $self->{entry}->[$self->{_findPos} - 1];
        return $e
            if (($e->[0] eq $term) or
                ($e->[1] eq $term) or
                ($e->[2] =~ /^$term$/i) or
                ($e->[3] =~ /^$term$/i) or
                ($e->[4] =~ /^$term$/i));
    }

    # nothing found
    return undef;
}

# Formatting ****************************************************************

my %xlat =
    (a1    => "ā", e1    => "ē", i1    => "ī",
     o1    => "ō", u1    => "ū", 'v1'  => "ǖ",
     a2    => "á", e2    => "é", i2    => "í",
     o2    => "ó", u2    => "ú", 'v2'  => "ǘ",
     a3    => "ǎ", e3    => "ě", i3    => "ǐ",
     o3    => "ǒ", u3    => "ǔ", 'v3'  => "ǚ",
     a4    => "à", e4    => "è", i4    => "ì",
     o4    => "ò", u4    => "ù", 'v4'  => "ǜ",
     a5    => 'a',  e5    => 'e',  i5    => 'i',
     o5    => 'o',  u5    => 'u',  'v5'  => 'ü');

sub utf8Pinyin {
    my ($self, $p) = @_;
    $p = $self unless ref($self);

    # normalize u: and v to v
    $p =~ s/u:/v/g;

    $p =~ s/([iuv]?)([aeiouv])([a-z]*)([1-5])/$1$xlat{"$2$4"}$3/g;
    return $p;
}

sub formatEnglish {
    my ($self, $en) = @_;
    $en = $self unless ref($self);

    my $separator = " · ";
#    my $separator = "/";

#    $en =~ s|/|$separator|g;
#    return $en;

    my @terms = split m|/|, $en;

    foreach (0..$#terms) {
        $terms[$_] =~ s|\(([^(]+)\)$|$1|;
    }

    return join($separator, @terms);
}

sub removePinyinTones {
    my ($self, $p) = @_;

    $p =~ s/[12345]//g;
    $p =~ s/(u:|v)/u/g;

    return $p;
}

sub englishToKeywords {
    my ($self, $en) = @_;
    my @kw;

    foreach (split(m|/|, $en)) {
        next if /^\([^()]+\)$/;

        # remove trailing explanation in brackets
        s/\s+\([^(]+\)$//;
        s/^\(?(to|the|a|an|to be)\)?\s+//i;

        # remove characters we don't like in keywords
        s|[^-a-zA-Z0-9 /.]||g;
        s|^\.+||;
#        s!(\w|\d|\s|-|/)!!g;

        # remove leading and trailing and multiple whitespace
        s/^\s+//;
        s/\s+$//;
        s/\s\s+/ /g;

        # definitions like "(a sense of) uncertainty"
        if (/^\((.+?)\)\s+(.+)$/) {
            push @kw, uc($2);
            push @kw, uc("$1 $2");
        } else {
            push @kw, uc($_);
        }
    }

    # return non-empty keywords
    return grep /\w/, @kw;
}

1;
__END__