This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add Module::Build 0.27_08
[perl5.git] / lib / Module / Build / PodParser.pm
CommitLineData
bb4e9162
YST
1package Module::Build::PodParser;
2
3use strict;
4use vars qw(@ISA);
5
6sub new {
7 # Perl is so fun.
8 my $package = shift;
9
10 my $self;
11
12 # Try using Pod::Parser first
13 if (eval{ require Pod::Parser; 1; }) {
14 @ISA = qw(Pod::Parser);
15 $self = $package->SUPER::new(@_);
16 $self->{have_pod_parser} = 1;
17 } else {
18 @ISA = ();
19 *parse_from_filehandle = \&_myparse_from_filehandle;
20 $self = bless {have_pod_parser => 0, @_}, $package;
21 }
22
23 unless ($self->{fh}) {
24 die "No 'file' or 'fh' parameter given" unless $self->{file};
25 $self->{fh} = IO::File->new($self->{file}) or die "Couldn't open $self->{file}: $!";
26 }
27
28 return $self;
29}
30
31sub _myparse_from_filehandle {
32 my ($self, $fh) = @_;
33
34 local $_;
35 while (<$fh>) {
36 next unless /^=(?!cut)/ .. /^=cut/; # in POD
37 last if ($self->{abstract}) = /^ (?: [a-z:]+ \s+ - \s+ ) (.*\S) /ix;
38 }
39
40 my @author;
41 while (<$fh>) {
42 next unless /^=head1\s+AUTHORS?/ ... /^=/;
43 next if /^=/;
44 push @author, $_ if /\@/;
45 }
46 return unless @author;
47 s/^\s+|\s+$//g foreach @author;
48
49 $self->{author} = \@author;
50
51 return;
52}
53
54sub get_abstract {
55 my $self = shift;
56 return $self->{abstract} if defined $self->{abstract};
57
58 $self->parse_from_filehandle($self->{fh});
59
60 return $self->{abstract};
61}
62
63sub get_author {
64 my $self = shift;
65 return $self->{author} if defined $self->{author};
66
67 $self->parse_from_filehandle($self->{fh});
68
69 return $self->{author} || [];
70}
71
72################## Pod::Parser overrides ###########
73sub initialize {
74 my $self = shift;
75 $self->{_head} = '';
76 $self->SUPER::initialize();
77}
78
79sub command {
80 my ($self, $cmd, $text) = @_;
81 if ( $cmd eq 'head1' ) {
82 $text =~ s/^\s+//;
83 $text =~ s/\s+$//;
84 $self->{_head} = $text;
85 }
86}
87
88sub textblock {
89 my ($self, $text) = @_;
90 $text =~ s/^\s+//;
91 $text =~ s/\s+$//;
92 if ($self->{_head} eq 'NAME') {
93 my ($name, $abstract) = split( /\s+-\s+/, $text, 2 );
94 $self->{abstract} = $abstract;
95 } elsif ($self->{_head} =~ /^AUTHORS?$/) {
96 push @{$self->{author}}, $text if $text =~ /\@/;
97 }
98}
99
100sub verbatim {}
101sub interior_sequence {}
102
1031;