use File::Find; use Cwd; use Text::Wrap; sub output ($); @pods = qw( perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5 perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata perlsyn perlop perlre perlrun perlfunc perlvar perlsub perlmod perlmodlib perlmodinstall perlfork perlform perllocale perlref perlreftut perldsc perllol perlboot perltoot perltootc perlobj perltie perlbot perlipc perldbmfilter perldebug perlnumber perldebguts perldiag perlsec perltrap perlport perlstyle perlpod perlbook perlembed perlapio perlxs perlxstut perlguts perlcall perlcompile perlapi perlintern perlhist ); for (@pods) { s/$/.pod/ } $/ = ''; @ARGV = @pods; ($_= < qw(../lib ../ext); sub getpods { if (/\.p(od|m)$/) { # Skip .pm files that have corresponding .pod files, and Functions.pm. return if /(.*)\.pm$/ && -f "$1.pod"; my $file = $File::Find::name; return if $file eq '../lib/Pod/Functions.pm'; # Used only by pod itself die "tut $name" if $file =~ /TUT/; unless (open (F, "< $_\0")) { warn "bogus <$file>: $!"; system "ls", "-l", $file; } else { my $line; while ($line = ) { if ($line =~ /^=head1\s+NAME\b/) { push @modpods, $file; #warn "GOOD $file\n"; return; } } warn "EVIL $file\n"; } } } die "no pods" unless @modpods; for (@modpods) { #($name) = /(\w+)\.p(m|od)$/; $name = path2modname($_); if ($name =~ /^[a-z]/) { push @pragmata, $_; } else { if ($done{$name}++) { # warn "already did $_\n"; next; } push @modules, $_; push @modname, $name; } } ($_= <>, with the help of oodles of other folks. EOPOD2B output $_; output "\n"; # flush $LINE exit; sub podset { local @ARGV = @_; while(<>) { if (s/^=head1 (NAME)\s*/=head2 /) { $pod = path2modname($ARGV); unhead1(); output "\n \n\n=head2 "; $_ = <>; if ( /^\s*$pod\b/ ) { s/$pod\.pm/$pod/; # '.pm' in NAME !? output $_; } else { s/^/$pod, /; output $_; } next; } if (s/^=head1 (.*)/=item $1/) { unhead2(); output "=over\n\n" unless $inhead1; $inhead1 = 1; output $_; nl(); next; } if (s/^=head2 (.*)/=item $1/) { unitem(); output "=over\n\n" unless $inhead2; $inhead2 = 1; output $_; nl(); next; } if (s/^=item ([^=].*)/$1/) { next if $pod eq 'perldiag'; s/^\s*\*\s*$// && next; s/^\s*\*\s*//; s/\n/ /g; s/\s+$//; next if /^[\d.]+$/; next if $pod eq 'perlmodlib' && /^ftp:/; ##print "=over\n\n" unless $initem; output ", " if $initem; $initem = 1; s/\.$//; s/^-X\b/-I/; output $_; next; } if (s/^=cut\s*\n//) { unhead1(); next; } } } sub path2modname { local $_ = shift; s/\.p(m|od)$//; s-.*?/(lib|ext)/--; s-/-::-g; s/(\w+)::\1/$1/; return $_; } sub unhead1 { unhead2(); if ($inhead1) { output "\n\n=back\n\n"; } $inhead1 = 0; } sub unhead2 { unitem(); if ($inhead2) { output "\n\n=back\n\n"; } $inhead2 = 0; } sub unitem { if ($initem) { output "\n\n"; ##print "\n\n=back\n\n"; } $initem = 0; } sub nl { output "\n"; } my $NEWLINE; # how many newlines have we seen recently my $LINE; # what remains to be printed sub output ($) { for (split /(\n)/, shift) { if ($_ eq "\n") { if ($LINE) { print wrap('', '', $LINE); $LINE = ''; } if ($NEWLINE < 2) { print; $NEWLINE++; } } elsif (/\S/ && length) { $LINE .= $_; $NEWLINE = 0; } } }