/usr/share/perl5/Test/Inline/Extract.pm is in libtest-inline-perl 2.213-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 | package Test::Inline::Extract;
=pod
=head1 NAME
Test::Inline::Extract - Extract relevant Pod sections from source
code.
=head1 DESCRIPTION
The Test::Inline::Extract package extracts content interesting to
L<Test::Inline> from source files.
=head1 METHODS
=cut
use strict;
use List::Util ();
use File::Slurp ();
use Params::Util qw{_CLASS _INSTANCE _SCALAR};
use vars qw{$VERSION};
BEGIN {
$VERSION = '2.213';
}
#####################################################################
# Constructor
=pod
=head2 new $file | \$source
The C<new> constructor creates a new Extract object. It is passed either a
file name from which the source code would be loaded, or a reference to a
string that directly contains source code.
Returns a new C<Test::Inline::Extract> object or C<undef> on error.
=cut
sub new {
my $class = _CLASS(shift) or die '->new is a static method';
# Get the source code to process, and clean it up
my $source = $class->_source(shift) or return undef;
$source = $$source;
$source =~ s/(?:\015{1,2}\012|\015|\012)/\n/g;
# Create the object
my $self = bless {
source => $source,
elements => undef,
}, $class;
$self;
}
sub _source {
my $self = shift;
return undef unless defined $_[0];
return shift if _SCALAR($_[0]);
return undef if ref $_[0];
File::Slurp::read_file( shift, scalar_ref => 1 );
}
=pod
=head2 elements
my $elements = $Extract->elements;
The C<elements> method extracts from the Pod any parts of the file that are
relevant to the extraction and generation process of C<Test::Inline>.
The elements will be either a package statements, or a section of inline
unit tests. They will only be returned if there is at least one section
of inline unit tests.
Returns a reference to an array of package strings and sections of inline
unit tests. Returns false if there are no sections containing inline
unit tests.
=cut
# Define the search pattern we will use
use vars qw{$search};
BEGIN {
$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
=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)\b # ... when we find a =begin test or testing
.*? # ... and keep capturing
\n=end[ \t]+(?:test|testing)\s*? # ... until an =end tag
(?:\n|$) # ... at the end of file or a newline
) # ... and stop capturing
/isx;
}
sub elements {
$_[0]->{elements} or
$_[0]->{elements} = $_[0]->_elements;
}
sub _elements {
my $self = shift;
my @elements = ();
while ( $self->{source} =~ m/$search/go ) {
push @elements, $1;
}
(List::Util::first { /^=/ } @elements) ? \@elements : '';
}
1;
=pod
=head1 TO DO
- For certain very complex cases, add a more intensive alternative parser
based on PPI
=head1 SUPPORT
See the main L<SUPPORT|Test::Inline/SUPPORT> section.
=head1 AUTHOR
Adam Kennedy E<lt>adamk@cpan.orgE<gt>, L<http://ali.as/>
=head1 COPYRIGHT
Copyright 2004 - 2013 Adam Kennedy.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
The full text of the license can be found in the
LICENSE file included with this module.
=cut
|