1package Test::Builder::Module;
2
3use Test::Builder;
4
5require Exporter;
6@ISA = qw(Exporter);
7
8$VERSION = '0.02';
9
10use strict;
11
12# 5.004's Exporter doesn't have export_to_level.
13my $_export_to_level = sub {
14      my $pkg = shift;
15      my $level = shift;
16      (undef) = shift;                  # redundant arg
17      my $callpkg = caller($level);
18      $pkg->export($callpkg, @_);
19};
20
21
22=head1 NAME
23
24Test::Builder::Module - Base class for test modules
25
26=head1 SYNOPSIS
27
28  # Emulates Test::Simple
29  package Your::Module;
30
31  my $CLASS = __PACKAGE__;
32
33  use base 'Test::Builder::Module';
34  @EXPORT = qw(ok);
35
36  sub ok ($;$) {
37      my $tb = $CLASS->builder;
38      return $tb->ok(@_);
39  }
40
41  1;
42
43
44=head1 DESCRIPTION
45
46This is a superclass for Test::Builder-based modules.  It provides a
47handful of common functionality and a method of getting at the underlying
48Test::Builder object.
49
50
51=head2 Importing
52
53Test::Builder::Module is a subclass of Exporter which means your
54module is also a subclass of Exporter.  @EXPORT, @EXPORT_OK, etc...
55all act normally.
56
57A few methods are provided to do the C<use Your::Module tests => 23> part
58for you.
59
60=head3 import
61
62Test::Builder::Module provides an import() method which acts in the
63same basic way as Test::More's, setting the plan and controling
64exporting of functions and variables.  This allows your module to set
65the plan independent of Test::More.
66
67All arguments passed to import() are passed onto
68C<< Your::Module->builder->plan() >> with the exception of
69C<import =>[qw(things to import)]>.
70
71    use Your::Module import => [qw(this that)], tests => 23;
72
73says to import the functions this() and that() as well as set the plan
74to be 23 tests.
75
76import() also sets the exported_to() attribute of your builder to be
77the caller of the import() function.
78
79Additional behaviors can be added to your import() method by overriding
80import_extra().
81
82=cut
83
84sub import {
85    my($class) = shift;
86
87    my $test = $class->builder;
88
89    my $caller = caller;
90
91    $test->exported_to($caller);
92
93    $class->import_extra(\@_);
94    my(@imports) = $class->_strip_imports(\@_);
95
96    $test->plan(@_);
97
98    $class->$_export_to_level(1, $class, @imports);
99}
100
101
102sub _strip_imports {
103    my $class = shift;
104    my $list  = shift;
105
106    my @imports = ();
107    my @other   = ();
108    my $idx = 0;
109    while( $idx <= $#{$list} ) {
110        my $item = $list->[$idx];
111
112        if( defined $item and $item eq 'import' ) {
113            push @imports, @{$list->[$idx+1]};
114            $idx++;
115        }
116        else {
117            push @other, $item;
118        }
119
120        $idx++;
121    }
122
123    @$list = @other;
124
125    return @imports;
126}
127
128
129=head3 import_extra
130
131    Your::Module->import_extra(\@import_args);
132
133import_extra() is called by import().  It provides an opportunity for you
134to add behaviors to your module based on its import list.
135
136Any extra arguments which shouldn't be passed on to plan() should be
137stripped off by this method.
138
139See Test::More for an example of its use.
140
141B<NOTE> This mechanism is I<VERY ALPHA AND LIKELY TO CHANGE> as it
142feels like a bit of an ugly hack in its current form.
143
144=cut
145
146sub import_extra {}
147
148
149=head2 Builder
150
151Test::Builder::Module provides some methods of getting at the underlying
152Test::Builder object.
153
154=head3 builder
155
156  my $builder = Your::Class->builder;
157
158This method returns the Test::Builder object associated with Your::Class.
159It is not a constructor so you can call it as often as you like.
160
161This is the preferred way to get the Test::Builder object.  You should
162I<not> get it via C<< Test::Builder->new >> as was previously
163recommended.
164
165The object returned by builder() may change at runtime so you should
166call builder() inside each function rather than store it in a global.
167
168  sub ok {
169      my $builder = Your::Class->builder;
170
171      return $builder->ok(@_);
172  }
173
174
175=cut
176
177sub builder {
178    return Test::Builder->new;
179}
180
181
1821;
183