File Coverage

blib/lib/Catmandu/Fix/wd_language.pm
Criterion Covered Total %
statement 25 32 78.1
branch 8 18 44.4
condition 1 3 33.3
subroutine 5 5 100.0
pod 0 1 0.0
total 39 59 66.1


line stmt bran cond sub pod time code
1             package Catmandu::Fix::wd_language;
2             #ABSTRACT: Limit string values in a Wikidata entity record to a selected language
3             our $VERSION = '0.06'; #VERSION
4 2     2   31902 use Catmandu::Sane;
  2         120692  
  2         17  
5 2     2   582 use Moo;
  2         4  
  2         11  
6              
7             with 'Catmandu::Fix::Base';
8              
9             has language => (is => 'ro', required => 1);
10             has force => (is => 'ro');
11              
12             around BUILDARGS => sub {
13             my ($orig, $class, $language) = @_;
14             $orig->($class, { language => $language });
15             };
16              
17             sub emit {
18 1     1 0 5636 my ($self, $fixer) = @_;
19              
20 1         5 my $language = $self->language;
21 1         18 my $var = $fixer->var;
22 1     1   11 my $code = $fixer->capture( sub { _fix_code($_[0],$language) } );
  1         811  
23              
24 1         75 return "${code}->(${var})";
25             }
26              
27             sub _fix_code {
28 1     1   2 my ($data, $language) = @_;
29              
30 1         2 foreach my $what (qw(labels descriptions)) {
31 2 100       7 next unless exists $data->{$what};
32 1         2 my $field = $data->{$what};
33 1 50       4 if (ref $field) { # keep simple strings as given
34 1         2 my $string = $field->{$language};
35 1 50       3 if (defined $string) {
36 1 50       7 $data->{$what} = ref $string ? $string->{value} : $string;
37             } else {
38 0         0 delete $data->{$what};
39             }
40             }
41             }
42              
43 1 50       6 if (exists $data->{labels}) {
44 1         3 $data->{label} = delete $data->{labels};
45             }
46              
47 1 50       5 if (exists $data->{descriptions}) {
48 0         0 $data->{description} = delete $data->{descriptions};
49             }
50              
51 1 50 33     4 if (ref $data->{aliases} and ref $data->{aliases} eq 'HASH') {
52 0         0 my $aliases = $data->{aliases}->{$language};
53 0 0       0 if (defined $aliases) {
54 0 0       0 $data->{aliases} = [
55 0         0 map { ref $_ ? $_->{value} : $_ } @$aliases
56             ];
57             } else {
58 0         0 $data->{aliases} = [ ];
59             }
60             }
61              
62             # TODO: only delete of string of requested language was found (or force)
63              
64 1         18 $data;
65             }
66              
67             1;
68              
69             __END__