File Coverage

blib/lib/Metabrik/Brik/Search.pm
Criterion Covered Total %
statement 9 226 3.9
branch 0 92 0.0
condition n/a
subroutine 3 14 21.4
pod 1 11 9.0
total 13 343 3.7


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # brik::search Brik
5             #
6             package Metabrik::Brik::Search;
7 1     1   589 use strict;
  1         2  
  1         29  
8 1     1   5 use warnings;
  1         2  
  1         32  
9              
10 1     1   5 use base qw(Metabrik);
  1         2  
  1         596  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             commands => {
17             all => [ ],
18             string => [ qw(string) ],
19             tag => [ qw(Tag) ],
20             not_tag => [ qw(Tag) ],
21             used => [ ],
22             not_used => [ ],
23             show_require_modules => [ ],
24             command => [ qw(Command) ],
25             category => [ qw(Category) ],
26             list_categories => [ ],
27             },
28             };
29             }
30              
31             sub all {
32 0     0 0   my $self = shift;
33              
34 0 0         if (! defined($self->context)) {
35 0           return $self->log->error("all: no core::context Brik");
36             }
37              
38 0           my $context = $self->context;
39 0           my $status = $context->status;
40              
41 0           my $total = 0;
42 0           my $count = 0;
43 0           $self->log->info("Used:");
44 0           for my $brik (@{$status->{used}}) {
  0            
45 0 0         next unless $context->used->{$brik}->can('brik_tags');
46 0           my $tags = $context->used->{$brik}->brik_tags;
47 0           $self->log->info(sprintf(" %-20s [%s]", $brik, join(', ', @$tags)));
48 0           $count++;
49 0           $total++;
50             }
51 0           $self->log->info("Count: $count");
52              
53 0           $count = 0;
54 0           $self->log->info("Not used:");
55 0           for my $brik (@{$status->{not_used}}) {
  0            
56 0 0         next unless $context->not_used->{$brik}->can('brik_tags');
57 0           my $tags = $context->not_used->{$brik}->brik_tags;
58 0           $self->log->info(sprintf(" %-20s [%s]", $brik, join(', ', @$tags)));
59 0           $count++;
60 0           $total++;
61             }
62 0           $self->log->info("Count: $count");
63              
64 0           return $total;
65             }
66              
67             sub string {
68 0     0 0   my $self = shift;
69 0           my ($string) = @_;
70              
71 0 0         if (! defined($self->context)) {
72 0           return $self->log->error("string: no core::context Brik");
73             }
74              
75 0 0         $self->brik_help_run_undef_arg('string', $string) or return;
76              
77 0           my $context = $self->context;
78 0           my $status = $context->status;
79              
80 0           my $total = 0;
81 0           $self->log->info("Used:");
82 0           for my $brik (@{$status->{used}}) {
  0            
83 0 0         next unless $brik =~ /$string/;
84 0 0         next unless $context->used->{$brik}->can('brik_tags');
85 0           my $tags = $context->used->{$brik}->brik_tags;
86 0           $self->log->info(sprintf(" %-20s [%s]", $brik, join(', ', @$tags)));
87 0           $total++;
88             }
89              
90 0           $self->log->info("Not used:");
91 0           for my $brik (@{$status->{not_used}}) {
  0            
92 0 0         next unless $brik =~ /$string/;
93 0 0         next unless $context->not_used->{$brik}->can('brik_tags');
94 0           my $tags = $context->not_used->{$brik}->brik_tags;
95 0           $self->log->info(sprintf(" %-20s [%s]", $brik, join(', ', @$tags)));
96 0           $total++;
97             }
98              
99 0           return $total;
100             }
101              
102             sub tag {
103 0     0 0   my $self = shift;
104 0           my ($tag) = @_;
105              
106 0 0         if (! defined($self->context)) {
107 0           return $self->log->error("tag: no core::context Brik");
108             }
109              
110 0 0         $self->brik_help_run_undef_arg('tag', $tag) or return;
111              
112 0           my $context = $self->context;
113 0           my $status = $context->status;
114              
115 0           my $total = 0;
116 0           $self->log->info("Used:");
117 0           for my $brik (@{$status->{used}}) {
  0            
118 0 0         next unless $context->used->{$brik}->can('brik_tags');
119 0           my $tags = $context->used->{$brik}->brik_tags;
120 0           push @$tags, 'used';
121 0           for my $this (@$tags) {
122 0 0         next unless $this eq $tag;
123 0           $self->log->info(sprintf(" %-20s [%s]", $brik, join(', ', @$tags)));
124 0           $total++;
125 0           last;
126             }
127             }
128              
129 0           $self->log->info("Not used:");
130 0           for my $brik (@{$status->{not_used}}) {
  0            
131 0 0         next unless $context->not_used->{$brik}->can('brik_tags');
132 0           my $tags = $context->not_used->{$brik}->brik_tags;
133 0           push @$tags, 'not_used';
134 0           for my $this (@$tags) {
135 0 0         next unless $this eq $tag;
136 0           $self->log->info(sprintf(" %-20s [%s]", $brik, join(', ', @$tags)));
137 0           $total++;
138 0           last;
139             }
140             }
141              
142              
143 0           return $total;
144             }
145              
146             sub not_tag {
147 0     0 0   my $self = shift;
148 0           my ($tag) = @_;
149              
150 0 0         if (! defined($self->context)) {
151 0           return $self->log->error("not_tag: no core::context Brik");
152             }
153              
154 0 0         $self->brik_help_run_undef_arg('not_tag', $tag) or return;
155              
156 0           my $context = $self->context;
157 0           my $status = $context->status;
158              
159 0           my $total = 0;
160 0           $self->log->info("Used:");
161 0           for my $brik (@{$status->{used}}) {
  0            
162 0 0         next unless $context->used->{$brik}->can('brik_tags');
163 0           my $tags = $context->used->{$brik}->brik_tags;
164 0           push @$tags, 'used';
165 0           for my $this (@$tags) {
166 0 0         next if $this eq $tag;
167 0           $self->log->info(sprintf(" %-20s [%s]", $brik, join(', ', @$tags)));
168 0           $total++;
169 0           last;
170             }
171             }
172              
173 0           $self->log->info("Not used:");
174 0           for my $brik (@{$status->{not_used}}) {
  0            
175 0 0         next unless $context->not_used->{$brik}->can('brik_tags');
176 0           my $tags = $context->not_used->{$brik}->brik_tags;
177 0           push @$tags, 'not_used';
178 0           for my $this (@$tags) {
179 0 0         next if $this eq $tag;
180 0           $self->log->info(sprintf(" %-20s [%s]", $brik, join(', ', @$tags)));
181 0           $total++;
182 0           last;
183             }
184             }
185              
186 0           return $total;
187             }
188              
189             sub used {
190 0     0 0   my $self = shift;
191              
192 0           return $self->tag('used');
193             }
194              
195             sub not_used {
196 0     0 0   my $self = shift;
197              
198 0           return $self->not_tag('used');
199             }
200              
201             sub show_require_modules {
202 0     0 0   my $self = shift;
203              
204 0 0         if (! defined($self->context)) {
205 0           return $self->log->error("show_require_modules: no core::context Brik");
206             }
207              
208 0           my $context = $self->context;
209 0           my $available = $context->available;
210              
211             # Don't show require for Core modules
212 0           my $core = {
213             'core::context',
214             'core::log',
215             'core::shell',
216             'core::global',
217             };
218              
219 0           my %require_modules = ();
220 0           for my $brik (keys %$available) {
221 0 0         next if (exists($core->{$brik}));
222 0 0         if ($available->{$brik}->can('brik_properties')) {
223 0           my $modules = $available->{$brik}->brik_properties->{require_modules};
224 0           for my $module (keys %$modules) {
225 0 0         next if $module =~ /^Metabrik/;
226 0           $require_modules{$module} = $brik;
227             }
228             }
229             }
230              
231 0           return [ sort { $a cmp $b } keys %require_modules ];
  0            
232             }
233              
234             sub command {
235 0     0 0   my $self = shift;
236 0           my ($command) = @_;
237              
238 0 0         if (! defined($self->context)) {
239 0           return $self->log->error("command: no core::context Brik");
240             }
241              
242 0 0         $self->brik_help_run_undef_arg('command', $command) or return;
243              
244 0           my $context = $self->context;
245 0           my $status = $context->status;
246              
247 0           my $total = 0;
248 0           $self->log->info("Used:");
249 0           for my $brik (@{$status->{used}}) {
  0            
250 0 0         if (exists($context->used->{$brik}->brik_properties->{commands})) {
251 0 0         next unless $context->used->{$brik}->can('brik_tags');
252 0           my $tags = $context->used->{$brik}->brik_tags;
253 0           push @$tags, 'used';
254 0           for my $key (keys %{$context->used->{$brik}->brik_properties->{commands}}) {
  0            
255 0 0         if ($key =~ /$command/i) {
256 0           $self->log->info(sprintf(" %-20s [%s]", $brik, join(', ', @$tags)));
257 0           $total++;
258             }
259             }
260             }
261             }
262              
263 0           $self->log->info("Not used:");
264 0           for my $brik (@{$status->{not_used}}) {
  0            
265 0 0         if (exists($context->not_used->{$brik}->brik_properties->{commands})) {
266 0 0         next unless $context->not_used->{$brik}->can('brik_tags');
267 0           my $tags = $context->not_used->{$brik}->brik_tags;
268 0           push @$tags, 'not_used';
269 0           for my $key (keys %{$context->not_used->{$brik}->brik_properties->{commands}}) {
  0            
270 0 0         if ($key =~ /$command/i) {
271 0           $self->log->info(sprintf(" %-20s [%s]", $brik, join(', ', @$tags)));
272 0           $total++;
273             }
274             }
275             }
276             }
277              
278 0           return $total;
279             }
280              
281             sub category {
282 0     0 0   my $self = shift;
283 0           my ($category) = @_;
284              
285 0 0         if (! defined($self->context)) {
286 0           return $self->log->error("category: no core::context Brik");
287             }
288              
289 0 0         $self->brik_help_run_undef_arg('category', $category) or return;
290              
291 0           my $context = $self->context;
292 0           my $status = $context->status;
293              
294 0           my $total = 0;
295 0           $self->log->info("Used:");
296 0           for my $brik (@{$status->{used}}) {
  0            
297 0 0         next unless defined($context->used->{$brik});
298 0 0         next unless $context->used->{$brik}->can('brik_category');
299 0           my $brik_category = $context->used->{$brik}->brik_category;
300 0 0         next unless $brik_category eq $category;
301 0 0         next unless $context->used->{$brik}->can('brik_tags');
302 0           my $tags = $context->used->{$brik}->brik_tags;
303 0           push @$tags, 'used';
304 0           $self->log->info(sprintf(" %-20s [%s]", $brik, join(', ', @$tags)));
305 0           $total++;
306             }
307              
308 0           $self->log->info("Not used:");
309 0           for my $brik (@{$status->{not_used}}) {
  0            
310 0 0         next unless defined($context->not_used->{$brik});
311 0 0         next unless $context->not_used->{$brik}->can('brik_category');
312 0           my $brik_category = $context->not_used->{$brik}->brik_category;
313 0 0         next unless $brik_category eq $category;
314 0 0         next unless $context->not_used->{$brik}->can('brik_tags');
315 0           my $tags = $context->not_used->{$brik}->brik_tags;
316 0           push @$tags, 'not_used';
317 0           $self->log->info(sprintf(" %-20s [%s]", $brik, join(', ', @$tags)));
318 0           $total++;
319             }
320              
321 0           return $total;
322             }
323              
324             sub list_categories {
325 0     0 0   my $self = shift;
326              
327 0 0         if (! defined($self->context)) {
328 0           return $self->log->error("list_categories: no core::context Brik");
329             }
330              
331 0           my $con = $self->context;
332 0           my $available = $con->find_available;
333              
334 0           my @categories = ();
335 0           for my $k (keys %$available) {
336 0           my @t = split(/::/, $k);
337 0 0         if (@t == 2) { # Category and Name
    0          
338 0           push @categories, $t[0];
339             }
340             elsif (@t == 3) { # Repository, Category and Name
341 0           push @categories, $t[1];
342             }
343             else { # Error
344 0           $self->log->warning("list_categories: Brik [$k] has no Category?");
345             }
346             }
347              
348 0           my %uniq = map { $_ => 1 } @categories;
  0            
349 0           return [ sort { $a cmp $b } keys %uniq ];
  0            
350             }
351              
352             1;
353              
354             __END__