File Coverage

blib/lib/Mason/Test/Class.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Mason::Test::Class;
2             $Mason::Test::Class::VERSION = '2.22';
3 20     20   2349232 use Carp;
  20         52  
  20         3142  
4 20     20   118 use File::Basename;
  20         38  
  20         3174  
5 20     20   110 use File::Path;
  20         35  
  20         1597  
6 20     20   32502 use File::Temp qw(tempdir);
  20         598317  
  20         1571  
7 20     20   10766 use Mason;
  0            
  0            
8             use Mason::Util qw(trim write_file);
9             use Method::Signatures::Simple;
10             use Test::Class::Most;
11             use Test::LongString;
12             use Class::Load;
13             use strict;
14             use warnings;
15              
16             __PACKAGE__->SKIP_CLASS("abstract base class");
17              
18             # RO accessors
19             sub comp_root { $_[0]->{comp_root} }
20             sub data_dir { $_[0]->{data_dir} }
21             sub interp { $_[0]->{interp} }
22             sub temp_dir { $_[0]->{temp_dir} }
23             sub temp_root { $_[0]->{temp_root} }
24              
25             # RW class accessors
26             my $default_plugins = [];
27             sub default_plugins { $default_plugins = $_[1] if defined( $_[1] ); $default_plugins; }
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             my $self = shift;
37             my $verbose = $ENV{TEST_VERBOSE};
38             $self->{temp_root} = tempdir( 'mason-test-XXXX', TMPDIR => 1, CLEANUP => $verbose ? 0 : 1 );
39             printf STDERR ( "\n*** temp_root = %s, no cleanup\n", $self->{temp_root} ) if $verbose;
40             $self->setup_dirs;
41             }
42              
43             method setup_dirs () {
44             $self->{temp_dir} = join( "/", $self->{temp_root}, $temp_dir_count++ );
45             $self->{comp_root} = $self->{temp_dir} . "/comps";
46             $self->{data_dir} = $self->{temp_dir} . "/data";
47             mkpath( [ $self->{comp_root}, $self->{data_dir} ], 0, 0775 );
48             $self->setup_interp(@_);
49             }
50              
51             method setup_interp () {
52             $self->{interp} = $self->create_interp(@_);
53             }
54              
55             method create_interp () {
56             my (%params) = @_;
57             $params{plugins} = $default_plugins if @$default_plugins;
58             my $mason_root_class = delete( $params{mason_root_class} ) || 'Mason';
59             Class::Load::load_class($mason_root_class);
60             rmtree( $self->data_dir );
61             return $mason_root_class->new(
62             comp_root => $self->comp_root,
63             data_dir => $self->data_dir,
64             %params,
65             );
66             }
67              
68             method add_comp (%params) {
69             $self->_validate_keys( \%params, qw(path src v verbose) );
70             my $path = $params{path} || die "must pass path";
71             my $source = $params{src} || " ";
72             my $verbose = $params{v} || $params{verbose};
73             die "'$path' is not absolute" unless substr( $path, 0, 1 ) eq '/';
74             my $source_file = $self->comp_root . $path;
75             $self->mkpath_and_write_file( $source_file, $source );
76             if ($verbose) {
77             print STDERR "*** $path ***\n";
78             my $output = $self->interp->_compile( $source_file, $path );
79             print STDERR "$output\n";
80             }
81             }
82              
83             method remove_comp (%params) {
84             my $path = $params{path} || die "must pass path";
85             my $source_file = join( "/", $self->comp_root, $path );
86             unlink($source_file);
87             }
88              
89             method _gen_comp_path () {
90             my $caller = ( caller(2) )[3];
91             my ($caller_base) = ( $caller =~ /([^:]+)$/ );
92             my $path = "/$caller_base" . ( ++$gen_path_count ) . ".mc";
93             return $path;
94             }
95              
96             method test_comp (%params) {
97             my $path = $params{path} || $self->_gen_comp_path;
98             my $source = $params{src} || " ";
99             my $verbose = $params{v} || $params{verbose};
100              
101             $self->add_comp( path => $path, src => $source, verbose => $verbose );
102             delete( $params{src} );
103              
104             $self->test_existing_comp( %params, path => $path );
105             }
106              
107             method test_existing_comp (%params) {
108             $self->_validate_keys( \%params, qw(args desc expect expect_data expect_error path v verbose) );
109             my $path = $params{path} or die "must pass path";
110             my $caller = ( caller(1) )[3];
111             my $desc = $params{desc} || $path;
112             my $expect = trim( $params{expect} );
113             my $expect_error = $params{expect_error};
114             my $expect_data = $params{expect_data};
115             my $verbose = $params{v} || $params{verbose};
116             my $args = $params{args} || {};
117             ( my $request_path = $path ) =~ s/\.m[cpi]$//;
118              
119             my @run_params = ( $request_path, %$args );
120             local $current_test_object = $self;
121              
122             if ( defined($expect_error) ) {
123             $desc ||= $expect_error;
124             throws_ok( sub { $self->interp->run(@run_params) }, $expect_error, $desc );
125             }
126             if ( defined($expect) ) {
127             $desc ||= $caller;
128             my $output = trim( $self->interp->run(@run_params)->output );
129             if ( ref($expect) eq 'Regexp' ) {
130             like( $output, $expect, $desc );
131             }
132             else {
133             is( $output, $expect, $desc );
134             }
135             }
136             if ( defined($expect_data) ) {
137             $desc ||= $caller;
138             cmp_deeply( $self->interp->run(@run_params)->data, $expect_data, $desc );
139             }
140             }
141              
142             method run_test_in_comp (%params) {
143             my $test = delete( $params{test} ) || die "must pass test";
144             my $args = delete( $params{args} ) || {};
145             $params{path} ||= $self->_gen_comp_path;
146             $self->add_comp( %params, src => '% $.args->{_test}->($self);' );
147             ( my $request_path = $params{path} ) =~ s/\.m[cpi]$//;
148             my @run_params = ( $request_path, %$args );
149             $self->interp->run( @run_params, _test => $test );
150             }
151              
152             method test_parse (%params) {
153             my $caller = ( caller(1) )[3];
154             my ($caller_base) = ( $caller =~ /([^:]+)$/ );
155             my $desc = $params{desc};
156             my $source = $params{src} || croak "must pass src";
157             my $expect_list = $params{expect};
158             my $expect_error = $params{expect_error};
159             croak "must pass either expect or expect_error" unless $expect_list || $expect_error;
160              
161             my $path = "/parse/comp" . $parse_count++;
162             my $file = $self->temp_dir . $path;
163             $self->mkpath_and_write_file( $file, $source );
164              
165             if ($expect_error) {
166             $desc ||= $expect_error;
167             throws_ok( sub { $self->interp->_compile( $file, $path ) }, $expect_error, $desc );
168             }
169             else {
170             $desc ||= $caller;
171             my $output = $self->interp->_compile( $file, $path );
172             foreach my $expect (@$expect_list) {
173             if ( ref($expect) eq 'Regexp' ) {
174             like_string( $output, $expect, "$desc - $expect" );
175             }
176             else {
177             contains_string( $output, $expect, "$desc - $expect" );
178             }
179             }
180             }
181             }
182              
183             method mkpath_and_write_file ($source_file, $source) {
184             unlink($source_file) if -e $source_file;
185             mkpath( dirname($source_file), 0, 0775 );
186             write_file( $source_file, $source );
187             }
188              
189             method _validate_keys ($params, @allowed_keys) {
190             my %is_allowed = map { ( $_, 1 ) } @allowed_keys;
191             if ( my @bad_keys = grep { !$is_allowed{$_} } keys(%$params) ) {
192             croak "bad parameters: " . join( ", ", @bad_keys );
193             }
194             }
195              
196             1;