inc/MyInline.pm

   1 package MyInline;
   2
   3 use strict;
   4 use warnings;
   5
   6 {
   7     package My::Extract;
   8
   9     use base 'Test::Inline::Extract';
  10
  11     use List::Util qw( first );
  12
  13     # This extracts the SYNOPSIS in addition to code specifically
  14     # marked for testing
  15     my $search = qr/
  16         (?:^|\n)                           # After the beginning of the string, or a newline
  17         (                                  # ... start capturing
  18                                            # EITHER
  19             package\s+                            # A package
  20             [^\W\d]\w*(?:(?:\'|::)[^\W\d]\w*)*    # ... with a name
  21             \s*;                                  # And a statement terminator
  22                 |
  23                         =head1[ \t]+SYNOPSIS\n
  24                         .*?
  25                         (?=\n=)
  26         |                                  # OR
  27             =for[ \t]+example[ \t]+begin\n        # ... when we find a =for example begin
  28             .*?                                   # ... and keep capturing
  29             \n=for[ \t]+example[ \t]+end\s*?      # ... until the =for example end
  30             (?:\n|$)                              # ... at the end of file or a newline
  31         |                                  # OR
  32             =begin[ \t]+(?:test|testing)(?:-SETUP)? # ... when we find a =begin test or testing
  33             .*?                                     # ... and keep capturing
  34             \n=end[ \t]+(?:test|testing)(?:-SETUP)? # ... until an =end tag
  35                         .*?
  36             (?:\n|$)                              # ... at the end of file or a newline
  37         )                                  # ... and stop capturing
  38         /isx;
  39
  40     sub _elements {
  41         my $self     = shift;
  42         my @elements = ();
  43         while ( $self->{source} =~ m/$search/go ) {
  44             my $elt = $1;
  45
  46             # A hack to turn the SYNOPSIS into something Test::Inline
  47             # doesn't barf on
  48             if ( $elt =~ s/=head1[ \t]+SYNOPSIS/=begin testing-SETUP\n\n{/ ) {
  49                 $elt .= "}\n\n=end testing-SETUP";
  50             }
  51
  52             # It seems like search.cpan doesn't like a name with
  53             # spaces after =begin. bleah, what a mess.
  54             $elt =~ s/testing-SETUP/testing SETUP/g;
  55
  56             push @elements, $elt;
  57         }
  58
  59         # If we have just one element it's a SYNOPSIS, so there's no
  60         # tests.
  61         return unless @elements > 2;
  62
  63         if ( @elements && $self->{source} =~ /=head1 NAME\n\n(Moose::Cookbook\S+)/ ) {
  64             unshift @elements, 'package ' . $1 . ';';
  65         }
  66
  67         ( first {/^=/} @elements ) ? \@elements : '';
  68     }
  69 }
  70
  71 {
  72     package My::Content;
  73
  74     use base 'Test::Inline::Content::Default';
  75
  76     sub process {
  77         my $self = shift;
  78
  79         my $base = $self->SUPER::process(@_);
  80
  81         $base =~ s/(\$\| = 1;)/use Test::Fatal;\n$1/;
  82
  83         return $base;
  84     }
  85 }
  86
  87 1;