File Coverage

blib/lib/App/RecordStream/Deaggregator/Split.pm
Criterion Covered Total %
statement 36 48 75.0
branch 2 4 50.0
condition n/a
subroutine 10 13 76.9
pod 0 7 0.0
total 48 72 66.6


line stmt bran cond sub pod time code
1             package App::RecordStream::Deaggregator::Split;
2              
3 1     1   526 use strict;
  1         1  
  1         23  
4 1     1   4 use warnings;
  1         2  
  1         20  
5              
6 1     1   4 use App::RecordStream::Deaggregator::Field;
  1         2  
  1         17  
7 1     1   3 use App::RecordStream::Deaggregator;
  1         2  
  1         14  
8 1     1   4 use App::RecordStream::DomainLanguage::Registry;
  1         2  
  1         29  
9              
10 1     1   8 use base 'App::RecordStream::Deaggregator::Field';
  1         3  
  1         408  
11              
12             sub new
13             {
14 4     4 0 5 my $class = shift;
15 4         13 my $old_field = shift;
16 4         6 my $delim = shift;
17 4         6 my $new_field = shift;
18              
19 4         19 my $this = $class->SUPER::new($old_field);
20              
21 4         10 $this->{'delim'} = make_delim($delim);
22 4         7 $this->{'new_field'} = $new_field;
23              
24 4         18 return $this;
25             }
26              
27             sub new_from_valuation
28             {
29 0     0 0 0 my $class = shift;
30 0         0 my $valuation = shift;
31 0         0 my $delim = shift;
32 0         0 my $new_field = shift;
33              
34 0         0 my $this = $class->SUPER::new_from_valuation($valuation);
35              
36 0         0 $this->{'delim'} = $delim; # not make_delim, let the domain language sort it out!
37 0         0 $this->{'new_field'} = $new_field;
38              
39 0         0 return $this;
40             }
41              
42             sub make_delim
43             {
44 4     4 0 8 my $delim = shift;
45              
46 4 50       17 if($delim =~ /^\/(.*)\/$/)
    50          
47             {
48 0         0 return qr/$1/;
49             }
50             elsif($delim =~ /^\/(.*)\/i$/)
51             {
52 0         0 return qr/$1/i;
53             }
54             else
55             {
56 4         49 return qr/\Q$delim\E/;
57             }
58             }
59              
60             sub deaggregate_field
61             {
62 14     14 0 21 my $this = shift;
63 14         20 my $values = shift;
64              
65 14         16 my @ret;
66              
67 14         49 for my $value (split($this->{'delim'}, $values, -1))
68             {
69 32         90 push @ret, {$this->{'new_field'} => $value};
70             }
71              
72 14         44 return \@ret;
73             }
74              
75             sub long_usage
76             {
77 0     0 0 0 return <
78             Usage: split,,,
79             Split the old field to create a new one.
80             EOF
81             }
82              
83             sub short_usage
84             {
85 0     0 0 0 return "split the provided field";
86             }
87              
88             sub argct
89             {
90 4     4 0 8 return 3;
91             }
92              
93             App::RecordStream::Deaggregator->register_implementation('split', __PACKAGE__);
94              
95             App::RecordStream::DomainLanguage::Registry::register_vfn(__PACKAGE__, 'new_from_valuation', 'split', 'VALUATION', 'SCALAR', 'SCALAR');
96              
97             1;