File Coverage

blib/lib/Config/Model/BackendTrackOrder.pm
Criterion Covered Total %
statement 48 52 92.3
branch 12 16 75.0
condition 2 3 66.6
subroutine 9 9 100.0
pod 2 2 100.0
total 73 82 89.0


line stmt bran cond sub pod time code
1             #
2             # This file is part of Config-Model
3             #
4             # This software is Copyright (c) 2005-2022 by Dominique Dumont.
5             #
6             # This is free software, licensed under:
7             #
8             # The GNU Lesser General Public License, Version 2.1, February 1999
9             #
10              
11             # ABSTRACT: Track read order of elements from configuration
12              
13             use Mouse;
14 3     3   21 use strict;
  3         9  
  3         22  
15 3     3   1205 use warnings;
  3         6  
  3         69  
16 3     3   15 use Carp;
  3         6  
  3         83  
17 3     3   15 use 5.10.0;
  3         6  
  3         206  
18 3     3   49  
  3         16  
19             use Mouse::Util;
20 3     3   16 use Log::Log4perl qw(get_logger :levels);
  3         8  
  3         22  
21 3     3   295  
  3         8  
  3         31  
22             my $logger = get_logger("BackendTrackOrder");
23              
24             has backend_obj => (
25             is => 'ro',
26             isa => 'Config::Model::Backend::Any',
27             weak_ref => 1,
28             required => 1,
29             handles => [qw/node get_element_names/],
30             );
31              
32             has _creation_order => (
33             is => 'bare',
34             isa => 'ArrayRef[Str]',
35             traits => ['Array'],
36             default => sub { [] },
37             handles => {
38             _register_element => 'push',
39             get_element_names_as_created => 'elements',
40             _insert_element => 'insert',
41             }
42             );
43              
44             has _created => (
45             is => 'rw',
46             isa => 'HashRef[Str]',
47             traits => ['Hash'],
48             default => sub { {} },
49             handles => {
50             register_created => 'set',
51             has_created => 'exists',
52             }
53             );
54              
55             # keeping order in Node does not make sense: one must read parameter
56             # in canonical order to enable warp mechanism from one elemnet to the
57             # other, so the read order will never differ from the canonical
58             # order. Only some elements will be missing
59              
60             # What about default values, not created, no store done ????
61             # -> when writing back, mix all elements from canonical list into existing list ...
62             # or at the end of initial load ???
63             # or mixall at the end of init() ?
64              
65             my ($self, $name) = @_;
66              
67 57     57 1 116 return if $self->has_created($name);
68             $self->register_created($name => 1 );
69 57 100       143  
70 35         396 if ($self->node->instance->initial_load) {
71             $logger->debug("registering $name during init");
72 35 100       1495 $self->_register_element($name);
73 26         489 }
74 26         232 else {
75             # try to keep canonical order
76             my $i = 1;
77             my %has = map{ ($_ , $i++ ) } $self->get_element_names_as_created;
78 9         110  
79 9         27 my $found_me = 0;
  56         160  
80             my $previous_idx = 0 ;
81 9         21 my $previous_name ;
82 9         12 # traverse the canonical list in reverse order (which includes
83 9         12 # accepted elements) ...
84             foreach my $std (reverse @{ $self->node->{model}{element_list} }) {
85             # ... until the new element is found in the canonical list ...
86 9         14 if ($name eq $std) {
  9         20  
87             $found_me++;
88 59 100 66     207 }
    100          
89 9         13 # ... and the first previous element from the canonical
90             # list already existing in the existing list is found
91             elsif ($found_me and $has{$std}) {
92             $previous_idx = $has{$std};
93             $previous_name = $std;
94 9         26 last;
95 9         15 }
96 9         15 }
97              
98             # then insert this element in the existing list after the
99             # previous element (which may be 0, if the previous element
100             # was not found, i.e. do an unshift). push it if search has failed.
101             if ($found_me) {
102             if ($logger->is_debug) {
103 9 50       19 my $str = $previous_name ? "after $previous_name" : "at beginning";
104 9 50       25 $logger->debug("registering $name $str");
105 0 0       0 }
106 0         0 $self->_insert_element($previous_idx, $name);
107             }
108 9         62 else {
109             $logger->debug("registering $name at end of list");
110             $self->_register_element($name);
111 0         0 }
112 0         0 }
113             }
114              
115             my $self = shift;
116             if ($self->node->instance->canonical) {
117             return $self->get_element_names;
118 7     7 1 129 }
119 7 100       25 else {
120 2         30 # triggers a registration of all remaining elements in _creation_order
121             for ( $self->get_element_names ) {
122             $self->register_element($_);
123             }
124 5         93 return $self->get_element_names_as_created;
125 31         358 }
126             }
127 5         52  
128             1;
129              
130              
131             =pod
132              
133             =encoding UTF-8
134              
135             =head1 NAME
136              
137             Config::Model::BackendTrackOrder - Track read order of elements from configuration
138              
139             =head1 VERSION
140              
141             version 2.151
142              
143             =head1 SYNOPSIS
144              
145             # inside a backend
146             use Config::Model::BackendTrackOrder;
147              
148             has tracker => (
149             is => 'ro',
150             isa => 'Config::Model::BackendTrackOrder',
151             lazy_build => 1,
152             );
153              
154             sub _build_tracker {
155             my $self = shift;
156             return Config::Model::BackendTrackOrder->new(
157             backend_obj => $self,
158             node => $self->node,
159             ) ;
160             }
161              
162             # register elements to record user order
163             $self->tracker->register_element('foo');
164             $self->tracker->register_element('bar');
165              
166             # later, when writing data back
167             foreach my $elt ( $self->tracker->get_ordered_element_names ) {
168             # write data
169             }
170              
171             =head1 DESCRIPTION
172              
173             This module is used by backends to record the order of the
174             configuration elements found in user file. Later these elements can be
175             written back in the file using the same order.
176              
177             Data are written in canonical order if C<canonical> method of the
178             L<instance/Config::Model::Instance> returns true.
179              
180             =head1 CONSTRUCTOR
181              
182             THe constructor accepts the following parameters:
183              
184             =over 4
185              
186             =item backend_obj
187              
188             The backend object holding this tracker (required).
189              
190             =item node
191              
192             The node holding the backend above
193              
194             =back
195              
196             =head1 METHODS
197              
198             =head2 register_element
199              
200             Register the element and keep track of the registration order during
201             L<initial load|Config::Model::Instance/start_initial_load>
202              
203             Element registered after initial load (i.e . user modification) are
204             registered using canonical order.
205              
206             =head2 get_ordered_element_names
207              
208             Returns a list of elements respecting user's order.
209              
210             Returns the canonical list if Instance canonical attribute is 1.
211              
212             =head1 AUTHOR
213              
214             Dominique Dumont
215              
216             =head1 COPYRIGHT AND LICENSE
217              
218             This software is Copyright (c) 2005-2022 by Dominique Dumont.
219              
220             This is free software, licensed under:
221              
222             The GNU Lesser General Public License, Version 2.1, February 1999
223              
224             =cut