[Summary view] [Print] [Text view]

   1  package Module::Build::PodParser;
   2  
   3  use strict;
   4  use vars qw($VERSION);
   5  $VERSION = '0.2808_01';
   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;