X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=author%2Fextract-inline-tests;h=5fea6a92b06b523aba28e760d94736e062a188ab;hb=f4720cd35094f7dae5e1f2fd7745bf9259606c46;hp=8cdb4cce826416d9ab13428ef475076a666746b3;hpb=b10dde3a27c11623547417c599ccbd4f92e42651;p=gitmo%2FMoose.git

diff --git a/author/extract-inline-tests b/author/extract-inline-tests
index 8cdb4cc..5fea6a9 100755
--- a/author/extract-inline-tests
+++ b/author/extract-inline-tests
@@ -3,101 +3,20 @@
 use strict;
 use warnings;
 
-{
-    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 > 1;
-
-        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;
-    }
-}
-
+use lib 'inc';
 use File::Find::Rule;
+use Getopt::Long;
+use MyInline;
 use Test::Inline;
 
-
-my $target = 't/000_recipes';
-
-for my $t_file ( File::Find::Rule->file->name(qr/^moose_cookbook_\.t$/)->in($target) ) {
-    unlink $t_file or die "Cannot unlink $t_file: $!";
-}
+my $quiet;
+GetOptions( 'quiet' => \$quiet );
 
 my $inline = Test::Inline->new(
-    verbose        => 1,
-    readonly       => 1,
-    output         => $target,
+    verbose        => !$quiet,
     ExtractHandler => 'My::Extract',
     ContentHandler => 'My::Content',
+    OutputHandler  => 'My::Output',
 );
 
 for my $pod (
@@ -106,3 +25,22 @@ for my $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/recipes/$name", $content );
+
+        return 1;
+    }
+}