view release on metacpan or  search on metacpan

lib/Lingua/PTD/SQLite.pm  view on Meta::CPAN

package Lingua::PTD::SQLite;
$Lingua::PTD::SQLite::VERSION = '1.17';
use strict;
use warnings;

use parent 'Lingua::PTD';
use DBI;

=encoding UTF-8

=head1 NAME

Lingua::PTD::SQLite - Sub-module to handle PTD files in sqlite format

=head1 SYNOPSIS

  use Lingua::PTD;

  $ptd = Lingua::PTD->new( "file.sqlite" );

=head1 DESCRIPTION

Check L<<Lingua::PTD>> for complete reference.

=head1 SEE ALSO

NATools(3), perl(1)

=head1 AUTHOR

Alberto Manuel Brandão Simões, E<lt>ambs@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010-2014 by Alberto Manuel Brandão Simões

=cut

sub new {
    my ($class, $filename) = @_;
    my $dbh = DBI->connect("dbi:SQLite:dbname=$filename", "", "",
                          { sqlite_unicode => 1} ) or die "Cant connect to database";
    my $self = {
                dbh => $dbh,
                get_meta => $dbh->prepare("SELECT v FROM meta WHERE k = ?;"),
                get_occs => $dbh->prepare("SELECT occ FROM occs WHERE w = ?;"),
                exists   => $dbh->prepare("SELECT w FROM trans WHERE w = ?;"),
               };
    bless $self => $class # amen
}

sub trans {
    my ($self, $word, $trans) = @_;
    if ($trans) {
        my $sth = $self->{dbh}->prepare("SELECT p FROM trans WHERE w = ? AND t = ?;");
        $sth->execute($word, $trans);
        my @row = $sth->fetchrow_array;
        return (@row)?1:0;
    } else {
        my $sth = $self->{dbh}->prepare("SELECT t FROM trans WHERE w = ?");
        $sth->execute($word);
        my @ans;
        my @row;
        while (@row = $sth->fetchrow_array) { push @ans, $row[0] };
        return @ans;
    }
}


sub prob {
    my ($self, $word, $trans) = @_;
    my $sth = $self->{dbh}->prepare("SELECT p FROM trans WHERE w = ? AND t = ?;");
    $sth->execute($word, $trans);
    my @row = $sth->fetchrow_array;
    return (@row)?$row[0]:0;
}

sub words {
    my $self = shift;
    my $sort = $_[0] ? "ORDER BY w ASC" : "";

    my $sth = $self->{dbh}->prepare("SELECT w FROM occs $sort;");
    $sth->execute;
    my @answer = ();
    my @row;
    while (@row = $sth->fetchrow_array()) { push @answer, $row[0] };
    return @answer;
}

sub exists {
    my ($self, $word) = @_;
    $self->{exists}->execute($word);
    if ($self->{exists}->fetchrow_array()) {
        return 1;
    } else {
        return 0;
    }
}

sub _calculate_sizes {
    my $self = shift;
    my $sth = $self->{dbh}->prepare("SELECT COUNT(w) FROM occs");
    $sth->execute;
    my @row = $sth->fetchrow_array;
    $self->_update_meta("count", $row[0]);

    $sth = $self->{dbh}->prepare("SELECT SUM(occ) FROM occs");
    $sth->execute;
    @row = $sth->fetchrow_array;