summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Module/Build/PodParser.pm
blob: 5bba10aae38e60fb1234a492a90d99b77756b8ce (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
package Module::Build::PodParser;

use strict;
use vars qw($VERSION);
$VERSION = '0.3800';
$VERSION = eval $VERSION;
use vars qw(@ISA);

sub new {
  # Perl is so fun.
  my $package = shift;

  my $self;

  # Try using Pod::Parser first
  if (eval{ require Pod::Parser; 1; }) {
    @ISA = qw(Pod::Parser);
    $self = $package->SUPER::new(@_);
    $self->{have_pod_parser} = 1;
  } else {
    @ISA = ();
    *parse_from_filehandle = \&_myparse_from_filehandle;
    $self = bless {have_pod_parser => 0, @_}, $package;
  }

  unless ($self->{fh}) {
    die "No 'file' or 'fh' parameter given" unless $self->{file};
    $self->{fh} = IO::File->new($self->{file}) or die "Couldn't open $self->{file}: $!";
  }

  return $self;
}

sub _myparse_from_filehandle {
  my ($self, $fh) = @_;

  local $_;
  while (<$fh>) {
    next unless /^=(?!cut)/ .. /^=cut/;  # in POD
    last if ($self->{abstract}) = /^  (?:  [a-z:]+  \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} || [];
}

################## Pod::Parser overrides ###########
sub initialize {
  my $self = shift;
  $self->{_head} = '';
  $self->SUPER::initialize();
}

sub command {
  my ($self, $cmd, $text) = @_;
  if ( $cmd eq 'head1' ) {
    $text =~ s/^\s+//;
    $text =~ s/\s+$//;
    $self->{_head} = $text;
  }
}

sub textblock {
  my ($self, $text) = @_;
  $text =~ s/^\s+//;
  $text =~ s/\s+$//;
  if (uc $self->{_head} eq 'NAME') {
    my ($name, $abstract) = split( /\s+-\s+/, $text, 2 );
    $self->{abstract} = $abstract;
  } elsif ($self->{_head} =~ /^AUTHORS?$/i) {
    push @{$self->{author}}, $text if $text =~ /\@/;
  }
}

sub verbatim {}
sub interior_sequence {}

1;