File Coverage

blib/lib/Mason/Test/Class.pm
Criterion Covered Total %
statement 183 191 95.8
branch 23 32 71.8
condition 26 55 47.2
subroutine 44 46 95.6
pod 0 6 0.0
total 276 330 83.6


line stmt bran cond sub pod time code
1             package Mason::Test::Class;
2             $Mason::Test::Class::VERSION = '2.23';
3 20     20   1013682 use Carp;
  20         40  
  20         1226  
4 20     20   104 use File::Basename;
  20         31  
  20         1307  
5 20     20   128 use File::Path;
  20         27  
  20         1021  
6 20     20   15331 use File::Temp qw(tempdir);
  20         352277  
  20         1434  
7 20     20   6933 use Mason;
  20         65  
  20         792  
8 20     20   111 use Mason::Util qw(trim write_file);
  20         33  
  20         1051  
9 20     20   99 use Method::Signatures::Simple;
  20         34  
  20         92  
10 20     20   8710 use Test::Class::Most;
  20         30343  
  20         302  
11 20     20   123727 use Test::LongString;
  20         42586  
  20         115  
12 20     20   2063 use Class::Load;
  20         36  
  20         683  
13 20     20   85 use strict;
  20         30  
  20         793  
14 20     20   90 use warnings;
  20         34  
  20         5487  
15              
16             __PACKAGE__->SKIP_CLASS("abstract base class");
17              
18             # RO accessors
19 420     420 0 1830 sub comp_root { $_[0]->{comp_root} }
20 200     200 0 69077 sub data_dir { $_[0]->{data_dir} }
21 215     215 0 2131 sub interp { $_[0]->{interp} }
22 8     8 0 37 sub temp_dir { $_[0]->{temp_dir} }
23 0     0 0 0 sub temp_root { $_[0]->{temp_root} }
24              
25             # RW class accessors
26             my $default_plugins = [];
27 1 50   1 0 6 sub default_plugins { $default_plugins = $_[1] if defined( $_[1] ); $default_plugins; }
  1         3  
28              
29             my $gen_path_count = 0;
30             my $parse_count = 0;
31             my $temp_dir_count = 0;
32              
33             our $current_test_object;
34              
35             sub _startup : Test(startup) {
36 20     20   13769 my $self = shift;
37 20         73 my $verbose = $ENV{TEST_VERBOSE};
38 20 50       271 $self->{temp_root} = tempdir( 'mason-test-XXXX', TMPDIR => 1, CLEANUP => $verbose ? 0 : 1 );
39 20 50       12634 printf STDERR ( "\n*** temp_root = %s, no cleanup\n", $self->{temp_root} ) if $verbose;
40 20         190 $self->setup_dirs;
41 20     20   117 }
  20         39  
  20         161  
