Upgrade to Module-Build-0.32
[perl.git] / lib / Module / Build / PodParser.pm
1 package Module::Build::PodParser;
2
3 use strict;
4 use vars qw($VERSION);
5 $VERSION = '0.32';
6 $VERSION = eval $VERSION;
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;