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