42              
43 20     20   15753 method setup_dirs () {
  79     79   178  
  79         176  
44 79         516 $self->{temp_dir} = join( "/", $self->{temp_root}, $temp_dir_count++ );
45 79         281 $self->{comp_root} = $self->{temp_dir} . "/comps";
46 79         264 $self->{data_dir} = $self->{temp_dir} . "/data";
47 79         29782 mkpath( [ $self->{comp_root}, $self->{data_dir} ], 0, 0775 );
48 79         651 $self->setup_interp(@_);
49             }
50              
51 20     20   8182 method setup_interp () {
  91     91   195  
  91         153  
52 91         469 $self->{interp} = $self->create_interp(@_);
53             }
54              
55 20     20   6745 method create_interp () {
  100     100   231  
  100         173  
56 100         311 my (%params) = @_;
57 100 100       419 $params{plugins} = $default_plugins if @$default_plugins;
58 100   100     670 my $mason_root_class = delete( $params{mason_root_class} ) || 'Mason';
59 100         549 Class::Load::load_class($mason_root_class);
60 100         3690 rmtree( $self->data_dir );
61 100         799 return $mason_root_class->new(
62             comp_root => $self->comp_root,
63             data_dir => $self->data_dir,
64             %params,
65             );
66             }
67              
68 20     20   8178 method add_comp (%params) {
  303     303   499  
  303         979  
  303         411  
69 303         1410 $self->_validate_keys( \%params, qw(path src v verbose) );
70 303   50     871 my $path = $params{path} || die "must pass path";
71 303   50     788 my $source = $params{src} || " ";
72 303   33     1294 my $verbose = $params{v} || $params{verbose};
73 303 50       970 die "'$path' is not absolute" unless substr( $path, 0, 1 ) eq '/';
74 303         1128 my $source_file = $self->comp_root . $path;
75 303         1177 $self->mkpath_and_write_file( $source_file, $source );
76 303 50       1505 if ($verbose) {
77 0         0 print STDERR "*** $path ***\n";
78 0         0 my $output = $self->interp->_compile( $source_file, $path );
79 0         0 print STDERR "$output\n";
80             }
81             }
82              
83 20     20   10141 method remove_comp (%params) {
  6     6   15  
  6         18  
  6         8  
84 6   50     24 my $path = $params{path} || die "must pass path";
85 6         37 my $source_file = join( "/", $self->comp_root, $path );
86 6         465 unlink($source_file);
87             }
88              
89 20     20   7345 method _gen_comp_path () {
  83     83   155  
  83         121  
90 83         357 my $caller = ( caller(2) )[3];
91 83         2218 my ($caller_base) = ( $caller =~ /([^:]+)$/ );
92 83         366 my $path = "/$caller_base" . ( ++$gen_path_count ) . ".mc";
93 83         335 return $path;
94             }
95              
96 20     20   9614 method test_comp (%params) {
  101     101   214  
  101         435  
  101         137  
97 101   66     924 my $path = $params{path} || $self->_gen_comp_path;
98 101   50     383 my $source = $params{src} || " ";
99 101   33     523 my $verbose = $params{v} || $params{verbose};
100              
101 101         658 $self->add_comp( path => $path, src => $source, verbose => $verbose );
102 101         242 delete( $params{src} );
103              
104 101         788 $self->test_existing_comp( %params, path => $path );
105             }
106              
107 20     20   8506 method test_existing_comp (%params) {
  107     107   225  
  107         340  
  107         165  
108 107         540 $self->_validate_keys( \%params, qw(args desc expect expect_data expect_error path v verbose) );
109 107 50       402 my $path = $params{path} or die "must pass path";
110 107         435 my $caller = ( caller(1) )[3];
111 107   66     2421 my $desc = $params{desc} || $path;
112 107         509 my $expect = trim( $params{expect} );
113 107         249 my $expect_error = $params{expect_error};
114 107         183 my $expect_data = $params{expect_data};
115 107   33     539 my $verbose = $params{v} || $params{verbose};
116 107   100     551 my $args = $params{args} || {};
117 107         753 ( my $request_path = $path ) =~ s/\.m[cpi]$//;
118              
119 107         414 my @run_params = ( $request_path, %$args );
120 107         204 local $current_test_object = $self;
121              
122 107 100       324 if ( defined($expect_error) ) {
123 36   33     89 $desc ||= $expect_error;
124 36     36   276 throws_ok( sub { $self->interp->run(@run_params) }, $expect_error, $desc );
  36         1549  
125             }
126 107 100       26673 if ( defined($expect) ) {
127 70   33     178 $desc ||= $caller;
128 70         390 my $output = trim( $self->interp->run(@run_params)->output );
129 70 100       2635 if ( ref($expect) eq 'Regexp' ) {
130 2         14 like( $output, $expect, $desc );
131             }
132             else {
133 68         383 is( $output, $expect, $desc );
134             }
135             }
136 107 100       52755 if ( defined($expect_data) ) {
137 1   33     4 $desc ||= $caller;
138 1         7 cmp_deeply( $self->interp->run(@run_params)->data, $expect_data, $desc );
139             }
140             }
141              
142 20     20   13946 method run_test_in_comp (%params) {
  4     4   10  
  4         18  
  4         6  
143 4   50     23 my $test = delete( $params{test} ) || die "must pass test";
144 4   100     24 my $args = delete( $params{args} ) || {};
145 4   66     23 $params{path} ||= $self->_gen_comp_path;
146 4         26 $self->add_comp( %params, src => '% $.args->{_test}->($self);' );
147 4         33 ( my $request_path = $params{path} ) =~ s/\.m[cpi]$//;
148 4         18 my @run_params = ( $request_path, %$args );
149 4         38 $self->interp->run( @run_params, _test => $test );
150             }
151              
152 20     20   26347 method test_parse (%params) {
  4     4   9  
  4         16  
  4         5  
153 4         22 my $caller = ( caller(1) )[3];
154 4         98 my ($caller_base) = ( $caller =~ /([^:]+)$/ );
155 4         12 my $desc = $params{desc};
156 4   33     18 my $source = $params{src} || croak "must pass src";
157 4         12 my $expect_list = $params{expect};
158 4         8 my $expect_error = $params{expect_error};
159 4 50 33     44 croak "must pass either expect or expect_error" unless $expect_list || $expect_error;
160              
161 4         14 my $path = "/parse/comp" . $parse_count++;
162 4         24 my $file = $self->temp_dir . $path;
163 4         21 $self->mkpath_and_write_file( $file, $source );
164              
165 4 50       16 if ($expect_error) {
166 0   0     0 $desc ||= $expect_error;
167 0     0   0 throws_ok( sub { $self->interp->_compile( $file, $path ) }, $expect_error, $desc );
  0         0  
168             }
169             else {
170 4   33     23 $desc ||= $caller;
171 4         25 my $output = $self->interp->_compile( $file, $path );
172 4         20 foreach my $expect (@$expect_list) {
173 6 100       976 if ( ref($expect) eq 'Regexp' ) {
174 3         18 like_string( $output, $expect, "$desc - $expect" );
175             }
176             else {
177 3         18 contains_string( $output, $expect, "$desc - $expect" );
178             }
179             }
180             }
181             }
182              
183 20     20   11773 method mkpath_and_write_file ($source_file, $source) {
  312     312   407  
  312         461  
  312         320  
184 312 100       46621 unlink($source_file) if -e $source_file;
185 312         33155 mkpath( dirname($source_file), 0, 0775 );
186 312         1380 write_file( $source_file, $source );
187             }
188              
189 20     20   7395 method _validate_keys ($params, @allowed_keys) {
  410     410   556  
  410         1040  
  410         422  
190 410         747 my %is_allowed = map { ( $_, 1 ) } @allowed_keys;
  2068         3329  
191 410 50       1113 if ( my @bad_keys = grep { !$is_allowed{$_} } keys(%$params) ) {
  955         2881  
192 0           croak "bad parameters: " . join( ", ", @bad_keys );
193             }
194             }
195              
196             1;