Lingua::Translate - Translate text from one language to another

 use Lingua::Translate;

 my $xl8r = Lingua::Translate->new(src => "en",
                                   dest => "de")
     or die "No translation server available for en -> de";

 my $english = "I would like some cigarettes and a box of matches";

 my $german = $xl8r->translate($english); # dies or croaks on error

 # prints "Mein Luftkissenfahrzeug ist voll von den Aalen";
 print $german;

#!/usr/bin/perl -w

package Lingua::Translate;

use strict;
use Carp;

use vars qw($VERSION $defaults);
$VERSION = '0.09';

# I'm not sure whether the "src", "dest" options should be hard coded
# like this.  Perhaps they should just be treated as configuration
# options.  But I think they deserve special treatment.

use I18N::LangTags qw(is_language_tag);

# HACK to do without Unicode::MapUTF8, as it can be very hard to
# install, particularly on older Perls
use vars qw($have_map_utf8);
BEGIN {
    eval "use Unicode::MapUTF8 qw(from_utf8 to_utf8 "
	."utf8_supported_charset);";
    $have_map_utf8 = 1 unless $@;
}

sub new {
    my $class = shift;
    my %options = @_;

    my $self = bless { }, $class;

    croak "Must supply source and destination language"
	unless (defined $options{src} and defined $options{dest});

    is_language_tag($self->{src} = delete $options{src})
	or croak "$self->{src} is not a valid RFC3066 language tag";

    is_language_tag($self->{dest} = delete $options{dest})
	or croak "$self->{dest} is not a valid RFC3066 language tag";

    # allow custom back end
    $self->{back_end} = load_back_end(delete $options{back_end}
				      || $defaults->{back_end});

    # allow encoding
    for my $option ( qw(src_enc dest_enc) ) {
	$self->config($option => delete $options{$option})
	    if (exists $options{$option});
    }

    $self->{back_end_options} = \%options if (keys %options);

    bless $self, $class;
}

# creates the $self->{worker} attribute

sub _create_worker {

    my $self = shift;

    # For flexibility, we allow two methods of configuration; if
    # the module defines &save_config(), then we call that
    # function, then call config(%options), new(), then
    # &restore_config().
    if ( $self->{back_end_options} and
	 my $code_ref = $self->{back_end}->can("save_config") ) {
	my $saved_config = $code_ref->();
	$self->{back_end}->config(%{$self->{back_end_options}});
	$self->{worker} =
	    $self->{back_end}->new( src => $self->{src},
				    dest => $self->{dest} );
	$self->{back_end}->restore_config($saved_config);
    } else {
	# If they don't define that function, then we just call
	# their &new() function with the remaining options as a
	# parameter
	$self->{worker} =
	    $self->{back_end}->new( src => $self->{src},
				    dest => $self->{dest},
				    %{$self->{back_end_options}||{}}
				  );
    }

}

sub translate {
    my ($self, $text) = map { shift } (1..2);

    my $source_encoding = $self->{src_enc} || $defaults->{src_enc};

    # BACK-ENDS MUST DEAL IN utf8
    if ( $have_map_utf8 and lc($source_encoding) ne "utf8" ) {
	$text = to_utf8( -string => $text,
			 -charset => $source_encoding);
    }

    # create a new worker if we need to
    $self->_create_worker unless $self->{worker};

    my $translated;
    for (1..3) {
        eval { $translated = $self->{worker}->translate($text) };
        last unless $@;
    }

    if ( $translated ) {
	my $dest_encoding = $self->{dest_enc} || $defaults->{dest_enc};
	if ( $have_map_utf8 and lc($dest_encoding) ne "utf8" ) {
	    $translated = from_utf8( -string => $translated,
				     -charset => $dest_encoding);
	}
	return $translated;
    } else {
	die "Translation back-end failed; $@";
    }
}

sub load_back_end {
    my ($back_end) = (@_);

    if ( $back_end !~ m/::/ ) {
	$back_end = "Lingua::Translate::$back_end";
    }
    eval "use $back_end;";
    if ( $@ ) {
	croak "Back end $back_end not available; $@";
    }

    return $back_end;
}

sub config {

    my ($self, $target);
    if ( UNIVERSAL::isa($_[0], __PACKAGE__) ) {
	$self = shift;
    } else {
	$self = $defaults ||= {};
    }

    while ( my ($option, $value) = splice @_, 0, 2 ) {

	if ( $option eq "back_end" ) {

	    # the user is selecting a back end.  Load it
	    $self->{back_end} = load_back_end($value);

	    # if there is a worker, kill it - it will be re-created on
	    # the next translate() call.
	    delete $self->{worker};

	} elsif ( $option eq "src_enc" ) {
	    # set the source encoding

	    croak "Charset `$value' not supported by Unicode::MapUTF8"
		if ($have_map_utf8 and
		    not utf8_supported_charset($value));

	    $self->{src_enc} = $value;

	} elsif ( $option eq "dest_enc" ) {

	    croak "Charset `$value' not supported by Unicode::MapUTF8"
		if ($have_map_utf8 and
		    not utf8_supported_charset($value));

	    $self->{dest_enc} = $value;

	} elsif (
		 my $code_ref = UNIVERSAL::can ($self->{back_end},
					       "config")
		) {

	    # call the back-end's configuration function
	    $code_ref->($option => $value);

	} else {
	    croak "Unknown configuration option $option";
	}
    }
}

# extract the default values from the POD
use Pod::Constants
    'CONFIGURATION FUNCTIONS' => sub {
	Pod::Constants::add_hook
		('*item' => sub {
		     my ($varname) = m/(\w+)/;
		     my ($default) = m/The default value is "(.*)"\./;
		     config($varname => $default);
		 }
		);
	Pod::Constants::add_hook
		(
		 '*back' => sub {
		     Pod::Constants::delete_hook('*item');
		     Pod::Constants::delete_hook('*back');
		 }
		);
    };

4;