File Coverage

blib/lib/Config/Model/Annotation.pm
Criterion Covered Total %
statement 82 82 100.0
branch 6 10 60.0
condition 1 3 33.3
subroutine 23 23 100.0
pod 2 8 25.0
total 114 126 90.4


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             use Mouse;
12 1     1   407 use English;
  1         2  
  1         5  
13 1     1   672 use Mouse::Util::TypeConstraints;
  1         2602  
  1         5  
14 1     1   328  
  1         2  
  1         6  
15             use Path::Tiny;
16 1     1   72 use Data::Dumper;
  1         1  
  1         30  
17 1     1   4  
  1         1  
  1         28  
18             use Config::Model::TypeConstraints;
19 1     1   4 use Config::Model::Exception;
  1         1  
  1         14  
20 1     1   4 use Config::Model::Node;
  1         1  
  1         13  
21 1     1   4 use Config::Model::ObjTreeScanner;
  1         2  
  1         26  
22 1     1   6  
  1         1  
  1         15  
23             use strict ;
24 1     1   3 use warnings;
  1         7  
  1         23  
25 1     1   4  
  1         2  
  1         28  
26             use Carp qw/croak confess cluck/;
27 1     1   5  
  1         22  
  1         590  
28             #my $logger = get_logger("Annotation") ;
29              
30             has 'instance' => ( is => 'ro', isa => 'Config::Model::Instance', required => 1 );
31             has 'config_class_name' => ( is => 'ro', isa => 'Str', required => 1 );
32             has 'file' => ( is => 'ro', isa => 'Path::Tiny', lazy => 1, builder => '_set_file' );
33             has 'dir' => ( is => 'ro', isa => 'Path::Tiny', lazy => 1, builder => '_set_dir' );
34              
35             has 'root_dir' => (
36             is => 'ro',
37             isa => 'Config::Model::TypeContraints::Path',
38             coerce => 1
39             );
40              
41             my $self = shift;
42             return $self->dir->child( $self->config_class_name . '-note.pl');
43 2     2   528 }
44 2         12  
45             my $self = shift;
46             return
47             $self->root_dir ? $self->root_dir->child('config-model')
48 2     2   830 : $EUID ? path("/var/lib/config-model")
49             : path("~/.config-model");
50 2 0       15 }
    50          
51              
52             my $self = shift;
53              
54             my $dir = $self->dir;
55             $dir->mkpath;
56 1     1 1 613 my $h = $self->get_annotation_hash;
57             $self->file->spew_utf8( Dumper($h) );
58 1         4 }
59 1         6  
60 1         222 my $self = shift;
61 1         8  
62             my %data;
63             my $scanner = Config::Model::ObjTreeScanner->new(
64             leaf_cb => \&my_leaf_cb,
65 4     4 0 488 hash_element_cb => \&my_hash_element_cb,
66             list_element_cb => \&my_list_element_cb,
67 4         5 node_element_cb => \&my_node_element_cb,
68 4         39 fallback => 'all',
69             );
70             my $root = $self->instance->config_root;
71              
72             $scanner->scan_node( \%data, $root );
73             return \%data;
74             }
75 4         31  
76             # WARNING: not a method
77 4         13 my ( $scanner, $data_ref, $node, $element_name, @keys ) = @_;
78 4         44  
79             # custom code using $data_ref
80             store_note_in_data( $data_ref, $node->fetch_element($element_name) );
81              
82             # resume exploration
83 24     24 0 53 map { $scanner->scan_hash( $data_ref, $node, $element_name, $_ ) } @keys;
84             }
85              
86 24         48 # WARNING: not a method
87             my ( $scanner, $data_ref, $node, $element_name, $key, $contained_node ) = @_;
88              
89 24         52 # your custom code using $data_ref
  18         40  
90             store_note_in_data( $data_ref, $contained_node );
91              
92             # explore next node
93             $scanner->scan_node( $data_ref, $contained_node );
94 54     54 0 90 }
95              
96             # WARNING: not a method
97 54         87 my ( $scanner, $data_ref, $node, $element_name, @idx ) = @_;
98              
99             # custom code using $data_ref
100 54         110 store_note_in_data( $data_ref, $node->fetch_element($element_name) );
101              
102             # resume exploration (if needed)
103             map { $scanner->scan_list( $data_ref, $node, $element_name, $_ ) } @idx;
104              
105 12     12 0 21 # note: scan_list and scan_hash are equivalent
106             }
107              
108 12         26 # WARNING: not a method
109             my ( $scanner, $data_ref, $node, $element_name, $index, $leaf_object ) = @_;
110             store_note_in_data( $data_ref, $leaf_object );
111 12         20 }
  29         57  
