view release on metacpan or  search on metacpan

lib/Activator/Dictionary.pm  view on Meta::CPAN

package Activator::Dictionary;
use strict;

use Activator::DB;
use Activator::Registry;
use Activator::Exception;
use Activator::Log qw( :levels );
use Exception::Class::TryCatch;
use Data::Dumper;
use base 'Class::StrongSingleton';

=head1 NAME

Activator::Dictionary

=head1 SYNOPSIS

Configure your dictionary using Activator::Registry. See
L<CONFIGURATION OVERVIEW> below.

Using explicit realms and languages:

  use Activator::Dictionary;
  my $dict = Activator::Dictionary->get_dict( $lang );
  my $val  = $dict->lookup( $key, $realm );

Or, configure defaults in Activator::Registry config file:

  'Activator::Registry':
    'Activator::Dictionary':
      default_lang:  'en'
      default_realm: 'my_realm'

Then:

  use Activator::Dictionary;
  my $dict = Activator::Dictionary->get_dict();
  my $val  = $dict->lookup( $key );

=head1 DESCRIPTION

This module provides simple lookup of key/value pairs for intended for
internationalization/localization(I18N/L10N). It is also useful for
separating the progamming of a project from the creation of the text
used by it. The object created by this module is a per-process
singleton that uses dictionary definintions from a simple
space-delimeted file or database table(s). The dictionary is
completely maintained in memory and loads realms and languages
dynamically on an as-needed basis, so this module may not be
appropriate for extremely large lexicons or for projects that create
large numbers of program instances. That being said, it can be
relatively memory efficient when used for a single language deployment
in an application that provides multiple language support.

An C<Activator::Dictionary> object can have multiple realms: that is, you
could have a 'web' dictionary for the website text, an 'error'
dictionary for backend job messages, and any number of other realms
needed for your application. This allows you to separate the
translatable texts from each other so that, for example, the web
frontend of your application could give a user friendly message using
the 'web' realm, and the backend could use the 'error' realm to log
something much more useful to a technician.

Note that there can be great amounts of complexity localizing language
within an application. This module is for the simple cases, where you
just have key/value lookups. If you need complex conjugations, object
sensitive pluralization, you should look into the existing
L<Locale::Maketext>, or the upcoming L<Activator::Lexicon> module. It
is highly recommended that you read
L<http://search.cpan.org/dist/Locale-Maketext/lib/Locale/Maketext/TPJ13.pod>
before making a decision as to which localization method your
application needs.

=head1 CONFIGURATION OVERVIEW

  'Activator::Registry':          # uses Activator::Registry
    'Activator::Dictionary':
      default_lang:  'en'         # default language for get_dict()*
      default_realm: 'my_realm'   # default realm for lookup()*
      fail_mode:     [ die ]      # die instead of returning undef
                                    for lookup failures*
      dict_files:    '<path>'     # path to definition files**
      dict_tables:   [ t1, t2 ]   # database definition table(s)**
      db_alias:      'db'         # Activator::DB alias to use***

   * optional
  ** either dict_files OR dict_tables MUST be defined
 *** db_alias required when dict_tables defined

=head1 DICTIONARY FILE CONFIGURATION

Configure your dictionary in your project registry:

  'Activator::Registry':
    'Activator::Dictionary':
      dict_files:         '/path/to/definitions/files'

Then create dictionary definition files for realms in the dictionary
path as such:

 <dict_files path>/<lang>/<realm>.dict

=head2 Dictionary File Format

To create a dictionary file, create a file named C<E<lt>realmE<gt>.dict>

lib/Activator/Dictionary.pm  view on Meta::CPAN

	    Activator::Exception::Dictionary->throw( 'init_lang', 'failed', $e );
	}

    }

    $self->{cur_lang} = $lang;

    return $self;
}

=head2 new( $lang )

Creates a dictionary object. Not very useful, as all it does is create
an uninitialized instance of an Activator::Dictionary object.

=cut

# Contstructor. Implements singleton.
sub new {
    my ( $pkg, $lang ) = @_;

    my $self = bless( { LOG_LEVEL_FOR_FILE_LOAD => 'WARN' }, $pkg);

    $self->_init_StrongSingleton();

    return $self;
}

