Pod::Readme - Convert POD to README file

  use Pod::Readme;
  my $parser = Pod::Readme->new();

  # Read POD from STDIN and write to STDOUT
  $parser->parse_from_filehandle;

  # Read POD from Module.pm and write to README
  $parser->parse_from_file('Module.pm', 'README');

  pod2text Module.pm > README

  $parser = Pod::Readme->new( readme_type => "copying" );

  =begin copying

  =begin copying,readme

    testing html xhtml xml docbook rtf man nroff dsr rno latex tex code

  $parser = Pod::Readme->new( debug => 1 );

package Pod::Readme;

use 5.005;
use strict;

use Carp;
use IO::File;
use Pod::PlainText;
use Regexp::Common qw( URI );

use vars qw( @ISA $VERSION );

@ISA = qw( Pod::PlainText );

$VERSION = '0.11';

{
  my %INVALID_TYPES = map { $_ => 1, } (qw(
    test testing tests
    html xhtml xml docbook rtf man nroff dsr rno latex tex code
  ));

  sub initialize {
    my $self = shift;

    $$self{README_SKIP} ||= 0;
    $$self{readme_type} ||= "readme";

    $$self{debug}       ||= 0;

    $self->SUPER::initialize;

    croak "$$self{readme_type} is an invalid readme_type",
      if ($INVALID_TYPES{ $$self{readme_type} });
  }
}

sub output {
  my $self = shift;
  return if $$self{README_SKIP};
  $self->SUPER::output(@_);
}

sub _parse_args {
  my $self   = shift;
  my $string = shift;
  my @values = ( );

  my $arg      = "";
  my $in_quote = 0;
  my $last;
  foreach (split //, $string) {
    if (/\s/) {
      if ($in_quote) {
        $arg .= $_;
      }
      else {
        if ($arg ne "") {
          push @values, $arg;
          $arg = "";
        }
      }
    }
    else {
      $arg .= $_;
      if (/\"/) {
        if ($in_quote) {
          $in_quote = 0 unless ($last eq "\\");
        }
        else {
          # croak "expected \"name=\" before quotes" unless ($last eq "=");
          $in_quote = 1;
        }
      }
    }
    $last = $_;
  }
  push @values, $arg if ($arg ne "");
  return @values;
}

sub cmd_begin {
  my $self = shift;
  my $sec  = $$self{readme_type} || "readme";
  my @fmt  = $self->_parse_args($_[0]);
  my %secs = map { $_ => 1, } split /,/, $fmt[0];
  if ($secs{$sec}) {
    $$self{README_SKIP} = 0;
    if (($fmt[1]||"pod") eq "pod") {
    }
    elsif ($fmt[1] eq "text") {
      $$self{VERBATIM} = 1;
    }
    else {
      # TODO - return error
      $$self{EXCLUDE}  = 1;
    }
  }
  else {
    carp "Ignoring document type(s) \"$fmt[0]\" in POD line $_[1]"
      if ($$self{debug});
    $self->SUPER::cmd_begin(@_);
  }
}

sub cmd_for {
  my $self = shift;
  my $sec  = $$self{readme_type} || "readme";
  my @fmt  = $self->_parse_args($_[0]);
  my %secs = map { $_ => 1, } split /,/, $fmt[0];
  if ($secs{$sec}) {
    my $cmd = $fmt[1] || "continue";
    if ($cmd eq "stop") {
      $$self{README_SKIP} = 1;
    } elsif ($cmd eq "continue") {
      $$self{README_SKIP} = 0;
    } elsif ($cmd eq "include") {

      my %arg = map {
        s/\"//g;
        my ($k,$v) = split /\=/;
        $k => $v;
      } @fmt[2..$#fmt];
      $arg{type} ||= "pod";

      my $text =
	$self->_include_file( map { $arg{$_} } (qw( type file start stop )) );
      if ($arg{type} eq "text") {
        $self->verbatim($text, $_[1], $_[2]);
      } else {
        $self->textblock($text, $_[1], $_[2]);
      }
    } else {
      croak "Don\'t know how to \"$cmd\" in POD line $_[1]";
    }
  }
  else {
    carp "Ignoring document type(s) \"$fmt[0]\" in POD line $_[1]"
      if ($$self{debug});
    $self->SUPER::cmd_for(@_);
  }
}

sub cmd_encoding {
    my $self = shift;
    my $encoding = (split /\s+/, shift)[0];
    if ($self->{_encoding}) {
        die "=encoding option must occur only once!";
    }
    $self->{_encoding} = $encoding;
    # TODO: Need to actually do something with this option
    # At least recognising it and not dying is a step in the right direction.
}

sub _include_file {
  my $self = shift;
  my $type = shift || "pod";
  my $file = shift;
  my $mark = shift || "";
  my $stop = shift || "";

  my $fh   = IO::File->new("<$file")
    || croak "Unable to open file \"$file\"";

  my $buffer = "";
  while (my $line = <$fh>) {
    next if (($mark ne "") && ($line !~ /$mark/));
    $mark = "" if ($mark ne "");
    last if (($stop ne "") && ($line =~ /$stop/));
    $buffer .= $line;
  }
  close $fh;

  if ($type ne "pod") {
    my $indent = " " x $$self{MARGIN};
    $buffer =~ s/([\r\n]+)(\t)?/$1 . $indent x (1+length($2||""))/ge;
    $buffer =~ s/($indent)+$//;
  }

  return $buffer;
}

# This code is based on code from Pod::PlainText 2.02

sub seq_l {
  my $self = shift;
  local $_ = shift;
    # Smash whitespace in case we were split across multiple lines.
    s/\s+/ /g;

    # If we were given any explicit text, just output it.
    if (/^([^|]+)\|/) { return $1 }

    # Okay, leading and trailing whitespace isn't important; get rid of it.
    s/^\s+//;
    s/\s+$//;

    # Default to using the whole content of the link entry as a section
    # name.  Note that L<manpage/> forces a manpage interpretation, as does
    # something looking like L<manpage(section)>.  The latter is an
    # enhancement over the original Pod::Text.


    my ($manpage, $section) = ('', $_);
    if (/$RE{URI}/ || /^(?:https?|ftps?|svn):/) {
        # a URL
        return $_;
    } elsif (/^"\s*(.*?)\s*"$/) {
        $section = '"' . $1 . '"';
    } elsif (m/^[-:.\w]+(?:\(\S+\))?$/) {
        ($manpage, $section) = ($_, '');
    } elsif (m%/%) {
        ($manpage, $section) = split (/\s*\/\s*/, $_, 2);
    }

    if (length $manpage) {
      return $manpage;
    } else {
      return $section;
    }
}