Commit | Line | Data |
bb4e9162 |
1 | package Module::Build::PodParser; |
2 | |
3 | use strict; |
7a827510 |
4 | use vars qw($VERSION); |
5 | $VERSION = '0.2808_01'; |
6 | $VERSION = eval $VERSION; |
bb4e9162 |
7 | use vars qw(@ISA); |
8 | |
9 | sub 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 | |
34 | sub _myparse_from_filehandle { |
35 | my ($self, $fh) = @_; |
36 | |
37 | local $_; |
38 | while (<$fh>) { |
39 | next unless /^=(?!cut)/ .. /^=cut/; # in POD |
40 | last if ($self->{abstract}) = /^ (?: [a-z:]+ \s+ - \s+ ) (.*\S) /ix; |
41 | } |
42 | |
43 | my @author; |
44 | while (<$fh>) { |
45 | next unless /^=head1\s+AUTHORS?/ ... /^=/; |
46 | next if /^=/; |
47 | push @author, $_ if /\@/; |
48 | } |
49 | return unless @author; |
50 | s/^\s+|\s+$//g foreach @author; |
51 | |
52 | $self->{author} = \@author; |
53 | |
54 | return; |
55 | } |
56 | |
57 | sub get_abstract { |
58 | my $self = shift; |
59 | return $self->{abstract} if defined $self->{abstract}; |
60 | |
61 | $self->parse_from_filehandle($self->{fh}); |
62 | |
63 | return $self->{abstract}; |
64 | } |
65 | |
66 | sub get_author { |
67 | my $self = shift; |
68 | return $self->{author} if defined $self->{author}; |
69 | |
70 | $self->parse_from_filehandle($self->{fh}); |
71 | |
72 | return $self->{author} || []; |
73 | } |
74 | |
75 | ################## Pod::Parser overrides ########### |
76 | sub initialize { |
77 | my $self = shift; |
78 | $self->{_head} = ''; |
79 | $self->SUPER::initialize(); |
80 | } |
81 | |
82 | sub 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 | |
91 | sub textblock { |
92 | my ($self, $text) = @_; |
93 | $text =~ s/^\s+//; |
94 | $text =~ s/\s+$//; |
95 | if ($self->{_head} eq 'NAME') { |
96 | my ($name, $abstract) = split( /\s+-\s+/, $text, 2 ); |
97 | $self->{abstract} = $abstract; |
98 | } elsif ($self->{_head} =~ /^AUTHORS?$/) { |
99 | push @{$self->{author}}, $text if $text =~ /\@/; |
100 | } |
101 | } |
102 | |
103 | sub verbatim {} |
104 | sub interior_sequence {} |
105 | |
106 | 1; |