Commit | Line | Data |
bb4e9162 |
1 | package Module::Build::PodParser; |
2 | |
3 | use strict; |
4 | use vars qw(@ISA); |
5 | |
6 | sub 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 | |
31 | sub _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 | |
54 | sub 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 | |
63 | sub 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 ########### |
73 | sub initialize { |
74 | my $self = shift; |
75 | $self->{_head} = ''; |
76 | $self->SUPER::initialize(); |
77 | } |
78 | |
79 | sub 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 | |
88 | sub 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 | |
100 | sub verbatim {} |
101 | sub interior_sequence {} |
102 | |
103 | 1; |