File Coverage

blib/lib/Locale/TextDomain/OO/Singleton/Lexicon.pm
Criterion Covered Total %
statement 49 49 100.0
branch 16 32 50.0
condition n/a
subroutine 10 10 100.0
pod 4 4 100.0
total 79 95 83.1


line stmt bran cond sub pod time code
1             package Locale::TextDomain::OO::Singleton::Lexicon; ## no critic (TidyCode)
2            
3 36     36   248 use strict;
  36         85  
  36         1031  
4 36     36   184 use warnings;
  36         76  
  36         938  
5 36     36   211 use Carp qw(confess);
  36         77  
  36         1408  
6 36     36   18392 use Moo;
  36         305739  
  36         189  
7 36     36   63760 use MooX::StrictConstructor;
  36         480072  
  36         183  
8 36     36   881897 use namespace::autoclean;
  36         298665  
  36         183  
9            
10             our $VERSION = '1.031';
11            
12             with qw(
13             Locale::TextDomain::OO::Role::Logger
14             MooX::Singleton
15             );
16            
17             has data => (
18             is => 'ro',
19             init_arg => undef,
20             default => sub {
21             my $self = shift;
22             return {
23             # empty lexicon of developer English
24             'i-default::' => {
25             q{} => {
26             nplurals => 2,
27             plural => 'n != 1',
28             plural_code => sub { return shift != 1 },
29             },
30             },
31             };
32             },
33             );
34            
35             sub merge_lexicon {
36 2     2 1 5243 my ( $self, $from1, $from2, $to ) = @_;
37 2 50       7 defined $from1
38             or confess 'Undef is not a lexicon name to merge from';
39 2 50       7 defined $from2
40             or confess 'Undef is not a lexicon name to merge from';
41 2 50       19 exists $self->data->{$from1}
42             or confess qq{Missing lexicon "$from1" to merge from};
43 2 50       13 exists $self->data->{$from2}
44             or confess qq{Missing lexicon "$from2" to merge from};
45 2 50       9 defined $to
46             or confess 'Undef is not a lexicon name to merge to';
47            
48             $self->data->{$to} = {
49 2         12 %{ $self->data->{$from1} },
50 2         4 %{ $self->data->{$from2} },
  2         16  
51             };
52 2 50       56 $self->logger and $self->logger->(
53             qq{Lexicon "$from1", "$from2" merged to "$to".},
54             {
55             object => $self,
56             type => 'debug',
57             event => 'lexicon,merge',
58             },
59             );
60            
61 2         507 return $self;
62             }
63            
64             sub copy_lexicon {
65 1     1 1 4784 my ( $self, $from, $to ) = @_;
66            
67 1 50       6 defined $from
68             or confess 'Undef is not a lexicon name to copy from';
69 1 50       6 exists $self->data->{$from}
70             or confess qq{Missing lexicon "$from" to copy from};
71 1 50       4 defined $to
72             or confess 'Undef is not a lexicon name to copy to';
73            
74             $self->data->{$to} = {
75 1         2 %{ $self->data->{$from} },
  1         7  
76             };
77 1 50       27 $self->logger and $self->logger->(
78             qq{Lexicon "$from" copied to "$to".},
79             {
80             object => $self,
81             type => 'debug',
82             event => 'lexicon,copy',
83             },
84             );
85            
86 1         36 return $self;
87            
88             }
89            
90             sub move_lexicon {
91 2     2 1 6800 my ( $self, $from, $to ) = @_;
92            
93 2 50       9 defined $from
94             or confess 'Undef is not a lexicon name to move from';
95 2 50       11 exists $self->data->{$from}
96             or confess qq{Missing lexicon "$from" to move from};
97 2 50       8 defined $to
98             or confess 'Undef is not a lexicon name to move to';
99 2         12 $self->data->{$to} = delete $self->data->{$from};
100 2 50       53 $self->logger and $self->logger->(
101             qq{Lexicon "$from" moved to "$to".},
102             {
103             object => $self,
104             type => 'debug',
105             event => 'lexicon,move',
106             },
107             );
108            
109 2         389 return $self;
110             }
111            
112             sub delete_lexicon {
113 2     2 1 6920 my ( $self, $name ) = @_;
114            
115 2 50       9 defined $name
116             or confess 'Undef is not a lexicon name to delete';
117 2         11 my $deleted = delete $self->data->{$name};
118 2 50       56 $self->logger and $self->logger->(
119             qq{Lexicon "$name" deleted.},
120             {
121             object => $self,
122             type => 'debug',
123             event => 'lexicon,delete',
124             },
125             );
126            
127 2         402 return $deleted;
128             }
129            
130             __PACKAGE__->meta->make_immutable;
131            
132             1;
133            
134             __END__