File Coverage

blib/lib/HTML/Mason/Tests.pm
Criterion Covered Total %
statement 221 254 87.0
branch 92 154 59.7
condition 22 51 43.1
subroutine 36 38 94.7
pod 8 12 66.6
total 379 509 74.4


line stmt bran cond sub pod time code
1             package HTML::Mason::Tests;
2             $HTML::Mason::Tests::VERSION = '1.60';
3 27     27   17111 use strict;
  27         190  
  27         737  
4 27     27   1933 use warnings;
  27         41  
  27         619  
5              
6 27     27   125 use Cwd;
  27         43  
  27         1931  
7              
8 27     27   179 use File::Path;
  27         50  
  27         1878  
9 27     27   161 use File::Spec;
  27         54  
  27         520  
10              
11 27     27   10541 use HTML::Mason;
  27         193  
  27         2008  
12 27     27   21246 use HTML::Mason::Compiler::ToObject;
  27         93  
  27         962  
13              
14 27     27   21815 use Getopt::Long;
  27         293847  
  27         144  
15              
16 27     27   23096 use Test::Builder ();
  27         1595948  
  27         1090  
17              
18 27     27   263 use vars qw($VERBOSE $DEBUG @SHARED);
  27         3611  
  27         108708  
19              
20             my $Test = Test::Builder->new;
21              
22             $VERBOSE = $ENV{MASON_DEBUG} || $ENV{MASON_VERBOSE} || $ENV{TEST_VERBOSE};
23             $DEBUG = $ENV{MASON_DEBUG};
24              
25             $| = 1;
26              
27             @SHARED = ( { path => '/shared/check_error',
28             component => <<'EOF',
29             <% ($error) ? "Error: $error" : "No error!?" %>
30             <%init>
31             if ($error) {
32             my @lines = split("\n",$error);
33             $error = join("\n",@lines[0..$lines-1]);
34             $error =~ s{\s+at .*}{}g;
35             }
36            
37             <%args>
38             $error
39             $lines=>1
40            
41             EOF
42             },
43             { path => '/shared/display_comp_obj',
44             component => <<'EOF',
45             Declared args:
46             % my %decl = %{$comp->declared_args};
47             % foreach (sort keys %decl) {
48             <% $_ %><% (defined($decl{$_}->{default})) ? "=>".$decl{$_}->{default} : "" %>
49             % }
50              
51             I am <% $comp->is_subcomp ? '' : 'not ' %>a subcomponent.
52             I am <% $comp->is_method ? '' : 'not ' %>a method.
53             I am <% $comp->is_file_based ? '' : 'not ' %>file-based.
54             % if (defined($comp->name)) {
55             My short name is <% $comp->name =~ /anon/ ? '[anon something]' : $comp->name %>.
56             % }
57             % if ($comp->is_subcomp and defined($comp->owner)) {
58             My parent component is <% $comp->owner->title %>.
59             % }
60             % if (defined($comp->dir_path)) {
61             My directory is <% $comp->dir_path %>.
62             % }
63             % my @subkeys = sort keys(%{$comp->subcomps});
64             I have <% scalar(@subkeys) %> subcomponent(s).
65             % if (@subkeys) {
66             Including one called <% $comp->subcomps($subkeys[0])->name %>.
67             % }
68             My title is <% $comp->title =~ /anon/ ? '[anon something]' : $comp->title %>.
69              
70             % if (defined($comp->path)) {
71             My path is <% $comp->path %>.
72             % }
73             % if (defined($comp->comp_id)) {
74             My comp_id is <% $comp->comp_id =~ /anon/ ? '[anon something]' : $comp->comp_id %>.
75             % }
76             <%args>
77             $comp
78            
79             EOF
80             },
81             { path => '/shared/display_req_obj',
82             component => <<'EOF',
83             My depth is <% $m->depth %>.
84              
85             I <% $m->is_subrequest ? 'am' : 'am not' %> a subrequest.
86              
87             The top-level component is <% $m->request_comp->title %>.
88              
89             My stack looks like:
90             -----
91             % foreach my $comp ($m->callers) {
92             <% $comp->title %>
93             % }
94             -----
95              
96             EOF
97             },
98             );
99              
100             #
101             # Get command options here so that we read tests_class before user
102             # calls new().
103             #
104             my %cmd_options;
105             GetOptions( 'create' => \$cmd_options{create},
106             'tests-to-run=s' => \$cmd_options{tests_to_run},
107             'tests-to-skip=s' => \$cmd_options{tests_to_skip},
108             'tests-class=s' => \$cmd_options{tests_class},
109             );
110              
111             #
112             # Allow options to be passed in the environment as well.
113             #
114             $cmd_options{tests_to_run} = $ENV{MASON_TESTS_TO_RUN}
115             if !defined($cmd_options{tests_to_run}) and defined($ENV{MASON_TESTS_TO_RUN});
116             $cmd_options{tests_to_skip} = $ENV{MASON_TESTS_TO_SKIP}
117             if !defined($cmd_options{tests_to_skip}) and defined($ENV{MASON_TESTS_TO_SKIP});
118             $cmd_options{tests_class} = $ENV{MASON_TESTS_CLASS}
119             if !defined($cmd_options{tests_class}) and defined($ENV{MASON_TESTS_CLASS});
120              
121             # If user specifies tests_class, load that package; otherwise,
122             # default it to this package.
123             if (defined($cmd_options{tests_class})) {
124             eval "use $cmd_options{tests_class}";
125             die $@ if $@;
126             } else {
127             $cmd_options{tests_class} = __PACKAGE__;
128             }
129              
130             my %tests_to_run;
131             if ($cmd_options{tests_to_run}) {
132             for ($cmd_options{tests_to_run}) { s/^\s+//; s/\s+$// }
133             my @tests_to_run = split(/\s*,\s*/, $cmd_options{tests_to_run});
134             if (grep { /[^0-9]/ } @tests_to_run) {
135             @tests_to_run = sort { $a cmp $b } @tests_to_run;
136             } else {
137             @tests_to_run = sort { $a <=> $b } @tests_to_run;
138             }
139             %tests_to_run = map { ($_, 1) } @tests_to_run;
140             $Test->diag(sprintf("Running only test%s %s\n", @tests_to_run == 1 ? "" : "s", join(", ", @tests_to_run)))
141             }
142              
143             my %tests_to_skip;
144             if ($cmd_options{tests_to_skip}) {
145             for ($cmd_options{tests_to_skip}) { s/^\s+//; s/\s+$// }
146             my @tests_to_skip = split(/\s*,\s*/, $cmd_options{tests_to_skip});
147             %tests_to_skip = map { ($_, 1) } @tests_to_skip;
148             $Test->diag(printf ("Skipping test%s %s\n", @tests_to_skip == 1 ? "" : "s", join(", ", @tests_to_skip)));
149             }
150              
151             sub new
152             {
153 26     26 1 143 my $class = shift;
154 26         295 my %p = (@_, %cmd_options);
155              
156             die "No group name provided\n"
157 26 50       164 unless exists $p{name};
158              
159             die "No description for test group provided\n"
160 26 50       140 unless exists $p{description};
161              
162             $p{pre_test_cleanup} = 1
163 26 100       135 unless exists $p{pre_test_cleanup};
164              
165 26         301 return bless {
166             %p,
167             support => [],
168             tests => [],
169             }, $class;
170             }
171              
172             # Returns the tests class to use for class methods - defaults to this package.
173             sub tests_class
174             {
175 34     34 0 47409 return $cmd_options{tests_class};
176             }
177              
178             sub add_support
179             {
180 146     146 1 829 my $self = shift;
181 146         518 my %p = @_;
182              
183             die "'support' key array member contains no 'path' key\n"
184 146 50       358 unless exists $p{path};
185              
186             die "'support' key array member contains no 'component' key\n"
187 146 50       290 unless exists $p{component};
188              
189 146         209 push @{ $self->{support} }, \%p;
  146         505  
190             }
191              
192             sub add_test
193             {
194 389     389 1 3780 my $self = shift;
195 389         2037 my %p = @_;
196              
197             die "no name provided for test\n"
198 389 50       905 unless exists $p{name};
199              
200 389 100       778 unless ( exists $p{path} )
201             {
202 355   66     1213 $p{path} = $p{call_path} || $p{name};
203             }
204              
205 389         821 my $call_path = "/$self->{name}";
206 389 100       780 if ( exists $p{call_path} )
207             {
208 59 100       187 $call_path .= '/' unless substr( $p{call_path}, 0, 1 ) eq '/';
209 59         108 $call_path .= $p{call_path};
210             }
211             else
212             {
213 330         779 $call_path .= '/' . $p{name};
214             }
215 389         643 $p{call_path} = $call_path;
216              
217 389 100       1004 if ( ref($p{call_args}) eq 'HASH' )
    100          
218             {
219 5         22 my @lst = %{$p{call_args}};
  5         29  
220 5         17 $p{call_args} = \@lst;
221             }
222             elsif ( !exists($p{call_args}) ) {
223 381         701 $p{call_args} = [];
224             }
225              
226             die "'$p{name}' test has no description\n"
227 389 50       824 unless exists $p{description};
228              
229             die "'$p{name}' test has no component\n"
230 389 50 66     767 unless exists $p{component} || $p{skip_component};
231              
232             die "'$p{name}' test has no 'expect' or 'expect_error' key\n"
233 389 0 66     912 unless exists $p{expect} || exists $p{expect_error} || $p{skip_expect} || $self->{create};
      33        
      0        
234              
235 389         689 foreach ( qw( interp_params ) )
236             {
237             die "$_ must be a hash reference"
238 389 50 66     1273 if exists $p{$_} && ! UNIVERSAL::isa( $p{$_}, 'HASH' );
239             }
240              
241 389         504 push @{ $self->{tests} }, \%p;
  389         1389  
242             }
243              
244             sub run
245             {
246 25     25 1 349 my $self = shift;
247              
248             die "No tests exist in this group"
249 25 50       80 unless @{ $self->{tests} };
  25         187  
250              
251 25 50       140 if ($DEBUG)
252             {
253 0 0       0 $Test->diag( "Will " . ( $self->{create} ? '' : 'not ' ) . "create 'expect' files\n" );
254             }
255              
256             eval
257 25         92 {
258             # 1 indicates to be silent on missing directories
259 25 100       302 $self->_cleanup(1) if $self->{pre_test_cleanup};
260 25         401 $self->_make_dirs;
261 25         405 $self->_write_shared_comps;
262 25         323 $self->_write_support_comps;
263 25         284 $self->_run_tests;
264             };
265              
266 25 50       839 $self->_cleanup unless $ENV{MASON_NO_CLEANUP};
267              
268 25 50       5977 die $@ if $@;
269             }
270              
271             sub _make_dirs
272             {
273 25     25   217 my $self = shift;
274              
275 25         321 my $comp_root = $self->comp_root;
276 25         354 my $data_dir = $self->data_dir;
277              
278 25 50       247 unless ( -d $self->comp_root )
279             {
280 25 50       366 $Test->diag( "Making comp_root directory: $comp_root\n" ) if $DEBUG;
281 25 50       426 mkpath( $self->comp_root, 0, 0755 )
282             or die "Unable to make base test directory '$comp_root': $!";
283             }
284              
285 25 100       355 unless ( -d $self->data_dir )
286             {
287 24 50       259 $Test->diag( "Making data_dir directory: $data_dir\n" ) if $DEBUG;
288 24 50       222 mkpath( $self->data_dir, 0, 0755 )
289             or die "Unable to make base test directory '$data_dir': $!";
290             }
291             }
292              
293             sub base_path
294             {
295 1600     1600 1 2413 my $proto = shift;
296              
297 1600 100       3810 if (ref $proto)
298             {
299 1596   66     108099 $proto->{base_path} ||= File::Spec->catdir( cwd(), 'mason_tests', $$ );
300 1596         35128 return $proto->{base_path};
301             }
302             else
303             {
304 4         16165 return File::Spec->catdir( cwd(), 'mason_tests', $$ );
305             }
306             }
307              
308             sub comp_root
309             {
310 1098     1098 1 2308 my $proto = shift;
311              
312 1098         2674 return File::Spec->catdir( $proto->base_path, 'comps' );
313             }
314              
315             sub data_dir
316             {
317 451     451 1 1035 my $proto = shift;
318              
319 451         1097 return File::Spec->catdir( $proto->base_path, 'data' );
320             }
321              
322             sub _write_shared_comps
323             {
324 25     25   160 my $self = shift;
325              
326 25 50       304 return unless @SHARED;
327              
328 25         276 foreach my $comp ( @SHARED )
329             {
330 75         688 my @path = split m(/), $comp->{path};
331 75         289 my $file = pop @path;
332              
333 75         330 my $dir = File::Spec->catdir( $self->comp_root, @path );
334              
335 75         596 $self->write_comp( $comp->{path}, $dir, $file, $comp->{component} );
336             }
337             }
338              
339             sub _write_support_comps
340             {
341 25     25   142 my $self = shift;
342              
343 25 100       102 unless ( @{ $self->{support} } )
  25         254  
344             {
345 5 50       54 $Test->diag( "No support comps to create\n" ) if $DEBUG;
346 5         32 return;
347             }
348              
349 20         88 foreach my $supp ( @{ $self->{support} } )
  20         173  
350             {
351 146         953 my @path = split m(/), $supp->{path};
352 146         395 my $file = pop @path;
353              
354 146         570 my $dir = File::Spec->catdir( $self->comp_root, $self->{name}, @path );
355              
356 146         583 $self->write_comp( $supp->{path}, $dir, $file, $supp->{component} );
357             }
358             }
359              
360             sub _write_test_comp
361             {
362 370     370   623 my $self = shift;
363 370         654 my $test = $self->{current_test};
364              
365 370         1641 my @path = split m(/), $test->{path};
366 370         872 my $file = pop @path;
367              
368 370         1037 my $dir = File::Spec->catdir( $self->comp_root, $self->{name}, @path );
369 370 100       7238 unless ( -d $dir )
370             {
371 8 50       98 $Test->diag( "Making dir: $dir\n" ) if $DEBUG;
372 8 50       1161 mkpath( $dir, 0, 0755 )
373             or die "Unable to create directory '$dir': $!";
374             }
375              
376 370         1987 $self->write_comp( $test->{path}, $dir, $file, $test->{component} );
377             }
378              
379             sub write_comp
380             {
381 593     593 0 1204 my $self = shift;
382 593         3241 my ($path, $dir, $file, $component) = @_;
383              
384 593 100       8447 unless (-d $dir)
385             {
386 85 50       456 $Test->diag( "Making dir: $dir\n" ) if $DEBUG;
387 85 50       14150 mkpath( $dir, 0, 0755 )
388             or die "Unable to create directory '$dir': $!";
389             }
390              
391 593         7238 my $real_file = File::Spec->catfile( $dir, $file );
392              
393 593 50       2178 $Test->diag( "Making component $path at $real_file\n" )
394             if $DEBUG;
395              
396 593 50       46245 open my $fh, ">$real_file"
397             or die "Unable to write to '$real_file': $!";
398 593 50       8899 print $fh $component
399             or die "Unable to write to '$real_file': $!";
400 593 50       25036 close $fh
401             or die "Unable to write to '$real_file': $!";
402             }
403              
404             sub _run_tests
405             {
406 25     25   127 my $self = shift;
407              
408 25         108 my $count = scalar @{ $self->{tests} };
  25         430  
409 25         791 $Test->plan( tests => $count );
410              
411 25 50       42109 if ($VERBOSE)
412             {
413 0         0 $Test->diag( "Running $self->{name} tests ($count tests): $self->{description}\n" );
414             }
415              
416 25         133 my $x = 1;
417 25         75 foreach my $test ( @{ $self->{tests} } )
  25         225  
418             {
419 389         1152 $self->{current_test} = $test;
420              
421             #
422             # If tests_to_run or tests_to_skip were specified in the
423             # environment or command line, check them to see whether to
424             # run the test.
425             #
426 389 50 33     2216 if (%tests_to_run or %tests_to_skip) {
427              
428             # Look for any of the specs [test_file_name:](test_number|test_name|*)
429 0         0 my $wildcard_name = join(":", $self->{name}, "*");
430 0         0 my $full_name = join(":", $self->{name}, $test->{name});
431 0         0 my $full_number = join(":", $self->{name}, $x);
432 0         0 my @all_specs = ($x, $test->{name}, $full_name, $full_number, $wildcard_name);
433              
434             # If our test isn't mentioned in %tests_to_run or is
435             # mentioned in %tests_to_skip, skip it.
436             #
437 0 0 0     0 if ((%tests_to_run and !(grep { $tests_to_run{$_} } @all_specs))
  0   0     0  
      0        
438 0         0 or (%tests_to_skip and (grep { $tests_to_skip{$_} } @all_specs))) {
439              
440             # Use presence of PERL_DL_NONLAZY to decide if we are
441             # running inside "make test", and if so, actually
442             # print the appropriate skip response to comply with the
443             # Test::Harness standard. If the user is running the
444             # test by hand, this would just be clutter.
445             #
446             # Checking PERL_DL_NONLAZY is a hack but I don't
447             # know of a better detection method.
448             #
449 0 0       0 $self->_skip if ($ENV{PERL_DL_NONLAZY});
450 0         0 $x++;
451 0         0 next;
452             }
453             }
454 389 50       1053 $Test->diag( "Running $test->{name} (#$x): $test->{description}\n" ) if $VERBOSE;
455 389 100       2068 $self->_make_component unless $test->{skip_component};
456 389         2002 $self->_run_test;
457 389         163460 $x++;
458             }
459             }
460              
461             sub _make_component
462             {
463 370     370   745 my $self = shift;
464 370         673 my $test = $self->{current_test};
465 370         1047 $self->_write_test_comp;
466             }
467              
468             sub _make_main_interp
469             {
470 382     382   635 my $self = shift;
471 382         691 my $test = $self->{current_test};
472 382 100       1174 return $test->{interp} if $test->{interp};
473              
474             my %interp_params = ( exists $test->{interp_params} ?
475 366 100       1129 %{ $test->{interp_params} } :
  115         2560  
476             () );
477              
478 366 50 33     1147 if ($DEBUG && %interp_params)
479             {
480 0         0 $Test->diag( "Interp params:\n" );
481 0         0 while ( my ($k, $v) = each %interp_params)
482             {
483 0         0 $Test->diag( " $k => $v\n" );
484             }
485             }
486              
487 366         993 return $self->_make_interp ( comp_root => $self->comp_root,
488             data_dir => $self->data_dir,
489             %interp_params );
490             }
491              
492             sub _make_interp
493             {
494 376     376   1884 my ($class, %interp_params) = @_;
495              
496 376         3253 return HTML::Mason::Interp->new( %interp_params );
497             }
498              
499             sub _run_test
500             {
501 382     382   832 my $self = shift;
502 382         787 my $test = $self->{current_test};
503              
504 382         992 $self->{buffer} = '';
505 382         977 my $interp = $self->_make_main_interp;
506 382 50   565   2801 $interp->out_method( sub { for (@_) { $self->{buffer} .= $_ if defined $_ } } );
  565         1128  
  565         1910  
507              
508 382         856 my $warnings = '';
509 382     10   2787 local $SIG{__WARN__} = sub { $warnings .= $_ for @_ };
  10         90  
510 382         985 eval {
511             # Run pre_code if test has it - pass in interp
512 382 100       1268 if ($test->{pre_code}) {
513 18         71 $test->{pre_code}->($interp);
514             }
515 379         1122 $self->_execute($interp);
516             };
517              
518 382         4882 return $self->check_result($@, $warnings);
519             }
520              
521             sub _execute
522             {
523 379     379   813 my ($self, $interp) = @_;
524 379         673 my $test = $self->{current_test};
525              
526 379 50       987 $Test->diag( "Calling $test->{name} test with path: $test->{call_path}\n" ) if $DEBUG;
527 379 100       1255 $test->{pretest_code}->() if $test->{pretest_code};
528 379         1120 $interp->exec( $test->{call_path}, @{$test->{call_args}} );
  379         1946  
529             }
530              
531             sub check_result {
532 389     389 0 1205 my ($self, $error, $warnings) = @_;
533 389         848 my $test = $self->{current_test};
534              
535             local $HTML::Mason::Tests::TODO = $self->{current_test}{todo}
536 389 50       1171 if exists $self->{current_test}{todo};
537 389 50       949 $Test->todo if exists $self->{current_test}{todo};
538              
539 389 100       1263 if ($error)
    50          
540             {
541 74 50       529 if ( $test->{expect_error} )
542             {
543 74 50       975 if ( $error =~ /$test->{expect_error}/ )
544             {
545 74         374 return $self->_success
546             }
547             else
548             {
549 0 0       0 if ($VERBOSE)
550             {
551 0         0 $Test->diag( "Got error:\n$error\n...but expected something matching:\n$test->{expect_error}\n" );
552             }
553 0         0 return $self->_fail;
554             }
555             }
556             else
557             {
558 0 0       0 $Test->diag( "Unexpected error running $test->{name}:\n$error" ) if $VERBOSE;
559 0         0 return $self->_fail;
560             }
561              
562             }
563             elsif ( $test->{expect_error} )
564             {
565 0 0       0 $Test->diag( "Expected an error matching '$test->{expect_error}' but no error occurred - got successful output:\n$self->{buffer}\n" ) if $VERBOSE;
566 0         0 return $self->_fail;
567             }
568              
569 315 50       826 if ($self->{create})
570             {
571 0         0 $Test->diag( "Results for $test->{name}:\n$self->{buffer}\n" );
572 0         0 return;
573             }
574              
575             my $success =
576             ( $test->{skip_expect} ?
577             1 :
578             $self->check_output( actual => $self->{buffer}, expect => $test->{expect} )
579 315 50       1324 );
580              
581 315 100       904 if ( $test->{expect_warnings} )
582             {
583 5 50       95 unless ( $warnings =~ /$test->{expect_warnings}/ )
584             {
585 0         0 $Test->diag( "Got warnings:\n$warnings\n...but expected something matching:\n$test->{expect_warnings}\n" );
586 0         0 $success = 0;
587             }
588             }
589              
590 315 50 33     758 $Test->diag( "Got warnings: $warnings" ) if $warnings && ( ! $test->{expect_warnings} || $VERBOSE );
      66        
591 315 50 66     1005 $success = 0 if $test->{no_warnings} && $warnings;
592              
593 315 50       1027 $success ? $self->_success : $self->_fail;
594             }
595              
596             sub check_output
597             {
598 315     315 1 1640 my ($self, %p) = @_;
599              
600 315         583 my $same;
601              
602             # Allow a regex for $p{expect}
603 315 100       803 if (ref $p{expect}) {
604 11         235 $same = ($p{actual} =~ /$p{expect}/);
605              
606             } else {
607             # Whitespace at end can vary. (Or rather, it is varying in the tests, and
608             # should be made not to vary, but I don't have time to fix it yet.)
609              
610 304         717 for ($p{actual}, $p{expect}) { s/\s+$// }
  608         4470  
611 304         912 $same = ($p{actual} eq $p{expect});
612             }
613              
614 315 0 33     843 if (!$same and $VERBOSE) {
615 0         0 $Test->diag( "Got ...\n-----\n$p{actual}\n-----\n ... but expected ...\n-----\n$p{expect}\n-----\n" );
616             }
617 315         986 return $same;
618             }
619              
620             sub _fail
621             {
622 0     0   0 my $self = shift;
623 0         0 my $test = $self->{current_test};
624              
625 0         0 $Test->ok( 0, $test->{name} );
626             }
627              
628             sub _success
629             {
630 389     389   669 my $self = shift;
631 389         663 my $test = $self->{current_test};
632              
633 389         1950 $Test->ok( 1, $test->{name} );
634             }
635              
636             sub _skip
637             {
638 0     0   0 my $self = shift;
639 0         0 my $test = $self->{current_test};
640              
641 0         0 $Test->skip;
642             }
643              
644             #
645             # We use our own rm_tree, rather than File::Path::rmtree, so that we
646             # can silently fail to entirely remove directories. On some systems
647             # .nfs files prevent total removal of directories but should not
648             # otherwise interfere with tests.
649             #
650             sub rm_tree {
651 1679     1679 0 3898 my ($path, $debug, $silent) = @_;
652 1679         3828 $path =~ s#/$##;
653 1679 100       39689 if (-d $path) {
    100          
654 527         1968 local *DIR;
655 527 50       13758 opendir DIR, $path or warn "Can't open $path: $!";
656 527         15489 while (defined(my $file = readdir DIR)) {
657 2684 100 100     14091 next if $file eq '.' or $file eq '..';
658 1630         5605 rm_tree("$path/$file");
659             }
660 527         6619 closedir DIR;
661 527         24100 rmdir $path;
662             } elsif (-f $path) {
663 1129         64706 unlink $path;
664             } else {
665 23 50       437 $Test->diag( "Can't find $path to remove" )
666             unless $silent;
667             }
668             }
669              
670             sub _cleanup
671             {
672 49     49   152 my $self = shift;
673              
674 49         196 rm_tree( $self->base_path, $DEBUG, @_ );
675             }
676              
677             1;
678              
679             __END__