File Coverage

blib/lib/Bot/Babelfish.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Bot::Babelfish;
use strict;
use Bot::BasicBot;
use Carp;
use Encode;
use I18N::LangTags qw(extract_language_tags is_language_tag);
use I18N::LangTags::List;
use Lingua::Translate;
use Text::Unidecode;

{ no strict;
  $VERSION = '0.04';
  @ISA = qw(Bot::BasicBot);
}

=head1 NAME

Bot::Babelfish - Provides Babelfish translation services via an IRC bot

=head1 VERSION

Version 0.04

=head1 SYNOPSIS

    use Bot::Babelfish;

    my $bot = Bot::Babel->new(
        nick => 'babel',  name => 'Babelfish bot',
        server => 'irc.perl.org', channels => [ '#mychannel' ]
    )->run

=head1 DESCRIPTION

This module provides the backend for an IRC bot which can be used as an
interface for translation services using Babelfish.

=head1 METHODS

=over 4

=item init()

Initializes private data.

=cut

sub init {
    my $self = shift;

    $self->{babel} = {
        cache       => {},
    };

    return 1
}

=item said()

Main function for interacting with the bot object.
It follows the C API and expect an hashref as argument.
See L<"COMMANDS"> for more information on recognized commands.

=cut

sub said {
    my $self = shift;
    my $args = shift;

    # don't do anything unless directly addressed
    return undef unless $args->{address} eq $self->nick or $args->{channel} eq 'msg';
    return if $self->ignore_nick($args->{who});

    # ignore karma
    return if index($args->{body}, '++') == 0;
    return if index($args->{body}, '--') == 0;

    if($args->{body} =~ /^ *version/) {
        $args->{body} = sprintf "%s IRC bot, using %s", $self->nick,
            join ', ', map { $_ . ' ' . $_->VERSION } qw(
                Bot::BasicBot  Bot::Babelfish  Encode  Lingua::Translate
                POE  POE::Component::IRC
            );
        $self->say($args);
        return undef;
    }

    #print STDERR $/, $args->{body}, $/;
    my ($from, $to) = extract_language_tags($args->{body} );
    $from ||= 'en';
    $to   ||= 'fr';
    #print STDERR " $from -> $to : ", $args->{body}, $/;

    unless(is_language_tag($from)) {
        $args->{body} = "Unrecognized language tag '$from'";
        $self->say($args);
        return undef
    }

    unless(is_language_tag($to)) {
        $args->{body} = "Unrecognized language tag '$to'";
        $self->say($args);
        return undef
    }

    my $from_to = "$from>$to";
    my($from_lang,$to_lang) = map { I18N::LangTags::List::name($_) } $from, $to;

    my $translator = new Lingua::Translate src => $from, dest => $to;
    unless(defined $translator) {
        $args->{body} = "Can't translate from $from_lang to $to_lang";
        $self->say($args);
        return undef
    }

    my $text = encode('utf-8', decode('iso-8859-1', $args->{body}));
    my $result = $self->{babel}{cache}{$from_to}{$text};

    unless($result) {
        eval { $result = decode('utf-8', $translator->translate($text)) };
        $self->{babel}{cache}{$from_to}{$text} = $result unless $@;
    }
    #print STDERR " ($@) result = $result\n";

    $text = non_unicode_version(decode('utf-8', $text));
    $result = non_unicode_version($result);

    $args->{body} = defined($result) ? qq|$to_lang for "$text" => "$result"| : "error: $@";
    $self->say($args);

    return $args
}

=item help()

Prints usage.

=cut

sub help {
    return "usage: babel: from to: text to translate\n".
           "  where 'from' and 'to' are two-letters codes of source and destination languages\n".
           "  see http://babelfish.altavista.com/ for the list of supported languages.\n".
           "  example:    babel: fr en: ceci n'est pas une pipe"
}

=item non_unicode_version()

This function returns a printable version of the given string
(with a European value of "printable" C<:-)>. More precisely,
if the string only contains Latin-1 characters, it is returned
decoded from internal Perl format. If the string contains
others characters outside Latin-1, it's converted using
C.

=cut

sub non_unicode_version {
    my $text = shift;
    my $wide = 0;
    ord($_) > 255 and $wide++ for split //, $text;
    return $wide ? unidecode($text) : encode('iso-8859-1', $text)
}

=back


=head1 COMMANDS

=over 4

=item translation

    babel from to: some text to translate

Where C and C are ISO-639 two-letters codes representing the languages.
See L for the list of supported languages.

B

    babel: fr en: ceci n'est pas une pipe
     English for "ceci n'est pas une pipe" => "this is not a pipe"

=item help

    babel help

Shows how to use this bot.

=item version

    babel version

Prints the version of this module and its dependencies.

=back

=head1 DIAGNOSTICS

=over 4

=item Can't create new %s object

B<(F)> Occurs in C. As the message says, we were unable to create
a new object of the given class.

=back

=head1 SEE ALSO

L, L

=head1 AUTHOR

SEbastien Aperghis-Tramoni, [e-mail]

=head1 BUGS

Please report any bugs or feature requests to
C, or through the web interface at
L.
I will be notified, and then you'll automatically be notified
of progress on your bug as I make changes.

=head1 COPYRIGHT & LICENSE

Copyright 2005 SEbastien Aperghis-Tramoni, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of Bot::Babelfish