view release on metacpan or  search on metacpan

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

    'Activator::Dictionary':
      dict_tables: [ table1, table2 ]
      db_alias: 'Activator::DB alias to use'

Note that you can use dict_files and dict_tables in any combination.

=head1 RESERVED WORDS FOR REALMS

When naming realms, follow these guidelines:

=over

=item *

Use more than 2 characters, to not confuse realms with languages.

=item *

Do not use the word C<config> for a realm

=back

TODO: enforce this guidance programatically

=head1 LOOKUP FEATURES

=head2 Using a Default Realm and/or Language

In some applications, it is inconvenient to have to pass the realm as
an argument for every lookup call when there is one common realm that
is nearly always used. You can define a default language and/or realm
as such:

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

Not passing the C<$lang> or C<$realm> arguments will then use the registry
key(s):

  my $dict = Activator::Dictionary->get_dict();  # sets lang to en
  $dict->lookup( $key );                         # returns 'my_realm' value

=head2 Database Dictionary Lookups

When using database dictionary definitions, you must define the target
field you are interested in with dot notation:

  $dict->lookup( $key_prefix );        # fails
  $dict->lookup( "$key_prefix.$col" ); # succeeds

For this reason, it is required that you not use period in the
C<key_prefix> column.

=head2 Failure Mode

Instead of returning undef for non-existent keys, you can configure
this module to fail via one or more of these methods:

  die     : throws Activator::Exception::Dictionary('key', 'missing')
  key     : returns the requested key itself
  ''      : returns empty string
  <lang>  : return the value for <lang> in the requested realm
  <realm> : return the value for <realm>

Examples:

  $db->lookup( $key, $realm1 );  # value does not exist

  fail_mode: [ realm2, de, key ]

   return value for $key in realm2 if it exists
   return value for $key in realm1 in german if it exists
   return $key

  fail_mode: [ realm2, die ]

   return value for $key in realm2 if it exists
   throw Activator::Exception::Dictionary

  fail_mode: [ realm2, realm3 ]

   return value for $key in realm2 if it exists
   return value for $key in realm3 if it exists
   return undef (fallback to default failure mode)

  fail_mode: [ '' ]

   return empty string

=head1 DISABLING LOAD WARNING

When loading dictionary files, you may sometimes see:

  [WARN] Couldn't load dictionary from file for <lang>

If you are using files for one language, and the DB for another, this
could get really annoying since you KNOW THIS TO BE TRUE. The
workaround is to set the log level for this message an alternate level
of FATAL, ERROR, WARN, INFO, DEBUG, or TRACE. For example:

  $dict->{LOG_LEVEL_FOR_FILE_LOAD} = 'INFO';

=head1 METHODS

=head2 lookup($key, $realm)

OO Usage:

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

Static Usage:

  Activator::Dictionary->use_lang( $lang );
  Activator::Dictionary->lookup( $key, $realm );
  Activator::Dictionary->lookup( $key2, $realm );

Returns the value for C<$key> in C<$realm>. Returns C<undef> when the
key does not exist, but you can configure this module to do something
different (see L<Failure Mode> below). If realm does not exist, throws
C<Activator::Exception::Dictionary> no matter the failure mode.

=cut

sub lookup {
    my ($pkg, $key, $realm ) = @_;
    my $self = &get_dict( $pkg );

    my $lang = $self->{cur_lang};

    $realm ||= $self->{config}->{default_realm};

    if ( !defined( $key ) ) {
	Activator::Exception::Dictionary->throw( 'key', 'undefined');
    }

    if ( !exists( $self->{ $lang }->{ $realm } ) ) {
	Activator::Exception::Dictionary->throw( 'realm', 'undefined', $realm);
    }

    if ( exists( $self->{ $lang }->{ $realm }->{ $key } ) ) {
	my $ret = $self->{ $lang }->{ $realm }->{ $key };
	DEBUG( "Found key '$key'. value: $ret");
	return $ret;
    }

    # At this point, there was no value for the given key in the given
    # realm. Honor configured failure mode.
    DEBUG( "Didn't find key '$key'.");
    if ( !exists( $self->{config}->{fail_mode} ) ) {
	DEBUG( "No fail_mode defined. Returning undef");
	return;
    }

    if ( !defined( $self->{config}->{fail_mode} ) ) {
	DEBUG( "No fail_mode defined. Returning undef");
	return;
    }

    my %tried = ( $lang => 1, $realm => 1 );
    my @modes = @{ $self->{config}->{fail_mode} };
    DEBUG( "Trying modes: ". Dumper( \@modes ) );
    foreach my $mode ( @modes ) {
	next if $tried{ $mode };
	$tried{ $mode } = 1;
	DEBUG( "Trying fail_mode '$mode'");
	if ( $mode eq 'die' ) {
	    DEBUG( "die means throw exception");
	    Activator::Exception::Dictionary->throw('key', 'missing');
	}

	if ( $mode eq '' ) {
	    DEBUG( "returning empty string");
	    return '';
	}

	if ( $mode eq 'key' ) {
	    DEBUG( "returning key '$key'");
	    return $key;
	}

	# check realms
	if ( grep /^$mode$/, keys( %{ $self->{ $lang } } ) ) {
	    if ( !exists( $self->{ $lang }->{ $mode }->{ $key } ) ) {
		next;
	    }
	    DEBUG( "Found entry for realm '$mode'");
	    return $self->{ $lang }->{ $mode }->{ $key };
	}

	# check langs
	if ( grep /^$mode$/, keys( %$self ) ) {
	    if ( !exists( $self->{ $mode }->{ $realm } ) ) {
		next;
	    }
	    if ( !exists( $self->{ $mode }->{ $realm }->{ $key } ) ) {
		next;
	    }
	    DEBUG( "Found entry for lang '$mode'");
	    return $self->{ $mode }->{ $realm }->{ $key };
	}
    }
    DEBUG( "No valid fail_mode found. Returning undef");
    return;
}

=head2 get_dict( $lang )

Returns a reference to the Activator::Dictionary object. Sets all
future lookups to use the $lang passed in. If $lang is not passed in,
uses 'Activator::Dictionary' registry value for 'default_lang'. If
$lang cannot be determined, throws Activator::Exception::Dictionary.

=cut

sub get_dict {
    my ($pkg, $lang ) = @_;
    my $self = &new( @_ );

    # first call
    if( !exists $self->{config} ) {
	$self->_init_config();
    }

    # first call for $lang
    $lang ||= $self->{cur_lang} || $self->{config}->{default_lang};

    if ( !$lang ) {
	Activator::Exception::Dictionary->throw( 'lang', 'undefined' );
    }

    if( !exists $self->{ $lang } ) {
	try eval {
	    $self->_init_lang( $lang );
	};
	if ( catch my $e ) {
	    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;