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