File Coverage

blib/lib/Config/Model/TreeSearcher.pm
Criterion Covered Total %
statement 77 81 95.0
branch 16 24 66.6
condition 15 18 83.3
subroutine 14 14 100.0
pod 1 1 100.0
total 123 138 89.1


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 59     59   368 use Mouse::Util::TypeConstraints;
  59         119  
  59         428  
13 59     59   23223  
  59         134  
  59         393  
14             use List::MoreUtils qw/any/;
15 59     59   6097 use Log::Log4perl qw(get_logger :levels);
  59         128  
  59         674  
16 59     59   36267 use Config::Model::Exception;
  59         150  
  59         446  
17 59     59   6796 use Config::Model::ObjTreeScanner;
  59         123  
  59         1314  
18 59     59   289 use Carp;
  59         156  
  59         1490  
19 59     59   315  
  59         143  
  59         4942  
20             my @search_types = qw/element value key summary description help/;
21             enum( 'SearchType' => [ @search_types, 'all' ] );
22              
23             # clean up namespace to avoid clash between MUTC keywords and
24             # my functions
25             # See http://www.nntp.perl.org/group/perl.moose/2010/10/msg1935.html
26             no Mouse::Util::TypeConstraints;
27 59     59   411  
  59         148  
  59         387  
28             has 'node' => (
29             is => 'ro',
30             isa => 'Config::Model::Node',
31             weak_ref => 1,
32             required => 1
33             );
34              
35             has 'type' => ( is => 'ro', isa => 'SearchType' );
36              
37             has '_type_hash' => (
38             is => 'rw',
39             isa => 'HashRef[Bool]',
40             builder => '_build_type_hash',
41             lazy => 1,
42             );
43              
44             my $logger = get_logger("TreeSearcher");
45              
46             my $self = shift;
47             my $t = $self->type;
48 9     9   16 my $def = $t eq 'all' ? 1 : 0;
49 9         22 my %res = map { $_ => $def; } @search_types;
50 9 50       21 $res{$t} = 1 unless $t eq 'all';
51 9         17 return \%res;
  54         101  
52 9 50       31 }
53 9         16  
54             my $self = shift;
55             my $string = shift; # string to search, can be a regexp
56              
57 9     9 1 150 $logger->trace( "TreeSearcher: creating scanner for " . $self->node->name );
58 9         15 my $reg = qr/$string/i;
59              
60 9         32 my @scanner_args;
61 9         148 my $need_search = $self->_build_type_hash;
62              
63 9         16 push @scanner_args, leaf_cb => sub {
64 9         17 my ( $scanner, $data_ref, $node, $element_name, $index, $leaf_object ) = @_;
65              
66             my $loc = $leaf_object->location;
67 549     549   990 $logger->debug("TreeSearcher: scanning leaf $loc");
68              
69 549         1277 my $v = $leaf_object->fetch( check => 'no' );
70 549         1688 if ( $need_search->{value} and defined $v and $v =~ $reg ) {
71             $data_ref->($loc);
72 549         4087 }
73 549 100 100     1846 if ( $need_search->{help} ) {
      100        
74 10         28 my $help_ref = $leaf_object->get_help;
75             $data_ref->($loc)
76 549 50       1858 if any { $_ =~ $reg; } values %$help_ref;
77 0         0 }
78             };
79 0 0       0  
  0         0  
