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 perlform perllocale perlref perldsc perllol perltoot perlobj perltie perlbot perlipc perldebug perldiag perlsec perltrap perlstyle perlpod perlbook perlembed perlapio perlxs perlxstut perlguts perlcall 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); unitem(); unhead2(); 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/) { unitem(); unhead2(); output $_; nl(); next; } if (s/^=head2 (.*)/=item $1/) { unitem(); output "=over\n\n" unless $inhead2; $inhead2 = 1; output $_; nl(); next; } if (s/^=item ([^=].*)\n/$1/) { next if $pod eq 'perldiag'; s/^\s*\*\s*$// && next; s/^\s*\*\s*//; 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; } } } sub path2modname { local $_ = shift; s/\.p(m|od)$//; s-.*?/(lib|ext)/--; s-/-::-g; s/(\w+)::\1/$1/; return $_; } sub unhead2 { if ($inhead2) { output "\n\n=back\n\n"; } $inhead2 = 0; $initem = 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; } } }