package DicionarioAberto;

use XML::DT;
use DBI;

use warnings;
use strict;

=head1 NAME

DicionarioAberto - The great new DicionarioAberto!

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';


=head1 SYNOPSIS

    use DicionarioAberto;

    my $DA = DicionarioAberto->new( db => 'xml.db' );

=head1 METHODS

=head2 new

Creates a new DicionarioAberto class. As arguments you should supply a
hash of configuration fields. A C<< db >> field is required, pointing
to the xml database file of Dicionário Aberto.

=cut

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

    return undef unless -f $self->{db};

    $self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{db}", "", "");
    return undef unless $self->{dbh};

    $self->{dbh}{sqlite_unicode} = 1;

    return $self;
}

=head2 process_entries

=cut

sub process_entries {
    my (@row, $self, $conf, $code);

    $self = shift;
    $conf = shift if ref($_[0]) eq 'HASH';
    $code = shift if ref($_[0]) eq 'CODE';
    return undef unless $code;

    $self->{dbh}->begin_work();

    my $select = "SELECT * FROM entry";
    $select .= " WHERE word LIKE \"$conf->{words_like}\"" if exists $conf->{words_like};

    my $insert = "UPDATE entry SET xml = ? WHERE word = ? AND n = ?";
    $insert = $self->{dbh}->prepare($insert);

    my $regexp = exists($conf->{grep_words}) ? $conf->{grep_words} : undef;

    my $sth = $self->{dbh}->prepare($select);
    $sth->execute;

    while (@row = $sth->fetchrow_array) {
        next if $regexp and $row[0] !~ $regexp;

        my $result = $code->($row[0], $row[2]);
        if (exists($conf->{inplace})) {
            $insert->execute($result, $row[0], $row[1]);
        }
    }

    $self->{dbh}->commit();
}


=head2 process_senses

=cut

sub process_senses {
    my (@row, $self, $conf, $code);

    $self = shift;
    $conf = (ref($_[0]) eq 'HASH')? shift : {};
    $code = shift if ref($_[0]) eq 'CODE';
    return undef unless $code;

    my $sub = sub {
        my ($word, $xml) = @_;
        my %processor =
          (
           sense   => sub {
               $v{morph} ||= "";
               $v{usg}   ||= {};
               $v{def}   ||= "";

               # Filter by morphology class
               return if exists($conf->{grep_morph}) && $v{morph} !~ qr/$conf->{grep_morph}/;

               # Filter by usage
               if ($conf->{grep_usg}) {
                   for my $type (keys %{$conf->{grep_usg}}) {
                       return unless exists($v{usg}{$type});
                       return unless grep { $_ =~ qr/$conf->{grep_usg}{$type}/ } @{$v{usg}{$type}};
                   }
               }

               $code->($word, $v{morph}, $v{def}, %{$v{usg}});
           },
           gramGrp => sub { $c = _trim($c); father->{morph} = $c },
           def     => sub { $c = _trim($c); father->{def} = $c },
           usg     => sub { $c = _trim($c); push @{father->{usg}{$v{type}}}, $c },
          );
        dtstring( $xml, %processor );
    };

    $self->process_entries( $conf, $sub );

}

sub _trim {
    my $c = shift;
    for ($c) {
        s/^\n+//;
        s/\n+$//;
    }
    return $c;
}


=head1 AUTHOR

Alberto Simoes, C<< <ambs at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-dicionarioaberto
at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=DicionarioAberto>.  I
will be notified, and then you'll automatically be notified of
progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc DicionarioAberto

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=DicionarioAberto>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/DicionarioAberto>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/DicionarioAberto>

=item * Search CPAN

L<http://search.cpan.org/dist/DicionarioAberto/>

=back

=head1 LICENSE AND COPYRIGHT

Copyright 2010 Alberto Simoes.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut

1; # End of DicionarioAberto