/
Fix.pm
218 lines (160 loc) · 5.2 KB
/
Fix.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
package Catmandu::Fix::Loader;
use Catmandu::Sane;
use Catmandu::Util qw(:is require_package read_file);
my @fixes;
my @stack;
sub load_fixes {
@fixes = ();
@stack = ();
for my $fix (@{$_[0]}) {
if (is_able($fix, 'fix')) {
push @fixes, $fix;
} elsif (is_string($fix)) {
if (-r $fix) {
$fix = read_file($fix);
}
eval "package Catmandu::Fix::Loader::Env;$fix;1" or confess $@;
}
}
confess "if without end" if @stack;
[@fixes];
}
sub _add_fix {
my ($fix, @args) = @_;
if ($fix eq 'end') {
$fix = pop @stack || confess "end without if";
if (@stack) {
push @{$stack[-1]->fixes}, $fix;
} else {
push @fixes, $fix;
}
}
elsif ($fix =~ s/^if_//) {
$fix = require_package($fix, 'Catmandu::FixCondition')->new(@args);
push @stack, $fix;
}
elsif ($fix =~ s/^unless_//) {
$fix = require_package($fix, 'Catmandu::FixCondition')->new(@args);
$fix->invert(1);
push @stack, $fix;
}
else {
$fix = require_package($fix, 'Catmandu::Fix')->new(@args);
if (@stack) {
push @{$stack[-1]->fixes}, $fix;
} else {
push @fixes, $fix;
}
}
}
package Catmandu::Fix::Loader::Env;
use strict;
use warnings;
sub AUTOLOAD {
my ($fix) = our $AUTOLOAD =~ /::(\w+)$/;
my $sub = sub { Catmandu::Fix::Loader::_add_fix($fix, @_); return };
{ no strict 'refs'; *$AUTOLOAD = $sub };
$sub->(@_);
}
sub DESTROY {}
package Catmandu::Fix;
use Catmandu::Sane;
use Catmandu::Util qw(:is :check);
use Moo;
has fixes => (
is => 'ro',
required => 1,
coerce => sub {
Catmandu::Fix::Loader::load_fixes(check_array_ref($_[0]));
},
);
sub fix {
my ($self, $data) = @_;
my $fixes = $self->fixes;
if (is_hash_ref($data)) {
for my $fix (@$fixes) {
$data = $fix->fix($data);
}
return $data;
}
if (is_array_ref($data)) {
return [map {
my $d = $_;
$d = $_->fix($d) for @$fixes;
$d;
} @$data];
}
if (is_code_ref($data)) {
return sub {
my $d = $data->();
defined($d) || return;
$d = $_->fix($d) for @$fixes;
$d;
};
}
if (is_invocant($data)) {
return $data->map(sub {
my $d = $_[0];
$d = $_->fix($d) for @$fixes;
$d;
});
}
return;
}
=head1 NAME
Catmandu::Fix - a Catmandu class used for data crunching
=head1 SYNOPSIS
use Catmandu::Fix;
my $fixer = Catmandu::Fix->new(fixes => ['upcase("job")','remove_field("test")']);
or
my $fixer = Catmandu::Fix->new(fixes => ['fix_file.txt']);
my $arr = $fixer->fix([ ... ]);
my $hash = $fixer->fix({ ... });
my $it = Catmandu::Importer::YAML(file => '...');
$fixer->fix($it)->each(sub {
...
});
=head1 DESCRIPTION
Catmandu::Fix-es can be use for easy data manipulation by non programmers. Using a
small Perl DSL language end-users can use Fix routines to manipulate data objects.
A plain text file of fixes can be created to specify all the routines needed to
tranform the data into the desired format.
=head1 PATHS
All the Fix routines in Catmandu::Fix use a TT2 type reference to point to values
in a Perl Hash. E.g. 'foo.2.bar' is a key 'bar' which is the 3-rd value of the
key 'foo'.
A special case is when you want to point to all items in an array. In this case
the wildcard '*' can be used. E.g. 'foo.*' points to all the items in the 'foo'
array.
For array values there are special wildcards available:
* $append - Add a new item at the end of an array
* $prepend - Add a new item at the start of an array
* $first - Syntactic sugar for index '0' (the head of the array)
* $last - Syntactic sugar for index '-1' (the tail of the array)
E.g.
# Create { mods => { titleInfo => [ { 'title' => 'a title' }] } };
add_field('mods.titleInfo.$append.title', 'a title');
# Create { mods => { titleInfo => [ { 'title' => 'a title' } , { 'title' => 'another title' }] } };
add_field('mods.titleInfo.$append.title', 'another title');
# Create { mods => { titleInfo => [ { 'title' => 'foo' } , { 'title' => 'another title' }] } };
add_field('mods.titleInfo.$first.title', 'foo');
# Create { mods => { titleInfo => [ { 'title' => 'foo' } , { 'title' => 'bar' }] } };
add_field('mods.titleInfo.$last.title', 'bar');
=head1 METHODS
=head2 new(fixes => [ FIX , ...])
Create a new Catmandu::Fix which will execute every FIX into a consecutive order. A
FIX can be the name of a Catmandu::Fix::* routine or the path to a plain text file
containing all the fixes to be executed.
=head2 fix(HASH)
Execute all the fixes on a HASH. Returns the fixed HASH.
=head2 fix(ARRAY)
Execute all the fixes on every element in the ARRAY. Returns an ARRAY of fixes.
=head2 fix(Catmandu::Iterator)
Execute all the fixes on every item in an Catmandu::Iterator. Returns a (lazy) iterator
on all the fixes.
=head2 fix(sub {})
Executes all the fixes on a generator function. Returns a new generator with fixed data.
=head1 SEE ALSO
L<Catmandu::Fix::add_field>
=cut
1;