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