80             push @scanner_args, hash_element_cb => sub {
81 9         45 my ( $scanner, $data_ref, $node, $element_name, @keys ) = @_;
82             my $loc = $node->location;
83             $loc .= ' ' if $loc;
84 54     54   107 $loc .= $element_name;
85 54         129  
86 54 100       103 $logger->debug("TreeSearcher: scanning hash $loc");
87 54         87  
88             foreach my $k (@keys) {
89 54         189 if ( $need_search->{key} and $k =~ $reg ) {
90             my $hloc = $node->fetch_element($element_name)->fetch_with_id($k)->location;
91 54         415 $data_ref->($hloc);
92 45 100 100     133 }
93 1         17 $scanner->scan_hash( $data_ref, $node, $element_name, $k );
94 1         3 }
95             };
96 45         105  
97             push @scanner_args, node_content_cb => sub {
98 9         31 my ( $scanner, $data_ref, $node, @element ) = @_;
99             my $loc = $node->location;
100             $logger->debug("TreeSearcher: scanning node $loc");
101 126     126   299  
102 126         354 foreach my $e (@element) {
103 126         358 my $store = 0;
104              
105 126         768 for ( qw/description summary/ ) {
106 693         897 if ($need_search->{$_} and $node->get_help_as_text( $_ => $e ) =~ $reg) {
107             $store = 1;
108 693         1046 }
109 1386 100 100     3031 }
110 4         10 if ($need_search->{element} and $e =~ $reg) {
111             $store = 1;
112             }
113 693 50 33     1221  
114 0         0 $data_ref->( $loc ? $loc . ' ' . $e : $e ) if $store;
115              
116             $scanner->scan_element( $data_ref, $node, $e );
117 693 50       1194 }
    100          
118             };
119 693         1591  
120             my $scan = Config::Model::ObjTreeScanner->new( @scanner_args, );
121 9         30  
122             # use hash to avoid duplication of path
123 9         50 my @loc;
124             my $store_sub = sub {
125             my $p = shift;
126 9         16 return if @loc and $loc[$#loc] eq $p;
127             $logger->trace("TreeSearcher: storing location '$p'");
128 15     15   20 push @loc, $p;
129 15 50 66     52 };
130 15         59 $scan->scan_node( $store_sub, $self->node );
131 15         106  
132 9         28 return @loc;
133 9         46 }
134              
135 9         287 __PACKAGE__->meta->make_immutable;
136              
137             1;
138              
139             # ABSTRACT: Search tree for match in value, description...
140              
141              
142             =pod
143              
144             =encoding UTF-8
145              
146             =head1 NAME
147              
148             Config::Model::TreeSearcher - Search tree for match in value, description...
149              
150             =head1 VERSION
151              
152             version 2.151
153              
154             =head1 SYNOPSIS
155              
156             use Config::Model ;
157              
158             # define configuration tree object
159             my $model = Config::Model->new ;
160             $model ->create_config_class (
161             name => "MyClass",
162             element => [
163             [qw/foo bar/] => {
164             type => 'leaf',
165             value_type => 'string'
166             },
167             baz => {
168             type => 'hash',
169             index_type => 'string' ,
170             cargo => {
171             type => 'leaf',
172             value_type => 'string',
173             },
174             },
175            
176             ],
177             ) ;
178              
179             my $inst = $model->instance(root_class_name => 'MyClass' );
180              
181             my $root = $inst->config_root ;
182              
183             my $steps = 'baz:fr=bonjour baz:hr="dobar dan" foo="journalled"';
184             $root->load( steps => $steps ) ;
185              
186             my @result = $root->tree_searcher(type => 'value')->search('jour');
187             print join("\n",@result),"\n" ;
188             # print
189             # baz:fr
190             # foo
191              
192             =head1 DESCRIPTION
193              
194             This class provides a way to search the content of a configuration tree.
195             Given a keyword or a pattern, the search method scans the tree to find
196             a value, a description or anything that match the given pattern (or keyword).
197              
198             =head1 Constructor
199              
200             =head2 new (type => [ value | description ... ] )
201              
202             Creates a new searcher object. The C<type> parameter can be:
203              
204             =over
205              
206             =item element
207              
208             =item value
209              
210             =item key
211              
212             =item summary
213              
214             =item description
215              
216             =item help
217              
218             =item all
219              
220             Search in all the items above
221              
222             =back
223              
224             =head1 Methods
225              
226             =head2 search
227              
228             Parameters: C<< (keyword) >>
229              
230             Search the keyword or pattern in the tree. The search is done in a case
231             insensitive manner. Returns a list of path pointing
232             to the matching tree elements. See L<Config::Model::Role::Grab/grab> for details
233             on the path syntax.
234              
235             =head1 BUGS
236              
237             Creating a class with just one search method may be overkill. OTOH, it may
238             be extended later to provide iterative search.
239              
240             =head1 AUTHOR
241              
242             Dominique Dumont, (ddumont at cpan dot org)
243              
244             =head1 SEE ALSO
245              
246             L<Config::Model>,
247             L<Config::Model::SearchElement>,
248             L<Config::Model::AnyThing>
249              
250             =head1 AUTHOR
251              
252             Dominique Dumont
253              
254             =head1 COPYRIGHT AND LICENSE
255              
256             This software is Copyright (c) 2005-2022 by Dominique Dumont.
257              
258             This is free software, licensed under:
259              
260             The GNU Lesser General Public License, Version 2.1, February 1999
261              
262             =cut