home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / PodParser.pm < prev    next >
Encoding:
Perl POD Document  |  2004-02-08  |  2.1 KB  |  106 lines
  1. package Module::Build::PodParser;
  2.  
  3. use strict;
  4. use vars qw(@ISA);
  5.  
  6. sub new {
  7.   # Perl is so fun.
  8.   my $package = shift;
  9.  
  10.   my $self;
  11.  
  12.   # Try using Pod::Parser first
  13.   if (eval{ require Pod::Parser; 1; }) {
  14.     @ISA = qw(Pod::Parser);
  15.     $self = $package->SUPER::new(@_);
  16.     $self->{have_pod_parser} = 1;
  17.   } else {
  18.     @ISA = ();
  19.     *parse_from_filehandle = \&_myparse_from_filehandle;
  20.     $self = bless {have_pod_parser => 0, @_}, $package;
  21.   }
  22.  
  23.   unless ($self->{fh}) {
  24.     die "No 'file' or 'fh' parameter given" unless $self->{file};
  25.     $self->{fh} = IO::File->new($self->{file}) or die "Couldn't open $self->{file}: $!";
  26.   }
  27.  
  28.   return $self;
  29. }
  30.  
  31. sub _myparse_from_filehandle {
  32.   my ($self, $fh) = @_;
  33.   
  34.   local $_;
  35.   while (<$fh>) {
  36.     next unless /^=(?!cut)/ .. /^=cut/;  # in POD
  37.     last if ($self->{abstract}) = /^  (?:  [a-z:]+  \s+ - \s+  )  (.*\S)  /ix;
  38.   }
  39.   
  40.   my @author;
  41.   while (<$fh>) {
  42.     next unless /^=head1\s+AUTHOR/ ... /^=/;
  43.     next if /^=/;
  44.     push @author, $_;
  45.   }
  46.   return unless @author;
  47.   
  48.   $self->{author} = join '', @author;
  49.   $self->{author} =~ s/^\s+|\s+$//g;
  50.   
  51.   return;
  52. }
  53.  
  54. sub get_abstract {
  55.   my $self = shift;
  56.   return $self->{abstract} if defined $self->{abstract};
  57.   
  58.   $self->parse_from_filehandle($self->{fh});
  59.  
  60.   return $self->{abstract};
  61. }
  62.  
  63. sub get_author {
  64.   my $self = shift;
  65.   return $self->{author} if defined $self->{author};
  66.   
  67.   $self->parse_from_filehandle($self->{fh});
  68.  
  69.   return $self->{author};  
  70. }
  71.  
  72. ################## Pod::Parser overrides ###########
  73. sub initialize {
  74.   my $self = shift;
  75.   $self->{_head} = '';
  76.   $self->SUPER::initialize();
  77. }
  78.  
  79. sub command {
  80.   my ($self, $cmd, $text) = @_;
  81.   if ( $cmd eq 'head1' ) {
  82.     $text =~ s/^\s+//;
  83.     $text =~ s/\s+$//;
  84.     $self->{_head} = $text;
  85.   }
  86. }
  87.  
  88.  
  89. sub textblock {
  90.   my ($self, $text) = @_;
  91.   $text =~ s/^\s+//;
  92.   $text =~ s/\s+$//;
  93.   if ($self->{_head} eq 'NAME') {
  94.     my ($name, $abstract) = split( /\s+-\s+/, $text, 2 );
  95.     $self->{abstract} = $abstract;
  96.   } elsif ($self->{_head} eq 'AUTHOR') {
  97.     $self->{author} = $text;
  98.   }
  99.   $self->{_head} = '';
  100. }
  101.  
  102. sub verbatim {}
  103. sub interior_sequence {}
  104.  
  105. 1;
  106.