Commit | Line | Data |
4dc2cd56 |
1 | package inc::ExtractInlineTests; |
e4d40db1 |
2 | |
3 | use Moose; |
4 | |
5 | with 'Dist::Zilla::Role::FileGatherer'; |
6 | |
7 | use File::Basename qw( basename ); |
8 | use File::Find::Rule; |
9 | use File::Spec; |
10 | use File::Temp qw( tempdir ); |
11 | use Test::Inline; |
12 | |
13 | sub gather_files { |
14 | my $self = shift; |
15 | my $arg = shift; |
16 | |
17 | my $inline = Test::Inline->new( |
18 | verbose => 0, |
19 | ExtractHandler => 'My::Extract', |
20 | ContentHandler => 'My::Content', |
21 | OutputHandler => My::Output->new($self), |
22 | ); |
23 | |
24 | for my $pod ( |
25 | File::Find::Rule->file->name(qr/\.pod$/)->in('lib/Moose/Cookbook') ) { |
26 | $inline->add($pod); |
27 | } |
28 | |
29 | $inline->save; |
30 | } |
31 | |
32 | { |
33 | package My::Extract; |
34 | |
35 | use base 'Test::Inline::Extract'; |
36 | |
37 | # This extracts the SYNOPSIS in addition to code specifically |
38 | # marked for testing |
39 | my $search = qr/ |
40 | (?:^|\n) # After the beginning of the string, or a newline |
41 | ( # ... start capturing |
42 | # EITHER |
43 | package\s+ # A package |
44 | [^\W\d]\w*(?:(?:\'|::)[^\W\d]\w*)* # ... with a name |
45 | \s*; # And a statement terminator |
46 | | |
47 | =head1[ \t]+SYNOPSIS\n |
48 | .*? |
49 | (?=\n=) |
50 | | # OR |
51 | =for[ \t]+example[ \t]+begin\n # ... when we find a =for example begin |
52 | .*? # ... and keep capturing |
53 | \n=for[ \t]+example[ \t]+end\s*? # ... until the =for example end |
54 | (?:\n|$) # ... at the end of file or a newline |
55 | | # OR |
56 | =begin[ \t]+(?:test|testing)(?:-SETUP)? # ... when we find a =begin test or testing |
57 | .*? # ... and keep capturing |
58 | \n=end[ \t]+(?:test|testing)(?:-SETUP)? # ... until an =end tag |
59 | .*? |
60 | (?:\n|$) # ... at the end of file or a newline |
61 | ) # ... and stop capturing |
62 | /isx; |
63 | |
64 | sub _elements { |
65 | my $self = shift; |
66 | my @elements = (); |
67 | while ( $self->{source} =~ m/$search/go ) { |
68 | my $elt = $1; |
69 | |
70 | # A hack to turn the SYNOPSIS into something Test::Inline |
71 | # doesn't barf on |
72 | if ( $elt =~ s/=head1[ \t]+SYNOPSIS/=begin testing-SETUP\n\n{/ ) { |
73 | $elt .= "}\n\n=end testing-SETUP"; |
74 | } |
75 | |
76 | # It seems like search.cpan doesn't like a name with |
77 | # spaces after =begin. bleah, what a mess. |
78 | $elt =~ s/testing-SETUP/testing SETUP/g; |
79 | |
80 | push @elements, $elt; |
81 | } |
82 | |
83 | # If we have just one element it's a SYNOPSIS, so there's no |
84 | # tests. |
85 | return unless @elements > 1; |
86 | |
87 | if ( @elements && $self->{source} =~ /=head1 NAME\n\n(Moose::Cookbook\S+)/ ) { |
88 | unshift @elements, 'package ' . $1 . ';'; |
89 | } |
90 | |
91 | ( List::Util::first {/^=/} @elements ) ? \@elements : ''; |
92 | } |
93 | } |
94 | |
95 | { |
96 | package My::Content; |
97 | |
98 | use base 'Test::Inline::Content::Default'; |
99 | |
100 | sub process { |
101 | my $self = shift; |
102 | |
103 | my $base = $self->SUPER::process(@_); |
104 | |
105 | $base =~ s/(\$\| = 1;)/use Test::Fatal;\n$1/; |
106 | |
107 | return $base; |
108 | } |
109 | } |
110 | |
111 | { |
112 | package My::Output; |
113 | |
114 | sub new { |
115 | my $class = shift; |
116 | my $dzil = shift; |
117 | |
118 | return bless { dzil => $dzil }, $class; |
119 | } |
120 | |
121 | sub write { |
122 | my $self = shift; |
123 | my $name = shift; |
124 | my $content = shift; |
125 | |
126 | $self->{dzil}->add_file( |
127 | Dist::Zilla::File::InMemory->new( |
128 | name => "t/002_recipes/$name", |
129 | content => $content, |
130 | ) |
131 | ); |
132 | |
133 | return 1; |
134 | } |
135 | } |
136 | |
137 | 1; |