File Coverage

inc/Test/Base.pm
Criterion Covered Total %
statement 243 378 64.2
branch 65 188 34.5
condition 18 83 21.6
subroutine 41 63 65.0
pod 0 29 0.0
total 367 741 49.5


line stmt bran cond sub pod time code
1             #line 1
2 2     2   285836 package Test::Base;
  2         8  
  2         161  
3 2     2   5820 use 5.006001;
  2         62  
  2         16  
4 2     2   30 use Spiffy 0.30 -Base;
  2     2   2  
  2     2   88  
  2         14  
  2         4  
  2         89  
  2         9  
  2         5  
  2         10  
5             use Spiffy ':XXX';
6             our $VERSION = '0.60';
7              
8             my @test_more_exports;
9 2     2   53 BEGIN {
10             @test_more_exports = qw(
11             ok isnt like unlike is_deeply cmp_ok
12             skip todo_skip pass fail
13             eq_array eq_hash eq_set
14             plan can_ok isa_ok diag
15             use_ok
16             $TODO
17             );
18             }
19 2     2   1894  
  2         10  
  2         26  
20 2     2   15 use Test::More import => \@test_more_exports;
  2         5  
  2         1149  
21             use Carp;
22              
23             our @EXPORT = (@test_more_exports, qw(
24             is no_diff
25              
26             blocks next_block first_block
27             delimiters spec_file spec_string
28             filters filters_delay filter_arguments
29             run run_compare run_is run_is_deeply run_like run_unlike
30             skip_all_unless_require is_deep run_is_deep
31             WWW XXX YYY ZZZ
32             tie_output no_diag_on_only
33              
34             find_my_self default_object
35              
36             croak carp cluck confess
37             ));
38              
39             field '_spec_file';
40             field '_spec_string';
41             field _filters => [qw(norm trim)];
42             field _filters_map => {};
43             field spec =>
44             -init => '$self->_spec_init';
45             field block_list =>
46             -init => '$self->_block_list_init';
47             field _next_list => [];
48             field block_delim =>
49             -init => '$self->block_delim_default';
50             field data_delim =>
51             -init => '$self->data_delim_default';
52             field _filters_delay => 0;
53             field _no_diag_on_only => 0;
54              
55             field block_delim_default => '===';
56             field data_delim_default => '---';
57              
58             my $default_class;
59             my $default_object;
60             my $reserved_section_names = {};
61 8     8 0 12  
62 8   66     50 sub default_object {
63 8         16 $default_object ||= $default_class->new;
64             return $default_object;
65             }
66              
67             my $import_called = 0;
68 2     2   19 sub import() {
69 2 50       15 $import_called = 1;
70             my $class = (grep /^-base$/i, @_)
71             ? scalar(caller)
72 2 50       9 : $_[0];
73 2         5 if (not defined $default_class) {
74             $default_class = $class;
75             }
76             # else {
77             # croak "Can't use $class after using $default_class"
78             # unless $default_class->isa($class);
79             # }
80 2 50       11  
81 2         3 unless (grep /^-base$/i, @_) {
82 2         10 my @args;
83 0 0       0 for (my $ii = 1; $ii <= $#_; ++$ii) {
84 0         0 if ($_[$ii] eq '-package') {
85             ++$ii;
86 0         0 } else {
87             push @args, $_[$ii];
88             }
89 2 50       8 }
90             Test::More->import(import => \@test_more_exports, @args)
91             if @args;
92             }
93 2         7
94 2         43 _strict_warnings();
95             goto &Spiffy::import;
96             }
97              
98             # Wrap Test::Builder::plan
99             my $plan_code = \&Test::Builder::plan;
100             my $Have_Plan = 0;
101 2     2   15 {
  2         17  
  2         8575  
102             no warnings 'redefine';
103 2     2   5 *Test::Builder::plan = sub {
104 2         9 $Have_Plan = 1;
105             goto &$plan_code;
106             };
107             }
108              
109             my $DIED = 0;
110             $SIG{__DIE__} = sub { $DIED = 1; die @_ };
111 18     18 0 20  
  18         36  
112 72     72 0 103 sub block_class { $self->find_class('Block') }
  72         158  
