cpan/Module-Build/lib/Module/Build/PodParser.pm

   1 package Module::Build::PodParser;
   2
   3 use strict;
   4 use vars qw($VERSION);
   5 $VERSION = '0.36';
   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?/i ... /^=/;
  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 (uc $self->{_head} eq 'NAME') {
  96     my ($name, $abstract) = split( /\s+-\s+/, $text, 2 );
  97     $self->{abstract} = $abstract;
  98   } elsif ($self->{_head} =~ /^AUTHORS?$/i) {
  99     push @{$self->{author}}, $text if $text =~ /\@/;
 100   }
 101 }
 102
 103 sub verbatim {}
 104 sub interior_sequence {}
 105
 106 1;