ETHER / Moose-2.2207 / inc / MyInline.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98

              
package inc::MyInline;
use strict;
use warnings;
{
    package My::Extract;
    use parent '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
        |                                  # OR
            \#\s*PODNAME:\s+                      # A PODNAME comment
            [^\W\d]\w*(?:(?:\'|::)[^\W\d]\w*)*    # ... with a name
            (?:\s+|$)                             # And a name 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} =~ /# PODNAME: (Moose::Cookbook\S+)(?:\s|$)/ ) {
            foreach my $element (@elements)
            {
                $element = "package $1;" if $element =~ /# PODNAME: (Moose::Cookbook\S+)(?:\s+|$)/;
            }
        }
        if ( @elements && $self->{source} =~ /=head1 NAME\n\n(Moose::Cookbook\S+)/ ) {
            unshift @elements, 'package ' . $1 . ';';
        }
        ( first {/^=/} @elements ) ? \@elements : '';
    }
}
{
    package My::Content;
    use parent '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;