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