File Coverage

blib/lib/Connector/Multi/Merge.pm
Criterion Covered Total %
statement 35 41 85.3
branch 5 6 83.3
condition 1 3 33.3
subroutine 8 8 100.0
pod 0 1 0.0
total 49 59 83.0


line stmt bran cond sub pod time code
1              
2             use strict;
3 1     1   190361 use warnings;
  1         15  
  1         32  
4 1     1   5 use English;
  1         1  
  1         30  
5 1     1   6 use Config::Merge;
  1         2  
  1         6  
6 1     1   996 use Data::Dumper;
  1         13241  
  1         6  
7 1     1   37  
  1         2  
  1         70  
8             use Moose;
9 1     1   470  
  1         391151  
  1         5  
10             extends 'Connector::Builtin::Memory';
11              
12             has '+LOCATION' => ( required => 1 );
13              
14              
15             my $self = shift;
16              
17 1     1   6 # Skip the workflow directories
18             my $cm = Config::Merge->new( $self->LOCATION() );
19             my $cmref = $cm->();
20 1         27 my $tree = $self->cm2tree($cmref);
21 1         3565  
22 1         62 return $tree;
23              
24 1         35 }
25              
26             # Traverse the tree read from Config::Merge and replace the "@" keys by
27             # scalar references
28              
29             my $self = shift;
30             my $cm = shift;
31              
32 8     8 0 11 if ( ref($cm) eq 'HASH' ) {
33 8         9 my $ret = {};
34             foreach my $key ( keys %{$cm} ) {
35 8 100       20 if ( $key =~ m{ (?: \A @ (.*?) @ \z | \A @ (.*) | (.*?) @ \z ) }xms ) {
    50          
36 6         8 my $match = $1 || $2 || $3;
37 6         7 # make it a ref to an anonymous scalar so we know it's a symlink
  6         12  
38 8 100       32 $ret->{$match} = \$cm->{$key};
39 1   33     13 } else {
40             $ret->{$key} = $self->cm2tree( $cm->{$key} )
41 1         3 }
42             }
43 7         19 return $ret;
44             }
45             elsif ( ref($cm) eq 'ARRAY' ) {
46 6         12 my $ret = [];
47             my $i = 0;
48             foreach my $entry ( @{$cm} ) {
49 0         0 $ret->[ $i++ ] = $self->cm2tree($entry);
50 0         0 }
51 0         0 return $ret;
  0         0  
52 0         0 }
53             else {
54 0         0 return $cm;
55             }
56             }
57 2         5  
58             1;
59              
60              
61              
62             =head1 Name
63              
64             Connector::Multi::Merge
65            
66             =head1 Description
67              
68             This is a glue connector to create the required reference syntax for
69             Connector::Multi based on a backend configuration handled by Config::Merge.
70              
71             LOCATION is passed over as path to Config::Merge and must point to the
72             root node of the config directory.
73              
74             Internally, the constructor walks down the whole tree and translates
75             all keys starting or ending with the "@" character into references as
76             understood by Connector::Multi.
77              
78             =head1 CONFIGURATION
79              
80             There is no special configuration besides the mandatory LOCATION property.
81              
82             =head1 Example
83              
84             my $backend = Connector::Multi::Merge->new({
85             LOCATION = /etc/myconfigtree/
86             })
87            
88             my $multi = Connector::Multi->new({
89             BASECONNECTOR => $backend
90             })
91              
92