diff options
author | Lorry Tar Creator <lorry-tar-importer@lorry> | 2015-06-11 22:32:06 +0000 |
---|---|---|
committer | Lorry Tar Creator <lorry-tar-importer@lorry> | 2015-06-11 22:32:06 +0000 |
commit | 467298a34215401cdcbb1dded51bc2aba5f1f41c (patch) | |
tree | 1923f32fbc9cf8f0b4ab291d1eb9fad5ab872d68 /lib/Module/Build/PodParser.pm | |
download | Module-Build-tarball-master.tar.gz |
Module-Build-0.4214HEADModule-Build-0.4214master
Diffstat (limited to 'lib/Module/Build/PodParser.pm')
-rw-r--r-- | lib/Module/Build/PodParser.pm | 63 |
1 files changed, 63 insertions, 0 deletions
diff --git a/lib/Module/Build/PodParser.pm b/lib/Module/Build/PodParser.pm new file mode 100644 index 0000000..277ee59 --- /dev/null +++ b/lib/Module/Build/PodParser.pm @@ -0,0 +1,63 @@ +package Module::Build::PodParser; + +use strict; +use warnings; +our $VERSION = '0.4214'; +$VERSION = eval $VERSION; + +sub new { + # Perl is so fun. + my $package = shift; + + my $self; + $self = bless {have_pod_parser => 0, @_}, $package; + + unless ($self->{fh}) { + die "No 'file' or 'fh' parameter given" unless $self->{file}; + open($self->{fh}, '<', $self->{file}) or die "Couldn't open $self->{file}: $!"; + } + + return $self; +} + +sub parse_from_filehandle { + my ($self, $fh) = @_; + + local $_; + while (<$fh>) { + next unless /^=(?!cut)/ .. /^=cut/; # in POD + # Accept Name - abstract or C<Name> - abstract + last if ($self->{abstract}) = /^ (?: [a-z_0-9:]+ | [BCIF] < [a-z_0-9:]+ > ) \s+ - \s+ (.*\S) /ix; + } + + my @author; + while (<$fh>) { + next unless /^=head1\s+AUTHORS?/i ... /^=/; + next if /^=/; + push @author, $_ if /\@/; + } + return unless @author; + s/^\s+|\s+$//g foreach @author; + + $self->{author} = \@author; + + return; +} + +sub get_abstract { + my $self = shift; + return $self->{abstract} if defined $self->{abstract}; + + $self->parse_from_filehandle($self->{fh}); + + return $self->{abstract}; +} + +sub get_author { + my $self = shift; + return $self->{author} if defined $self->{author}; + + $self->parse_from_filehandle($self->{fh}); + + return $self->{author} || []; +} |