File Coverage

blib/lib/Data/Phrasebook/Loader/JSON.pm

Criterion	Covered	Total	%
statement	64	64	100.0
branch	36	38	94.7
condition	11	12	91.6
subroutine	11	11	100.0
pod	5	5	100.0
total	127	130	97.6

package Data::Phrasebook::Loader::JSON;

use strict;
use warnings FATAL => 'all';

our $VERSION = '0.02';

#--------------------------------------------------------------------------

use base qw( Data::Phrasebook::Loader::Base Data::Phrasebook::Debug );

use Carp qw( croak );
use File::Slurp;
use JSON::XS;

#--------------------------------------------------------------------------

=head1 NAME

Data::Phrasebook::Loader::JSON - Absract your phrases with JSON.

=head1 SYNOPSIS

    use Data::Phrasebook;

    my $q = Data::Phrasebook->new(
        class  => 'Fnerk',
        loader => 'JSON',
        file   => 'phrases.json',
    );

    $q->delimiters( qr{ \[% \s* (\w+) \s* %\] }x );
    my $phrase = $q->fetch($keyword);

=head1 DESCRIPTION

This class loader implements phrasebook patterns using JSON.

Phrases can be contained within one or more dictionaries, with each phrase
accessible via a unique key. Phrases may contain placeholders, please see
L for an explanation of how to use these. Groups of phrases
are kept in a dictionary. In this implementation a single file is one
complete dictionary.

An example JSON file:

  {
    "dictionary1": { "key1": "value1", "key2": "value2" },
    "dictionary2": { "key3": "value3", "key4": "value4" }
  }

Within the phrase text placeholders can be used, which are then replaced with
the appropriate values once the get() method is called. The default style of
placeholders can be altered using the delimiters() method.

=head1 INHERITANCE

L inherits from the base class
L.
See that module for other available methods and documentation.

=head1 METHODS

=head2 load

Given a C, load it. C must contain a JSON map.

   $loader->load( $file, @dict );

This method is used internally by L's
C method, to initialise the data store.

It must take a C (be it a scalar, or something more complex)
and return a handle. The C is optional, should you wish to use the
dictionary support.

=cut

sub load {
    my ($class, $file, @dict) = @_;
    croak "No file given as argument!"          unless defined $file;
    croak "Unable to read file [$file]!"        unless -r $file;
    my $json = read_file( $file );
    croak "No data in given JSON file [$file]"  unless $json;
    my $data = decode_json($json);
    croak "Badly formatted JSON file [$file]"   unless $data;
	$class->{json} = $data;

    # what sections are we using?
    my $key = $class->{defaultname} || ($class->dicts)[0];
    $class->{default} = ($key ? $class->{json}->{$key}
                              : $class->{json});

    $class->{dict} = [];
    $class->{dict} = [$class->{defaultname}] if $class->{defaultname};
    $class->{dict} = (ref $dict[0] ? $dict[0] : [@dict]) if scalar @dict;
}

=head2 get

Returns the phrase stored in the phrasebook, for a given keyword.

   my $value = $loader->get( $key );

If one or more named dictionaries have been previously selected, they will be
searched in order, followed by the default dictionary. The first hit on
C will be returned, otherwise C is returned.

=cut

sub get {
	my ($class,$key) = @_;
	return	unless($key);
	return	unless($class->{json});

    my @dicts = (ref $class->{dict} ? @{$class->{dict}} : ());

    foreach ( @dicts ) {
        return $class->{json}->{$_}->{$key}
            if exists $class->{json}->{$_}
            and exists $class->{json}->{$_}->{$key};
    }

    return $class->{default}->{$key}
        if ref $class->{default} eq 'HASH'
        and exists $class->{default}->{$key};

    return;
}

=head2 dicts

Returns the list of dictionaries available.

   my @dicts = $loader->dicts();

This is the list of all dictionaries available in the source file. If multiple
dictionaries are not being used, then an empty list will be returned.

=cut

sub dicts {
    my $class = shift;

    my @keys = keys %{$class->{json}};
    if ( scalar @keys ==
            scalar grep {ref $_ eq 'HASH'} values %{$class->{json}} ) {
        # data source looks like it has multiple dictionaries
        return (sort @keys);
    }

    return ();
}

=head2 keywords

Returns the list of keywords available. List is lexically sorted.

 my @keywords = $loader->keywords( $dict );

If one or more named dictionaries have been previously selected, they will be
farmed for keywords, followed by the default dictionary.

The C argument is optional, and may be used to override the search to a
single named dictionary, or a list of dictionaries if passed by reference,
plus the default dictionary of course.

To find all available keywords in all available dictionaries, use the
following:

 $loader->keywords( [ $loader->dicts ] );

=cut

sub keywords {
    my ($class, $dict) = @_;
    my (%keywords, @dicts);

    @dicts = ( (not $dict) ? (ref $class->{dict} ? @{$class->{dict}} : ())
             : (ref $dict) ? @$dict : ($dict) );

    foreach my $d (@dicts) {
        next unless
            exists $class->{json}->{$d}
            and ref $class->{json}->{$d} eq 'HASH';
        map { $keywords{$_} = 1 } keys %{$class->{json}->{$d}};
    }

    if (ref $class->{default} eq 'HASH') {
        map { $keywords{$_} = 1 } keys %{$class->{default}};
    }

    my @keywords = sort keys %keywords;
    return @keywords;
}

=head2 set_default

If a requested phrase is not found in the named dictionary an attempt is made
to find it in the I dictionary. L loaders normally
use the first dictionary in the phrasebook as the default, but as mentioned in
L this does not make sense because the dictionaries in
JSON phrasebooks are not ordered.

To override the automatically selected default dictionary use this method, and
pass it a C. This value is only reset at phrasebook
load time, so you'll probably need to trigger a reload:

 $q->loader->set_default( $default_dictionary_name );
 $q->loader->load( $file );

To reset the loader's behaviour to automatic default dictionary selection,
pass this method an undefined value, and then reload.

=cut

sub set_default {
    $_[0]->{defaultname} = $_[1];
}

1;

__END__