inc/ExtractInlineTests.pm

   1 package inc::ExtractInlineTests;
   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 > 2;
  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         $name =~ s/^moose_cookbook_//;
 127
 128         $self->{dzil}->add_file(
 129             Dist::Zilla::File::InMemory->new(
 130                 name    => "t/002_recipes/$name",
 131                 content => $content,
 132             )
 133         );
 134
 135         return 1;
 136     }
 137 }
 138
 139 1;