view release on metacpan or  search on metacpan

lib/Lingua/NATools/Dict.pm  view on Meta::CPAN

# NATools - Package with parallel corpora tools
# Copyright (C) 2002-2012  Alberto Simões
#
# This package is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.

package Lingua::NATools::Dict;
our $VERSION = '0.7.12';
use 5.006;
use strict;
use warnings;
require Exporter;

use Lingua::NATools;
use MLDBM;
use Fcntl;
use Storable;
use Data::Dumper;

our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw() ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw();


sub new {
  my ($class, $filename, $size) = @_;

  my $id = Lingua::NATools::dicnew($size);
  return undef if $id < 0;

  my $self = bless +{ id => $id, filename => $filename } => $class;
  return $self;
}

sub open {
  my $filename = shift;

  $filename = shift if $filename eq "Lingua::NATools::Dict";
  my $self = {};
  return undef unless -f $filename;
  my $dic = Lingua::NATools::dicopen($filename);
  return undef if $dic < 0;
  $self->{id} = $dic;
  return bless $self #amen
}

sub close {
  my $self = shift;
  Lingua::NATools::dicclose($self->{id});
}

sub add {
  my $self = shift;
  my $other = shift;
  my $dicid = Lingua::NATools::dicadd($self->{id}, $other->{id});
  return undef if $dicid < 0;
  my $new = { id => $dicid };
  return bless $new #amen
}


sub save {
  my ($dic, $filename) = @_;
  $filename = $dic->{filename} if exists($dic->{filename}) && !$filename;
  return undef unless Lingua::NATools::dicsave($dic->{id}, $filename);
  return 1;
}

sub for_each {
  my $self = shift;
  my $sub  = shift;

  my $i = 1;
  while($i <= $self->size) {
    &{$sub}( word => $i, occ  => $self->occ($i), vals => $self->vals($i));
    $i++;
  }
}

sub exists {
  my $self = shift;
  my $id = shift;
  return 1 if $id > 0 && $id <= $self->size;
  return 0;
}

sub size {
  my $self = shift;
  return Lingua::NATools::dicgetsize($self->{id});
}