File Coverage

blib/lib/App/RecordStream/Operation/annotate.pm
Criterion Covered Total %
statement 152 173 87.8
branch 13 16 81.2
condition 6 9 66.6
subroutine 28 37 75.6
pod 0 6 0.0
total 199 241 82.5


line stmt bran cond sub pod time code
1             package App::RecordStream::Operation::annotate;
2              
3             our $VERSION = "4.0.24";
4              
5 2     2   1006 use strict;
  2         5  
  2         70  
6              
7 2     2   11 use base qw(App::RecordStream::Operation);
  2         4  
  2         445  
8              
9 2     2   633 use App::RecordStream::Executor::Getopt;
  2         6  
  2         66  
10 2     2   13 use App::RecordStream::Executor;
  2         5  
  2         50  
11 2     2   14 use App::RecordStream::Record;
  2         5  
  2         2200  
12              
13             sub init {
14 4     4 0 10 my $this = shift;
15 4         9 my $args = shift;
16              
17 4         26 my $key_groups = App::RecordStream::KeyGroups->new();
18              
19 4         33 my $executor_options = App::RecordStream::Executor::Getopt->new();
20             my $spec = {
21             $executor_options->arguments(),
22 4     4   4063 'keys|k=s' => sub { $key_groups->add_groups($_[1]); },
23 4         17 };
24              
25 4         29 $this->parse_options($args, $spec, ['bundling']);
26              
27 4         23 my $expression = $executor_options->get_string($args);
28 4         44 my $executor = App::RecordStream::Executor->new(<<" CODE");
29             $expression
30             ; # Safe from a trailing comment in \$expression
31             \$r
32             CODE
33              
34 4 50       19 if ( ! $key_groups->has_any_group() ) {
35 0         0 die "Must specify at least one --key, maybe you want recs-xform instead?\n";
36             }
37              
38 4         12 $this->{'EXECUTOR'} = $executor;
39 4         12 $this->{'KEYGROUP'} = $key_groups;
40 4         79 $this->{'ANNOTATIONS'} = {};
41             }
42              
43             sub accept_record {
44 19     19 0 34 my $this = shift;
45 19         28 my $record = shift;
46              
47 19         57 my $specs = $this->{'KEYGROUP'}->get_keyspecs_for_record($record);
48              
49 19         31 my @values;
50 19         45 foreach my $key (sort @$specs) {
51 19         32 my $value = ${$record->guess_key_from_spec($key)};
  19         49  
52 19         46 push @values, $value;
53             }
54              
55             # Join keys with the ASCII record separator character (30)
56 19         54 my $synthetic_key = join(chr(30), @values);
57              
58 19 100       51 if ( exists $this->{'ANNOTATIONS'}->{$synthetic_key} ) {
59 12         36 $this->apply_annotation($synthetic_key, $record);
60 12         45 $this->push_record($record);
61 12         57 return 1;
62             }
63              
64 7         13 my $executor = $this->{'EXECUTOR'};
65              
66 7         14 my $store = {};
67              
68 7         25 my $hash = create_recorder({$record->as_hash()}, $store);
69              
70 7         40 my $new_record = App::RecordStream::Record->new($hash);
71              
72 7         27 my $returned_record = $executor->execute_code($new_record);
73              
74 7         25 $this->{'ANNOTATIONS'}->{$synthetic_key} = $store;
75              
76 7         35 $this->push_record($returned_record);
77              
78 7         61 return 1;
79             }
80              
81             sub apply_annotation {
82 12     12 0 18 my $this = shift;
83 12         24 my $annotation_key = shift;
84 12         17 my $record = shift;
85              
86 12         24 my $stores = $this->{'ANNOTATIONS'}->{$annotation_key};
87              
88 12         35 foreach my $keyspec (keys %$stores) {
89 16         29 my $value = $stores->{$keyspec};
90 16         21 ${$record->guess_key_from_spec($keyspec)} = $value;
  16         39  
91             }
92             }
93              
94             sub add_help_types {
95 4     4 0 9 my $this = shift;
96 4         21 $this->use_help_type('snippet');
97 4         14 $this->use_help_type('keyspecs');
98 4         12 $this->use_help_type('keygroups');
99 4         12 $this->use_help_type('keys');
100             }
101              
102             sub usage {
103 0     0 0 0 my $this = shift;
104              
105 0         0 my $options = [
106             App::RecordStream::Executor::options_help(),
107             ['keys', 'Keys to match records by, maybe specified multiple times, may be a keygroup or keyspec'],
108             ];
109              
110 0         0 my $args_string = $this->options_string($options);
111              
112 0         0 return <
113             Usage: recs-annotate []
114             __FORMAT_TEXT__
115             is evaluated as perl on each record of input (or records from
116             ) with \$r set to a App::RecordStream::Record object and \$line set
117             to the current line number (starting at 1). Records are analyzed for
118             changes, those changes are applied to each successive record that matches
119             --keys
120              
121             Only use this script if you have --keys fields that are repeated, otherwise
122             recs-xform will be faster
123             __FORMAT_TEXT__
124              
125             IMPORTANT SNIPPET NOTE
126             __FORMAT_TEXT__
127             Because of the way annotations are recorded, you cannot use UNSHIFT or
128             SPLICE on array refs that already exist in the record you are modifiying.
129             Additionally, deletes, removes, unshifts, and other 'removing' operations
130             will not apply to later records. If you need this behavior, consider using
131             recs-xform
132             __FORMAT_TEXT__
133              
134             $args_string
135              
136             Examples:
137             # Annotate records with IPs with hostnames, only doing lookup once
138             ... | recs-annotate --key ip '{{hostname}} = `host {{ip}}`'
139              
140             # Record md5sums of files
141             ... | recs-annotate --key filename '{{md5}} = `md5sum {{filename}}`'
142              
143             # Add url contents to records
144             ... | recs-annotate --key url '{{contents}} = `curl {{url}}`'
145             USAGE
146             }
147              
148             sub create_recorder {
149 19     19 0 33 my $data = shift;
150 19         25 my $store = shift;
151 19         28 my $current_keyspec = shift;
152              
153             #Nothing todo, what happened here?
154 19 50 66     55 if ( ref($data) ne 'HASH' && ref($data) ne 'ARRAY' ) {
155 0         0 warn "create_recorder called on non HASH or ARRAY data!\n";
156 0         0 return $data;
157             }
158              
159 19         51 my $recorder = KeyspecRecorder->new($current_keyspec, $store);
160              
161 19         29 my $spec = '';
162 19 100       41 if ( defined $current_keyspec ) {
163 12         21 $spec = $current_keyspec . '/';
164             }
165              
166 19 100       39 if ( ref($data) eq 'HASH' ) {
167 13         19 my %new_hash;
168 13         42 foreach my $key (keys %$data) {
169 43         74 my $value = $data->{$key};
170 43         59 my $new_value = $value;
171 43 100 100     154 if ( ref($value) eq 'HASH' || ref($value) eq 'ARRAY' ) {
172 12         35 my $new_data = create_recorder($value, $store, $spec . $key);
173 12         25 $new_value = $new_data;
174             }
175 43         84 $new_hash{$key} = $new_value;
176             }
177              
178 13         24 my %hash;
179 13         54 my $recorder = tie %hash, 'RecordingHash', \%new_hash, $recorder;
180              
181 13         34 return \%hash;
182             }
183             else { #Must be an array
184 6         11 my @new_array;
185 6         9 my $index = 0;
186 6         13 foreach my $value (@$data) {
187 6         9 my $new_value = $value;
188 6 50 33     23 if ( ref($value) eq 'HASH' || ref($value) eq 'ARRAY' ) {
189 0         0 my $new_data = create_recorder($value, $store, $spec . '#' . $index);
190 0         0 $new_value = $new_data;
191             }
192              
193 6         13 push @new_array, $new_value;
194 6         12 $index++;
195             }
196              
197 6         10 my @array;
198 6         26 my $recorder = tie @array, 'RecordingArray', \@new_array, $recorder;
199              
200 6         16 return \@array;
201             }
202              
203             }
204              
205              
206             1;
207              
208             package KeyspecRecorder;
209              
210             sub new {
211 19     19   34 my $class = shift;
212 19         26 my $current_keyspec = shift;
213 19         25 my $store = shift;
214              
215 19         56 my $this = bless {
216             KEYSPEC => $current_keyspec,
217             STORES => $store,
218             }, $class;
219              
220 19         39 return $this;
221             }
222              
223             sub get_stores {
224 8     8   18 my $this = shift;
225 8         110 return $this->{'STORES'};
226             }
227              
228             sub get_keyspec {
229 14     14   27 my $this = shift;
230 14         60 return $this->{'KEYSPEC'};
231             }
232              
233             sub add_store {
234 8     8   18 my $this = shift;
235 8         15 my $sub_spec = shift;
236 8         15 my $value = shift;
237              
238 8         15 my $spec = $sub_spec;
239 8 100       18 if ( defined $this->get_keyspec() ) {
240 6         14 $spec = $this->get_keyspec() . '/' . $sub_spec;
241             }
242              
243 8         23 $this->get_stores()->{$spec} = $value;
244             }
245              
246             1;
247              
248             package RecordingHash;
249              
250 2     2   719 use Tie::Hash;
  2         1417  
  2         51  
