Move pod test extraction to code that can be reused by dzil and Makefile.PL

The cookbook tests will be extracted every time the dev-only Makefile.PL is run.

diff --git a/.gitignore b/.gitignore
index b8bab15..d2b18c7 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -5,7 +5,7 @@
 /MANIFEST.bak
 /blib/
 /pm_to_blib
-/t/000_recipes/*
+/t/002_recipes/*
 /.build
 .*
 !.gitignore

diff --git a/Makefile.PL b/Makefile.PL
index 5359a20..6eb0b0f 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -7,6 +7,7 @@ use ExtUtils::MakeMaker;
 use lib 'inc';
 
 use MMHelper;
+use MyInline;
 
 warn <<'EOF';
 
@@ -20,6 +21,8 @@ warn <<'EOF';
 
 EOF
 
+system( $^X, 'author/extract-inline-tests', '--quiet' );
+
 eval MMHelper::my_package_subs();
 
 WriteMakefile(

diff --git a/author/extract-inline-tests b/author/extract-inline-tests
new file mode 100755 (executable)
index 0000000..9a186d9
--- /dev/null
+++ b/author/extract-inline-tests
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib 'inc';
+use File::Find::Rule;
+use Getopt::Long;
+use MyInline;
+use Test::Inline;
+
+my $quiet;
+GetOptions( 'quiet' => \$quiet );
+
+my $inline = Test::Inline->new(
+    verbose        => !$quiet,
+    ExtractHandler => 'My::Extract',
+    ContentHandler => 'My::Content',
+    OutputHandler  => 'My::Output',
+);
+
+for my $pod (
+    File::Find::Rule->file->name(qr/\.pod$/)->in('lib/Moose/Cookbook') ) {
+    $inline->add($pod);
+}
+
+$inline->save;
+
+{
+
+    package My::Output;
+
+    use File::Slurp qw( write_file );
+
+    sub write {
+        my $class   = shift;
+        my $name    = shift;
+        my $content = shift;
+
+        $name =~ s/^moose_cookbook_//;
+
+        write_file( "t/002_recipes/$name", $content );
+
+        return 1;
+    }
+}

diff --git a/inc/ExtractInlineTests.pm b/inc/ExtractInlineTests.pm
index 753ea22..bf0f547 100644 (file)
--- a/inc/ExtractInlineTests.pm
+++ b/inc/ExtractInlineTests.pm
@@ -8,6 +8,7 @@ use File::Basename qw( basename );
 use File::Find::Rule;
 use File::Spec;
 use File::Temp qw( tempdir );
+use inc::MyInline;
 use Test::Inline;
 
 sub gather_files {
@@ -30,85 +31,6 @@ sub gather_files {
 }
 
 {
-    package My::Extract;
-
-    use base 'Test::Inline::Extract';
-
-    # This extracts the SYNOPSIS in addition to code specifically
-    # marked for testing
-    my $search = qr/
-               (?:^|\n)                           # After the beginning of the string, or a newline
-               (                                  # ... start capturing
-                                                  # EITHER
-                       package\s+                            # A package
-                       [^\W\d]\w*(?:(?:\'|::)[^\W\d]\w*)*    # ... with a name
-                       \s*;                                  # And a statement terminator
-                |
-                        =head1[ \t]+SYNOPSIS\n
-                        .*?
-                        (?=\n=)
-               |                                  # OR
-                       =for[ \t]+example[ \t]+begin\n        # ... when we find a =for example begin
-                       .*?                                   # ... and keep capturing
-                       \n=for[ \t]+example[ \t]+end\s*?      # ... until the =for example end
-                       (?:\n|$)                              # ... at the end of file or a newline
-               |                                  # OR
-                       =begin[ \t]+(?:test|testing)(?:-SETUP)? # ... when we find a =begin test or testing
-                       .*?                                     # ... and keep capturing
-                       \n=end[ \t]+(?:test|testing)(?:-SETUP)? # ... until an =end tag
-                        .*?
-                       (?:\n|$)                              # ... at the end of file or a newline
-               )                                  # ... and stop capturing
-               /isx;
-
-    sub _elements {
-        my $self     = shift;
-        my @elements = ();
-        while ( $self->{source} =~ m/$search/go ) {
-            my $elt = $1;
-
-            # A hack to turn the SYNOPSIS into something Test::Inline
-            # doesn't barf on
-            if ( $elt =~ s/=head1[ \t]+SYNOPSIS/=begin testing-SETUP\n\n{/ ) {
-                $elt .= "}\n\n=end testing-SETUP";
-            }
-
-            # It seems like search.cpan doesn't like a name with
-            # spaces after =begin. bleah, what a mess.
-            $elt =~ s/testing-SETUP/testing SETUP/g;
-
-            push @elements, $elt;
-        }
-
-        # If we have just one element it's a SYNOPSIS, so there's no
-        # tests.
-        return unless @elements > 2;
-
-        if ( @elements && $self->{source} =~ /=head1 NAME\n\n(Moose::Cookbook\S+)/ ) {
-            unshift @elements, 'package ' . $1 . ';';
-        }
-
-        ( List::Util::first {/^=/} @elements ) ? \@elements : '';
-    }
-}
-
-{
-    package My::Content;
-
-    use base 'Test::Inline::Content::Default';
-
-    sub process {
-        my $self = shift;
-
-        my $base = $self->SUPER::process(@_);
-
-        $base =~ s/(\$\| = 1;)/use Test::Fatal;\n$1/;
-
-        return $base;
-    }
-}
-
-{
     package My::Output;
 
     sub new {

diff --git a/inc/MyInline.pm b/inc/MyInline.pm
new file mode 100644 (file)
index 0000000..3ab70c8
--- /dev/null
+++ b/inc/MyInline.pm
@@ -0,0 +1,87 @@
+package MyInline;
+
+use strict;
+use warnings;
+
+{
+    package My::Extract;
+
+    use base 'Test::Inline::Extract';
+
+    use List::Util qw( first );
+
+    # This extracts the SYNOPSIS in addition to code specifically
+    # marked for testing
+    my $search = qr/
+               (?:^|\n)                           # After the beginning of the string, or a newline
+               (                                  # ... start capturing
+                                                  # EITHER
+                       package\s+                            # A package
+                       [^\W\d]\w*(?:(?:\'|::)[^\W\d]\w*)*    # ... with a name
+                       \s*;                                  # And a statement terminator
+                |
+                        =head1[ \t]+SYNOPSIS\n
+                        .*?
+                        (?=\n=)
+               |                                  # OR
+                       =for[ \t]+example[ \t]+begin\n        # ... when we find a =for example begin
+                       .*?                                   # ... and keep capturing
+                       \n=for[ \t]+example[ \t]+end\s*?      # ... until the =for example end
+                       (?:\n|$)                              # ... at the end of file or a newline
+               |                                  # OR
+                       =begin[ \t]+(?:test|testing)(?:-SETUP)? # ... when we find a =begin test or testing
+                       .*?                                     # ... and keep capturing
+                       \n=end[ \t]+(?:test|testing)(?:-SETUP)? # ... until an =end tag
+                        .*?
+                       (?:\n|$)                              # ... at the end of file or a newline
+               )                                  # ... and stop capturing
+               /isx;
+
+    sub _elements {
+        my $self     = shift;
+        my @elements = ();
+        while ( $self->{source} =~ m/$search/go ) {
+            my $elt = $1;
+
+            # A hack to turn the SYNOPSIS into something Test::Inline
+            # doesn't barf on
+            if ( $elt =~ s/=head1[ \t]+SYNOPSIS/=begin testing-SETUP\n\n{/ ) {
+                $elt .= "}\n\n=end testing-SETUP";
+            }
+
+            # It seems like search.cpan doesn't like a name with
+            # spaces after =begin. bleah, what a mess.
+            $elt =~ s/testing-SETUP/testing SETUP/g;
+
+            push @elements, $elt;
+        }
+
+        # If we have just one element it's a SYNOPSIS, so there's no
+        # tests.
+        return unless @elements > 2;
+
+        if ( @elements && $self->{source} =~ /=head1 NAME\n\n(Moose::Cookbook\S+)/ ) {
+            unshift @elements, 'package ' . $1 . ';';
+        }
+
+        ( first {/^=/} @elements ) ? \@elements : '';
+    }
+}
+
+{
+    package My::Content;
+
+    use base 'Test::Inline::Content::Default';
+
+    sub process {
+        my $self = shift;
+
+        my $base = $self->SUPER::process(@_);
+
+        $base =~ s/(\$\| = 1;)/use Test::Fatal;\n$1/;
+
+        return $base;
+    }
+}
+
+1;