view release on metacpan or  search on metacpan

pod/buildtoc  view on Meta::CPAN

toroff=`
	echo		\
EOH
    | perl -ne 'map { -r && print "$_ " } split'`

    # Bypass internal shell buffer limit -- can't use case
    if perl -e '$x = shift; exit($x =~ m|/|)' $toroff; then
	echo "$me: empty file list -- did you run install?" >&2
	exit 1
    fi

    #psroff -t -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.ps 2>$tmp/PerlTOC.raw
    #nroff -man -rC1 -rD1 -rF1 > $tmp/PerlDoc.txt 2>$tmp/PerlTOC.nr.raw

    # First, create the raw data
    run="$cmd -rC1 -rD1 -rF1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
    echo "$me: running $run"
    eval $run $toroff

    #Now create the TOC
    echo "$me: parsing TOC"
    perl rofftoc $tmp/PerlTOC.$ext.raw > $tmp/PerlTOC.tmp.man
    run="$cmd $tmp/PerlTOC.tmp.man >$tmp/PerlTOC.$ext"
    echo "$me: running $run"
    eval $run

    # Finally, recreate the Doc, without the blank page 0
    run="$cmd -rC1 -rD1 >$tmp/PerlDoc.$ext 2>$tmp/PerlTOC.$ext.raw"
    echo "$me: running $run"
    eval $run $toroff
    rm -f $tmp/PerlTOC.tmp.man $tmp/PerlTOC.$ext.raw
    echo "$me: leaving you with $tmp/PerlDoc.$ext and $tmp/PerlTOC.$ext"
EOT

exit(0);

# Below are all the auxiliary routines for generating perltoc.pod

my ($inhead1, $inhead2, $initem);

sub podset {
    my ($pod, $file) = @_;

    open my $fh, '<:', $file or my_die "Can't open file '$file' for $pod: $!";

    local *_;
    my $found_pod;
    while (<$fh>) {
        if (/^=head1\s+NAME\b/) {
            ++$found_pod;
            last;
        }
    }

    unless ($found_pod) {
	warn "$0: NOTE: cannot find '=head1 NAME' in:\n  $file\n" unless $Quiet;
        return;
    }

    seek $fh, 0, 0 or my_die "Can't rewind file '$file': $!";
    local $/ = '';

    while(<$fh>) {
	s/\r$//;
	if (s/^=head1 (NAME)\s*/=head2 /) {
	    unhead1();
	    $OUT .= "\n\n=head2 ";
	    $_ = <$fh>;
            last unless defined $_;
	    # Remove svn keyword expansions from the Perl FAQ
	    s/ \(\$Revision: \d+ \$\)//g;
	    if ( /^\s*\Q$pod\E\b/ ) {
		s/$pod\.pm/$pod/;       # '.pm' in NAME !?
	    } else {
		s/^/$pod, /;
	    }
	}
	elsif (s/^=head1 (.*)/=item $1/) {
	    unhead2();
	    $OUT .= "=over 4\n\n" unless $inhead1;
	    $inhead1 = 1;
	    $_ .= "\n";
	}
	elsif (s/^=head2 (.*)/=item $1/) {
	    unitem();
	    $OUT .= "=over 4\n\n" unless $inhead2;
	    $inhead2 = 1;
	    $_ .= "\n";
	}
	elsif (s/^=item ([^=].*)/$1/) {
	    next if $pod eq 'perldiag';
	    s/^\s*\*\s*$// && next;
	    s/^\s*\*\s*//;
	    s/\n/ /g;
	    s/\s+$//;
	    # make sure inner links include the target page
	    s{L<(?:[^|>]+\|)?\K/}{$pod/}g;
	    next if /^[\d.]+$/;
	    next if $pod eq 'perlmodlib' && /^ftp:/;
	    $OUT .= ", " if $initem;
	    $initem = 1;
	    s/\.$//;
	    s/^-X\b/-I<X>/;
	}
	else {
	    unhead1() if /^=cut\s*\n/;
	    next;
	}
	$OUT .= $_;
    }
}

sub unhead1 {
    unhead2();
    if ($inhead1) {
	$OUT .= "\n\n=back\n\n";
    }
    $inhead1 = 0;
}

sub unhead2 {