251 2     2   11 use base qw(Tie::ExtraHash);
  2         4  
  2         488  
252              
253             sub TIEHASH {
254 13     13   24 my $class = shift;
255 13         24 my $hash = shift;
256 13         20 my $recorder = shift;
257              
258 13         31 my $this = bless [ $hash, $recorder ], $class;
259 13         37 return $this;
260             }
261              
262             sub STORE {
263 2     2   6 my ($this, $key, $value) = @_;
264 2         6 my ($hash, $data) = @$this;
265 2         5 $hash->{$key} = $value;
266 2         5 $this->get_recorder()->add_store($key, $value);
267             }
268              
269             sub get_recorder {
270 2     2   7 return $_[0]->[1];
271             }
272              
273             package RecordingArray;
274              
275 2     2   455 use Tie::Array;
  2         1772  
  2         49  
276 2     2   11 use base qw(Tie::Array);
  2         4  
  2         785  
277              
278             #sub TIEARRAY { bless [], $_[0] }
279             sub TIEARRAY {
280 6     6   12 my $class = shift;
281 6         9 my $array = shift;
282 6         8 my $recorder = shift;
283              
284 6         14 my $this = bless [ $array, $recorder ], $class;
285 6         14 return $this;
286             }
287              
288             #sub STORE { $_[0]->[$_[1]] = $_[2] }
289 2     2   19 sub STORE { my ($this, $index, $value) = @_; my ($array, $recorder) = @$this;
  2         5  
290 2         5 $array->[$index] = $value;
291 2         6 $this->get_recorder()->add_store('#' . $index, $value);
292             }
293              
294             sub PUSH {
295 2     2   27 my ($this, @new_items) = @_;
296 2         7 my ($array, $recorder) = @$this;
297 2         6 my $start_index = scalar @$array;
298              
299             #First modify the array
300 2         6 push @$array, @new_items;
301              
302             #Now record the new indexes
303 2         4 my $num_to_push = scalar @new_items;
304 2         7 my $item_index = 0;
305              
306 2         9 foreach my $index ($start_index..($start_index+$num_to_push-1)) {
307 4         23 $recorder->add_store('#' . $index, $new_items[$item_index]);
308 4         77 $item_index++;
309             }
310             }
311              
312             # These methods are copied from Tie::StdArray, Except modified to work on the
313             # first array, like ExtraHash (there is no ExtraArray)
314 16     16   5153 sub FETCHSIZE { scalar @{$_[0]->[0]} }
  16         52  
315 0     0   0 sub STORESIZE { $#{$_[0]->[0]} = $_[1]-1 }
  0         0  
316 10     10   50 sub FETCH { $_[0]->[0]->[$_[1]] }
317 0     0   0 sub CLEAR { @{$_[0]->[0]} = () }
  0         0  
318 0     0   0 sub POP { pop(@{$_[0]->[0]}) }
  0         0  
319 0     0   0 sub SHIFT { shift(@{$_[0]->[0]}) }
  0         0  
320 0     0   0 sub EXISTS { exists $_[0]->[0]->[$_[1]] }
321 0     0   0 sub DELETE { delete $_[0]->[0]->[$_[1]] }
322              
323             # Die on unsupported methods
324 0     0   0 sub UNSHIFT { die "UNSHIFT Unsupported in annotate, consider using xform" }
325 0     0   0 sub SPLICE { die "SPLICE Unsupported in annotate, consider using xform" }
326              
327             sub get_recorder {
328 2     2   7 return $_[0][1];
329             }
330              
331             1;