sub _init_config {
    my ($self) = @_;

    # old config format
    my $config = Activator::Registry->get('Activator::Dictionary');
    if ( !$config ) {
	# new format
	$config = Activator::Registry->get('Activator->Dictionary');
    }


    $self->{config}->{default_realm} = $config->{default_realm} || 'default';
    $self->{config}->{default_lang}  = $config->{default_lang} || 'en';
    $self->{config}->{dict_tables}   = $config->{dict_tables};
    $self->{config}->{dict_files}    = $config->{dict_files};
    $self->{config}->{db_alias}      = $config->{db_alias};
    $self->{config}->{fail_mode}     = $config->{fail_mode};

    if ( !( defined( $self->{config}->{dict_files} ) ||
	    defined( $self->{config}->{dict_tables} )
	  ) ) {
	Activator::Exception::Dictionary->throw( 'tables_or_files', 'undefined' );
    }

    if ( defined( $self->{config}->{dict_tables} ) &&
	 !defined( $self->{config}->{db_alias} ) ) {
	Activator::Exception::Dictionary->throw( 'db_alias', 'missing' );
    }
}

sub _init_lang {
    my ($self, $lang) = @_;
    my $processed = 0;

    # import all the realms for this language from the db
    if ( defined( $self->{config}->{dict_tables} ) ) {
	my ( $sql, $rows, $row, $col, $realm, $key );
	foreach my $table ( @{ $self->{config}->{dict_tables} } ) {
	    $sql = "SELECT * FROM $table WHERE lang = ?";
	    try eval {
		$rows = Activator::DB->getall_hashrefs( $sql, [ $lang ], connect => 'def' );
	    };
	    if ( catch my $e ) {
		Activator::Exception::Dictionary->throw( 'dict_tables',
							 'misconfigured',
							 "Activator::Dictionary caught: \n$e" );
	    }
	    foreach $row ( @$rows ) {
		foreach $col ( keys %$row ) {
		    if ( $col !~/_id$|realm|lang|key_prefix|last_modified/ ) {
			$realm = $row->{realm};
			$key   = "$row->{key_prefix}.$col";
			if ( exists( $self->{ $lang }->{ $realm }->{ $key } ) ) {
			    local $Log::Log4perl::caller_depth;
			    $Log::Log4perl::caller_depth += 3;
			    WARN( "dictionary table $table redefines value for realm '$realm' key_prefix '$row->{key_prefix}' column '$col'");
			}
			$self->{ $lang }->{ $realm }->{ $key } =
			  $row->{ $col };
		    }
		}
	    }
	    $processed = 1;
	}
    }

    # import all the realms for this lang from files
    if ( defined( $self->{config}->{dict_files} ) ) {
	my $dir_loc = $self->{config}->{dict_files};
	$dir_loc =~ s|/$||;
	$dir_loc .= "/$lang";

	if (!opendir( DIR, $dir_loc ) ) {
	    local $Log::Log4perl::caller_depth;
	    $Log::Log4perl::caller_depth += 3;

	    # This message could be annoying in some situations, so
	    # allow changing the log level for just this one.
	    my $msg = "Couldn't load dictionary from file for $lang from $dir_loc";
	    my $level = $self->{LOG_LEVEL_FOR_FILE_LOAD};
	    if ( $level =~ /FATAL|ERROR|WARN|INFO|DEBUG|TRACE/ ) {
		no strict 'refs';
		&$level( $msg );
	    }
	    else {
		WARN( $msg );
	    }
	}
	else {

	    my @files = grep { /^[^\.]/ && -f "$dir_loc/$_" } readdir(DIR);
	    closedir DIR;
	    my ($file, $realm, $key, $value);
	    foreach $file ( @files ) {
		if ( $file !~ /.dict$/ ) {
		    WARN("Non-dictionary file '$file' found in lang dir $dir_loc");
		    next;
		}

		open DICT, "<$dir_loc/$file" ||
		  Activator::Exception::Dictionary->throw('dict_file',
							  'unreadable',
							  "$dir_loc/$file" );
		$file =~ /(.+)\.dict$/;
		$realm = $1;

		while (<DICT>) {
		    chomp;
		    next if /^\s*$/;
		    next if /^\s*#/;
		    s/^\s+//;
		    s/\s+$//;
		    ($key, $value) = split /\s+/, $_, 2;
		    $value =~ s/("$)//;
		    if ( $1 ) {
			$value =~ s/^"//;
		    }
		    $self->{ $lang }->{ $realm }->{ $key } = $value;
		}
		close DICT;
		$processed = 1;
	    }
	}
    }
    return $processed;
}

=head1 SEE ALSO

L<Activator::Log>, L<Activator::Exception>, L<Activator::DB>,
L<Exception::Class::TryCatch>, L<Class::StrongSingleton>

=head1 AUTHOR

Karim A. Nassar

=head1 COPYRIGHT

Copyright (c) 2007 Karim A. Nassar <karim.nassar@acm.org>

You may distribute under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl README file.

=cut

1;