112              
113             # WARNING: not a method
114             my ( $data_ref, $obj ) = @_;
115              
116             my $note = $obj->annotation;
117             return unless $note;
118 271     271 0 378  
119 271         361 my $key = $obj->location;
120             $data_ref->{$key} = $note;
121             }
122              
123             my $self = shift;
124 361     361 0 418 my $f = $self->file;
125             return unless $f->exists;
126 361         650 my $hash = do "./$f" || croak "can't do $f:$!";
127 361 100       886 my $root = $self->instance->config_root;
128              
129 22         47 foreach my $path ( keys %$hash ) {
130 22         59 my $obj = eval { $root->grab( step => $path, autoadd => 0 ) };
131             next if $@; # skip annotation of unknown elements
132             $obj->annotation( $hash->{$path} );
133             }
134 2     2 1 35 }
135 2         8  
136 2 50       67 no Mouse;
137 2   33     58  
138 2         15 __PACKAGE__->meta->make_immutable;
139              
140 2         9 1;
141 14         20  
  14         47  
142 14 100       84 # ABSTRACT: Read and write configuration annotations
143 8         21  
144              
145             =pod
146              
147 1     1   6 =encoding UTF-8
  1         1  
  1         42  
148              
149             =head1 NAME
150              
151             Config::Model::Annotation - Read and write configuration annotations
152              
153             =head1 VERSION
154              
155             version 2.151
156              
157             =head1 SYNOPSIS
158              
159             use Config::Model ;
160              
161             # define configuration tree object
162             my $model = Config::Model->new ;
163             $model ->create_config_class (
164             name => "MyClass",
165             element => [
166             [qw/foo bar/] => {
167             type => 'leaf',
168             value_type => 'string'
169             },
170             baz => {
171             type => 'hash',
172             index_type => 'string' ,
173             cargo => {
174             type => 'leaf',
175             value_type => 'string',
176             },
177             },
178              
179             ],
180             ) ;
181              
182             my $inst = $model->instance(root_class_name => 'MyClass' );
183              
184             my $root = $inst->config_root ;
185              
186             # put some data in config tree the hard way
187             $root->fetch_element('foo')->store('yada') ;
188             $root->fetch_element('baz')->fetch_with_id('en')->store('hello') ;
189              
190             # put annotation the hard way
191             $root->fetch_element('foo')->annotation('english') ;
192             $root->fetch_element('baz')->fetch_with_id('en')->annotation('also english') ;
193              
194             # put more data the easy way
195             my $steps = 'baz:fr=bonjour#french baz:hr="dobar dan"#croatian';
196             $root->load( steps => $steps ) ;
197              
198             # dump resulting tree with annotations
199             print $root->dump_tree;
200              
201             # save annotations
202             my $annotate_saver = Config::Model::Annotation
203             -> new (
204             config_class_name => 'MyClass',
205             instance => $inst ,
206             root_dir => '/tmp/', # for test
207             ) ;
208             $annotate_saver->save ;
209              
210             # now check content of /tmp/config-model/MyClass-note.pl
211              
212             =head1 DESCRIPTION
213              
214             This module provides an object that read and write annotations (a bit
215             like comments) to and from a configuration tree and save them in a
216             file (not configuration file). This module can be used to save
217             annotation for configuration files that do not support comments.
218              
219             THis module should not be used for configuration files that support
220             comments.
221              
222             Depending on the effective id of the process, the annotation is
223             saved in:
224              
225             =over
226              
227             =item *
228              
229             C<< /var/lib/config-model/<model_name>-note.yml >> for root (EUID == 0)
230              
231             =item *
232              
233             C<< ~/.config-model/<model_name>-note.yml >> for normal user (EUID > 0)
234              
235             =back
236              
237             =head1 CONSTRUCTOR
238              
239             Quite standard. The constructor is passed a L<Config::Model::Instance>
240             object.
241              
242             =head1 METHODS
243              
244             =head2 save
245              
246             Save annotations in a file (See L<DESCRIPTION>)
247              
248             =head2 load
249              
250             Loads annotations from a file (See L<DESCRIPTION>)
251              
252             =head1 CAVEATS
253              
254             This module is currently not used.
255              
256             =head1 AUTHOR
257              
258             Dominique Dumont, (ddumont at cpan dot org)
259              
260             =head1 SEE ALSO
261              
262             L<Config::Model>,
263             L<Config::Model::Node>,
264             L<Config::Model::Loader>,
265             L<Config::Model::Searcher>,
266             L<Config::Model::Value>,
267              
268             =head1 AUTHOR
269              
270             Dominique Dumont
271              
272             =head1 COPYRIGHT AND LICENSE
273              
274             This software is Copyright (c) 2005-2022 by Dominique Dumont.
275              
276             This is free software, licensed under:
277              
278             The GNU Lesser General Public License, Version 2.1, February 1999
279              
280             =cut