File Coverage

blib/lib/App/RecordStream/Operation/fromre.pm
Criterion Covered Total %
statement 39 44 88.6
branch 5 6 83.3
condition 5 7 71.4
subroutine 10 11 90.9
pod 0 7 0.0
total 59 75 78.6


line stmt bran cond sub pod time code
1             package App::RecordStream::Operation::fromre;
2              
3             our $VERSION = "4.0.24";
4              
5 2     2   1533 use strict;
  2         5  
  2         76  
6              
7 2     2   18 use base qw(App::RecordStream::Operation);
  2         5  
  2         1341  
8              
9             sub init {
10 3     3 0 8 my $this = shift;
11 3         9 my $args = shift;
12              
13             my %options = (
14 2     2   2086 "key|k|field|f=s" => sub { $this->add_field(split(/,/, $_[1])); },
15 3         30 );
16              
17 3         29 $this->parse_options($args, \%options);
18 3 50       18 if(!@$args) {
19 0         0 die "Missing expression\n";
20             }
21 3         20 $this->_set_pattern(shift @$args);
22             }
23              
24             sub _set_pattern {
25 3     3   14 my ($this, $value) = @_;
26 3         50 $this->{'PATTERN'} = $value;
27             }
28              
29             sub get_pattern {
30 10     10 0 26 my ($this) = @_;
31 10   50     208 return $this->{'PATTERN'} || 0;
32             }
33              
34             sub add_field {
35 2     2 0 8 my $this = shift;
36 2   50     24 $this->{'FIELDS'} ||= [];
37 2         7 push @{$this->{'FIELDS'}}, @_;
  2         13  
38             }
39              
40             sub get_field {
41 14     14 0 42 my ($this, $index) = @_;
42              
43 14 100 100     79 if($this->{'FIELDS'} && $index < @{$this->{'FIELDS'}}) {
  11         54  
44 9         61 return $this->{'FIELDS'}->[$index];
45             }
46             else {
47 5         24 return $index;
48             }
49             }
50              
51             sub accept_line {
52 10     10 0 25 my $this = shift;
53 10         25 my $line = shift;
54              
55 10 100       35 if(my @groups = ($line =~ $this->get_pattern())) {
56 6         81 my $record = App::RecordStream::Record->new();
57 6         19 my $index = 0;
58              
59 6         20 foreach my $value (@groups) {
60 14         32 ${$record->guess_key_from_spec($this->get_field($index))} = $value;
  14         51  
61 14         49 ++$index;
62             }
63              
64 6         46 $this->push_record($record);
65             }
66              
67 10         57 return 1;
68             }
69              
70             sub add_help_types {
71 3     3 0 10 my $this = shift;
72 3         25 $this->use_help_type('keyspecs');
73             }
74              
75             sub usage {
76 0     0 0   my $this = shift;
77              
78 0           my $options = [
79             [ 'key|-k ', 'Comma separated list of key names. May be specified multiple times. may be a key spec, see \'man recs\' for more'],
80             ];
81              
82 0           my $args_string = $this->options_string($options);
83              
84 0           return <
85             Usage: recs-fromre []
86             __FORMAT_TEXT__
87             is matched against each line of input (or lines of ). Each
88             successfully match results in one output record whose field values are the
89             capture groups from the match. Lines that do not match are ignored. Keys
90             are named numerically (0, 1, etc.) or as given by --key.
91              
92             For spliting on a delimeter, see recs-fromsplit.
93             __FORMAT_TEXT__
94              
95             Arguments:
96             $args_string
97              
98             Examples:
99             Parse greetings
100             recs-fromre --key name,age '^Hello, my name is (.*) and I am (\\d*) years? old\$'
101             Parse a single key named time from a group of digits at the beginning of the line
102             recs-fromre --key time '^(\\d+)'
103             Map three sets of <>s to a record with keys named 0, 1, and 2
104             recs-fromre '<(.*)>\\s*<(.*)>\\s*<(.*)>'
105             USAGE
106             }
107              
108             1;