113             sub filter_class { $self->find_class('Filter') }
114 90     90 0 105  
115 90         104 sub find_class {
116 90         179 my $suffix = shift;
117 90 100       427 my $class = ref($self) . "::$suffix";
118 2         6 return $class if $class->can('new');
119 2 50       23 $class = __PACKAGE__ . "::$suffix";
120 2         149 return $class if $class->can('new');
121 2 50       20 eval "require $class";
122 0         0 return $class if $class->can('new');
123             die "Can't find a class for $suffix";
124             }
125 0     0 0 0  
126 0 0       0 sub check_late {
127 0         0 if ($self->{block_list}) {
128 0         0 my $caller = (caller(1))[3];
129 0         0 $caller =~ s/.*:://;
130             croak "Too late to call $caller()"
131             }
132             }
133              
134 16 100   16 0 71 sub find_my_self() {
135             my $self = ref($_[0]) eq $default_class
136             ? splice(@_, 0, 1)
137 16         44 : default_object();
138             return $self, @_;
139             }
140              
141 2     2 0 19 sub blocks() {
142             (my ($self), @_) = find_my_self(@_);
143 2 50       9  
144             croak "Invalid arguments passed to 'blocks'"
145 2 50 33     11 if @_ > 1;
146             croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
147             if @_ && $_[0] !~ /^[a-zA-Z]\w*$/;
148 2         71  
149             my $blocks = $self->block_list;
150 2   50     13
151 0         0 my $section_name = shift || '';
152 2 50       11 my @blocks = $section_name
153             ? (grep { exists $_->{$section_name} } @$blocks)
154             : (@$blocks);
155 2 50       19  
156             return scalar(@blocks) unless wantarray;
157 0 0       0
158             return (@blocks) if $self->_filters_delay;
159 0         0  
160 0 0       0 for my $block (@blocks) {
161             $block->run_filters
162             unless $block->is_filtered;
163             }
164 0         0  
165             return (@blocks);
166             }
167              
168 4     4 0 10 sub next_block() {
169 4         120 (my ($self), @_) = find_my_self(@_);
170 4 50       14 my $list = $self->_next_list;
171 4         9 if (@$list == 0) {
  4         108  
172 4         114 $list = [@{$self->block_list}, undef];
173             $self->_next_list($list);
174 4         10 }
175 4 100 66     115 my $block = shift @$list;
176 2         11 if (defined $block and not $block->is_filtered) {
177             $block->run_filters;
178 4         22 }
179             return $block;
180             }
181              
182 4     4 0 13 sub first_block() {
183 4         126 (my ($self), @_) = find_my_self(@_);
184 4         17 $self->_next_list([]);
185             $self->next_block;
186             }
187              
188 0     0 0 0 sub filters_delay() {
189 0 0       0 (my ($self), @_) = find_my_self(@_);
190             $self->_filters_delay(defined $_[0] ? shift : 1);
191             }
192              
193 0     0 0 0 sub no_diag_on_only() {
194 0 0       0 (my ($self), @_) = find_my_self(@_);
195             $self->_no_diag_on_only(defined $_[0] ? shift : 1);
196             }
197              
198 0     0 0 0 sub delimiters() {
199 0         0 (my ($self), @_) = find_my_self(@_);
200 0         0 $self->check_late;
201 0   0     0 my ($block_delimiter, $data_delimiter) = @_;
202 0   0     0 $block_delimiter ||= $self->block_delim_default;
203 0         0 $data_delimiter ||= $self->data_delim_default;
204 0         0 $self->block_delim($block_delimiter);
205 0         0 $self->data_delim($data_delimiter);
206             return $self;
207             }
208              
209 0     0 0 0 sub spec_file() {
210 0         0 (my ($self), @_) = find_my_self(@_);
211 0         0 $self->check_late;
212 0         0 $self->_spec_file(shift);
213             return $self;
214             }
215              
216 0     0 0 0 sub spec_string() {
217 0         0 (my ($self), @_) = find_my_self(@_);
218 0         0 $self->check_late;
219 0         0 $self->_spec_string(shift);
220             return $self;
221             }
222              
223 2     2 0 18 sub filters() {
224 2 50       9 (my ($self), @_) = find_my_self(@_);
225 2         60 if (ref($_[0]) eq 'HASH') {
226             $self->_filters_map(shift);
227             }
228 0         0 else {
229 0         0 my $filters = $self->_filters;
230             push @$filters, @_;
231 2         5 }
232             return $self;
233             }
234              
235 0     0 0 0 sub filter_arguments() {
236             $Test::Base::Filter::arguments;
237             }
238 0     0 0 0  
239 0 0 0     0 sub have_text_diff {
  0         0  
  0         0  
240             eval { require Text::Diff; 1 } &&
241             $Text::Diff::VERSION >= 0.35 &&
242             $Algorithm::Diff::VERSION >= 1.15;
243             }
244              
245 0     0 0 0 sub is($$;$) {
246 0         0 (my ($self), @_) = find_my_self(@_);
247 0         0 my ($actual, $expected, $name) = @_;
248 0 0 0     0 local $Test::Builder::Level = $Test::Builder::Level + 1;
      0        
      0        
      0        
      0        
249             if ($ENV{TEST_SHOW_NO_DIFFS} or
250             not defined $actual or
251             not defined $expected or
252             $actual eq $expected or
253             not($self->have_text_diff) or
254             $expected !~ /\n./s
255 0         0 ) {
256             Test::More::is($actual, $expected, $name);
257             }
258 0 0       0 else {
259 0         0 $name = '' unless defined $name;
260             ok $actual eq $expected,
261             $name . "\n" . Text::Diff::diff(\$expected, \$actual);
262             }
263             }
264              
265 0     0 0 0 sub run(&;$) {
266 0         0 (my ($self), @_) = find_my_self(@_);
267 0         0 my $callback = shift;
  0         0  
268 0 0       0 for my $block (@{$self->block_list}) {
269 0         0 $block->run_filters unless $block->is_filtered;
  0         0  
270             &{$callback}($block);
271             }
272             }
273              
274 4     4   9 my $name_error = "Can't determine section names";
275 4 50       13 sub _section_names {
276 4 50       17 return @_ if @_ == 2;
277             my $block = $self->first_block
278 8         32 or croak $name_error;
279 4 50       19 my @names = grep {
280 4         8 $_ !~ /^(ONLY|LAST|SKIP)$/;
281 4 50       24 } @{$block->{_section_order}[0] || []};
282             croak "$name_error. Need two sections in first block"
283 4         17 unless @names == 2;
284             return @names;
285             }
286 4     4   8  
287 4 50       13 sub _assert_plan {
288             plan('no_plan') unless $Have_Plan;
289             }
290 2     2   7  
291 2 0 33     22 sub END {
      33        
292             run_compare() unless $Have_Plan or $DIED or not $import_called;
293             }
294              
295 4     4 0 37 sub run_compare() {
296 4         19 (my ($self), @_) = find_my_self(@_);
297 4         16 $self->_assert_plan;
298 4         11 my ($x, $y) = $self->_section_names(@_);
299 4         6 local $Test::Builder::Level = $Test::Builder::Level + 1;
  4         112  
300 36 50 33     227 for my $block (@{$self->block_list}) {
301 36 100       1053 next unless exists($block->{$x}) and exists($block->{$y});
302 36 50       124 $block->run_filters unless $block->is_filtered;
    0          
303 36 50       93 if (ref $block->$x) {
304             is_deeply($block->$x, $block->$y,
305             $block->name ? $block->name : ());
306             }
307 0 0       0 elsif (ref $block->$y eq 'Regexp') {
308 0 0       0 my $regexp = ref $y ? $y : $block->$y;
309             like($block->$x, $regexp, $block->name ? $block->name : ());
310             }
311 0 0       0 else {
312             is($block->$x, $block->$y, $block->name ? $block->name : ());
313             }
314             }
315             }
316              
317 0     0 0 0 sub run_is() {
318 0         0 (my ($self), @_) = find_my_self(@_);
319 0         0 $self->_assert_plan;
320 0         0 my ($x, $y) = $self->_section_names(@_);
321 0         0 local $Test::Builder::Level = $Test::Builder::Level + 1;
  0         0  
322 0 0 0     0 for my $block (@{$self->block_list}) {
323 0 0       0 next unless exists($block->{$x}) and exists($block->{$y});
324 0 0       0 $block->run_filters unless $block->is_filtered;
325             is($block->$x, $block->$y,
326             $block->name ? $block->name : ()
327             );
328             }
329             }
330              
331 0     0 0 0 sub run_is_deeply() {
332 0         0 (my ($self), @_) = find_my_self(@_);
333 0         0 $self->_assert_plan;
334 0         0 my ($x, $y) = $self->_section_names(@_);
  0         0  
335 0 0 0     0 for my $block (@{$self->block_list}) {
336 0 0       0 next unless exists($block->{$x}) and exists($block->{$y});
337 0 0       0 $block->run_filters unless $block->is_filtered;
338             is_deeply($block->$x, $block->$y,
339             $block->name ? $block->name : ()
340             );
341             }
342             }
343              
344 0     0 0 0 sub run_like() {
345 0         0 (my ($self), @_) = find_my_self(@_);
346 0         0 $self->_assert_plan;
347 0         0 my ($x, $y) = $self->_section_names(@_);
  0         0  
348 0 0 0     0 for my $block (@{$self->block_list}) {
349 0 0       0 next unless exists($block->{$x}) and defined($y);
350 0 0       0 $block->run_filters unless $block->is_filtered;
351 0 0       0 my $regexp = ref $y ? $y : $block->$y;
352             like($block->$x, $regexp,
353             $block->name ? $block->name : ()
354             );
355             }
356             }
357              
358 0     0 0 0 sub run_unlike() {
359 0         0 (my ($self), @_) = find_my_self(@_);
360 0         0 $self->_assert_plan;
361 0         0 my ($x, $y) = $self->_section_names(@_);
  0         0  
362 0 0 0     0 for my $block (@{$self->block_list}) {
363 0 0       0 next unless exists($block->{$x}) and defined($y);
364 0 0       0 $block->run_filters unless $block->is_filtered;
365 0 0       0 my $regexp = ref $y ? $y : $block->$y;
366             unlike($block->$x, $regexp,
367             $block->name ? $block->name : ()
368             );
369             }
370             }
371              
372 0     0 0 0 sub skip_all_unless_require() {
373 0         0 (my ($self), @_) = find_my_self(@_);
374 0 0       0 my $module = shift;
375             eval "require $module; 1"
376             or Test::More::plan(
377             skip_all => "$module failed to load"
378             );
379             }
380              
381 0     0 0 0 sub is_deep() {
382 0         0 (my ($self), @_) = find_my_self(@_);
383 0         0 require Test::Deep;
384             Test::Deep::cmp_deeply(@_);
385             }
386              
387 0     0 0 0 sub run_is_deep() {
388 0         0 (my ($self), @_) = find_my_self(@_);
389 0         0 $self->_assert_plan;
390 0         0 my ($x, $y) = $self->_section_names(@_);
  0         0  
391 0 0 0     0 for my $block (@{$self->block_list}) {
392 0 0       0 next unless exists($block->{$x}) and exists($block->{$y});
393 0 0       0 $block->run_filters unless $block->is_filtered;
394             is_deep($block->$x, $block->$y,
395             $block->name ? $block->name : ()
396             );
397             }
398             }
399 2     2   4  
400 2         5 sub _pre_eval {
401 2 50       16 my $spec = shift;
402             return $spec unless $spec =~
403 0         0 s/\A\s*<<<(.*?)>>>\s*$//sm;
404 0         0 my $eval_code = $1;
405 0 0       0 eval "package main; $eval_code";
406 0         0 croak $@ if $@;
407             return $spec;
408             }
409 2     2   5  
410 2         53 sub _block_list_init {
411 2         9 my $spec = $self->spec;
412 2         61 $spec = $self->_pre_eval($spec);
413 2         194 my $cd = $self->block_delim;
414 2         14 my @hunks = ($spec =~ /^(\Q${cd}\E.*?(?=^\Q${cd}\E|\z))/msg);
415 2         58 my $blocks = $self->_choose_blocks(@hunks);
416 2         4 $self->block_list($blocks); # Need to set early for possible filter use
417 2         4 my $seq = 1;
418 18         360 for my $block (@$blocks) {
419 18         369 $block->blocks_object($self);
420             $block->seq_num($seq++);
421 2         12 }
422             return $blocks;
423             }
424 2     2   5  
425 2         4 sub _choose_blocks {
426 2         6 my $blocks = [];
427 18         33 for my $hunk (@_) {
428 18 50       37 my $block = $self->_make_block($hunk);
429 0 0       0 if (exists $block->{ONLY}) {
430             diag "I found ONLY: maybe you're debugging?"
431 0         0 unless $self->_no_diag_on_only;
432             return [$block];
433 18 50       34 }
434 18         24 next if exists $block->{SKIP};
435 18 50       40 push @$blocks, $block;
436 0         0 if (exists $block->{LAST}) {
437             return $blocks;
438             }
439 2         5 }
440             return $blocks;
441             }
442 36     36   38  
443 36         38 sub _check_reserved {
444 36 50 33     152 my $id = shift;
445             croak "'$id' is a reserved name. Use something else.\n"
446             if $reserved_section_names->{$id} or
447             $id =~ /^_/;
448             }
449 18     18   21  
450 18         20 sub _make_block {
451 18         407 my $hunk = shift;
452 18         380 my $cd = $self->block_delim;
453 18         36 my $dd = $self->data_delim;
454 18 50       136 my $block = $self->block_class->new;
455 18         35 $hunk =~ s/\A\Q${cd}\E[ \t]*(.*)\s+// or die;
456 18         176 my $name = $1;
457 18         27 my @parts = split /^\Q${dd}\E +\(?(\w+)\)? *(.*)?\n/m, $hunk;
458 18   50     62 my $description = shift @parts;
459 18 50       32 $description ||= '';
460 18         30 unless ($description =~ /\S/) {
461             $description = $name;
462 18         84 }
463 18         39 $description =~ s/\s*\z//;
464             $block->set_value(description => $description);
465 18         23
466 18         26 my $section_map = {};
467 18         35 my $section_order = [];
468 36         64 while (@parts) {
469 36         70 my ($type, $filters, $value) = splice(@parts, 0, 3);
470 36 50       56 $self->_check_reserved($type);
471 36 50       57 $value = '' unless defined $value;
472 36 100       121 $filters = '' unless defined $filters;
473 18 50       53 if ($filters =~ /:(\s|\z)/) {
474             croak "Extra lines not allowed in '$type' section"
475 18         71 if $value =~ /\S/;
476 18 50       39 ($filters, $value) = split /\s*:(?:\s+|\z)/, $filters, 2;
477 18         101 $value = '' unless defined $value;
478             $value =~ s/^\s*(.*?)\s*$/$1/;
479 36         89 }
480             $section_map->{$type} = {
481             filters => $filters,
482 36         53 };
483 36         62 push @$section_order, $type;
484             $block->set_value($type, $value);
485 18         28 }
486 18         31 $block->set_value(name => $name);
487 18         34 $block->set_value(_section_map => $section_map);
488 18         51 $block->set_value(_section_order => $section_order);
489             return $block;
490             }
491 2     2   6  
492 2 50       57 sub _spec_init {
493             return $self->_spec_string
494 2         7 if $self->_spec_string;
495 2         3 local $/;
496 2 50       59 my $spec;
497 0 0       0 if (my $spec_file = $self->_spec_file) {
498 0         0 open FILE, $spec_file or die $!;
499 0         0 $spec = <FILE>;
500             close FILE;
501             }
502 2         5 else {
503             $spec = do {
504 2     2   20 package main;
  2         5  
  2         1017  
505 2         38 no warnings 'once';
506             <DATA>;
507             };
508 2         14 }
509             return $spec;
510             }
511              
512 2     2   11 sub _strict_warnings() {
513 2         5 require Filter::Util::Call;
514             my $done = 0;
515             Filter::Util::Call::filter_add(
516 2 50   2   9 sub {
517 2         4 return 0 if $done;
518 2         23 my ($data, $end) = ('', '');
519 65 50       106 while (my $status = Filter::Util::Call::filter_read()) {
520 65 100       132 return $status if $status < 0;
521 2         6 if (/^__(?:END|DATA)__\r?$/) {
522 2         4 $end = $_;
523             last;
524 63         71 }
525 63         266 $data .= $_;
526             $_ = '';
527 2         9 }
528 2         49 $_ = "use strict;use warnings;$data$end";
529             $done = 1;
530 2         16 }
531             );
532             }
533              
534 0     0 0 0 sub tie_output() {
535 0 0       0 my $handle = shift;
536 0         0 die "No buffer to tie" unless @_;
537             tie *$handle, 'Test::Base::Handle', $_[0];
538             }
539 0     0 0 0  
540 0         0 sub no_diff {
541             $ENV{TEST_SHOW_NO_DIFFS} = 1;
542             }
543              
544             package Test::Base::Handle;
545              
546 0     0   0 sub TIEHANDLE() {
547 0         0 my $class = shift;
548             bless \ $_[0], $class;
549             }
550 0     0   0  
551 0         0 sub PRINT {
552             $$self .= $_ for @_;
553             }
554              
555             #===============================================================================
556             # Test::Base::Block
557             #
558             # This is the default class for accessing a Test::Base block object.
559             #===============================================================================
560             package Test::Base::Block;
561             our @ISA = qw(Spiffy);
562              
563             our @EXPORT = qw(block_accessor);
564 0     0   0  
565 0         0 sub AUTOLOAD {
566             return;
567             }
568              
569 12     12   18 sub block_accessor() {
570 2     2   13 my $accessor = shift;
  2         3  
  2         554  
571 12 50       53 no strict 'refs';
572             return if defined &$accessor;
573 252     252   316 *$accessor = sub {
574 252 50       462 my $self = shift;
575 0         0 if (@_) {
576             Carp::croak "Not allowed to set values for '$accessor'";
577 252 50       260 }
  252         1076  
578             my @list = @{$self->{$accessor} || []};
579 252 100       1000 return wantarray
580             ? (@list)
581 12         85 : $list[0];
582             };
583             }
584              
585             block_accessor 'name';
586             block_accessor 'description';
587             Spiffy::field 'seq_num';
588             Spiffy::field 'is_filtered';
589             Spiffy::field 'blocks_object';
590             Spiffy::field 'original_values' => {};
591 198     198   231  
592 2     2   11 sub set_value {
  2         6  
  2         461  
593 198         221 no strict 'refs';
594 198 100       451 my $accessor = shift;
595             block_accessor $accessor
596 198         723 unless defined &$accessor;
597             $self->{$accessor} = [@_];
598             }
599 18     18   31  
600 18         49 sub run_filters {
601 18         42 my $map = $self->_section_map;
602 18 50       443 my $order = $self->_section_order;
603             Carp::croak "Attempt to filter a block twice"
604 18         36 if $self->is_filtered;
605 36         114 for my $type (@$order) {
606 36         331 my $filters = $map->{$type}{filters};
607 36         1139 my @value = $self->$type;
608 36         136 $self->original_values->{$type} = $value[0];
609 90 50       204 for my $filter ($self->_get_filters($type, $filters)) {
610             $Test::Base::Filter::arguments =
611 90         138 $filter =~ s/=(.*)$// ? $1 : undef;
612 2     2   13 my $function = "main::$filter";
  2         4  
  2         1273  
613 90 100       419 no strict 'refs';
614 18 50 33     120 if (defined &$function) {
615             local $_ =
616             (@value == 1 and not defined($value[0])) ? undef :
617 18         31 join '', @value;
618 18         61 my $old = $_;
619 18 50 33     264 @value = &$function(@value);
      33        
      33        
620             if (not(@value) or
621             @value == 1 and defined($value[0]) and $value[0] =~ /\A(\d+|)\z/
622 0 0 0     0 ) {
623 0         0 if ($value[0] && $_ eq $old) {
624             Test::Base::diag("Filters returning numbers are supposed to do munging \$_: your filter '$function' apparently doesn't.");
625 0         0 }
626             @value = ($_);
627             }
628             }
629 72         3060 else {
630 72 50       207 my $filter_object = $self->blocks_object->filter_class->new;
631             die "Can't find a function or method for '$filter' filter\n"
632 72         2232 unless $filter_object->can($filter);
633 72         236 $filter_object->current_block($self);
634             @value = $filter_object->$filter(@value);
635             }
636             # Set the value after each filter since other filters may be
637 90         434 # introspecting.
638             $self->set_value($type, @value);
639             }
640 18         455 }
641             $self->is_filtered(1);
642             }
643 36     36   53  
644 36         49 sub _get_filters {
645 36   50     136 my $type = shift;
646 36         151 my $string = shift || '';
647 36         62 $string =~ s/\s*(.*?)\s*/$1/;
648 36   100     863 my @filters = ();
649 36 50       96 my $map_filters = $self->blocks_object->_filters_map->{$type} || [];
650 36         51 $map_filters = [ $map_filters ] unless ref $map_filters;
651 36         41 my @append = ();
652 36         823 for (
653             @{$self->blocks_object->_filters},
654             @$map_filters,
655             split(/\s+/, $string),
656 90         292 ) {
657 90 50       163 my $filter = $_;
658 90 50       438 last unless length $filter;
    50          
659 0         0 if ($filter =~ s/^-//) {
  0         0  
660             @filters = grep { $_ ne $filter } @filters;
661             }
662 0         0 elsif ($filter =~ s/^\+//) {
663             push @append, $filter;
664             }
665 90         177 else {
666             push @filters, $filter;
667             }
668 36         132 }
669             return @filters, @append;
670             }
671              
672             {
673             %$reserved_section_names = map {
674             ($_, 1);
675             } keys(%Test::Base::Block::), qw( new DESTROY );
676             }
677              
678             __DATA__
679              
680             =encoding utf8
681              
682             #line 1374