=head1 NAME genhelp - Build lib/VCP/Help.pm by extracting POD from the listed files =head1 SYNOPSYS genhelp bin/vcp lib/VCP.pm lib/VCP/Foo.pm ... =head1 When bundling libraries and POD files with PAR <= 0.79, it is difficult to find and parse the files to generate help with. So we extract it and build it in to a Perl module as a bunch of strings using this tool. See Makefile.PL for how this tool is automated. =cut my $text; ## My::Pod::Usage writes to this instead of STDOUT. It's a global ## to allow us to call pod2usage() and collect its output. ############################################################################### package My::Pod::Text; use Pod::Text; @ISA = qw( Pod::Text ); sub parse_from_file { my $self = shift; $text = ""; $self->SUPER::parse_from_file( @_ ); } sub output { $text .= $_[1]; } ############################################################################### package main; use strict; use lib 'lib'; use List::Util; use Pod::Usage; use VCP::PodDESCRIPTIONParser; use VCP::PodOPTIONSParser; use Text::Wrap qw( wrap ); ## HACK: Pod::* are very single minded about only outputting to the ## console. Subvert Pod::Usage. @Pod::Usage::ISA = qw( My::Pod::Text ); use lib 'lib'; open OUTPUT, ">lib/VCP/Help.pm" or die "$!: lib/VCP/Help.pm"; warn "writing lib/VCP/Help.pm\n"; print OUTPUT < <<'TOPIC',\n$text\nTOPIC\n"; } sub wrap_pod_paragraphs { local $Text::Wrap::columns = shift; return map /^\s/ || /==\z/ ? "$_" : wrap( "", "", map split( /\n+/ ), $_ ), @_; } sub pod_paragraphs_to_string { return join "\n", "", map( "$_\n", wrap_pod_paragraphs 60, @_ ), ## We wrap at 60 because paragraphs that pass through here ## are destined to be printed to a config file as inline ## commmentary and need to be narrow so they can be indented. "\n"; } sub wrap_into_3_columns { my @topics = @_; ## Display 3 columns of topics push @topics, "" while @topics % 3; my $l = List::Util::max( map length, @topics ); my $m = @topics / 3; return join "", map( sprintf( " %-${l}s %-${l}s %s\n", @topics[ $_, $_+$m, $_+2*$m ] ), (0..$m - 1) ); } sub class_hierarchy { my ( $class ) = @_; my @isa_q = ( $class ); ## The queue of unvisited classes my %seen_classes; ## Classes to be skipped because they've been seen. my @classes; while ( @isa_q ) { my $class = shift @isa_q; next if $seen_classes{$class}++; push @classes, $class; push @isa_q, do { no strict "refs"; @{"${class}::ISA"}; }; } return @classes; } ############################################################################### my @topics; my %seen; for my $fn ( @ARGV ) { my $topic = $fn; $topic =~ s{.*\b(bin|VCP)[\\/]}{}i; $topic =~ s{\..*}{}; $topic =~ s{[\\/]}{::}g; warn( "Already emitted topic $topic from $seen{$topic}\n" ), next if $seen{$topic}; $seen{$topic} = $fn; push @topics, $topic; ## Convert the whole POD in to a large help file for "vcp help" do { my $p = My::Pod::Text->new( width => 72 ); $p->parse_from_file( $fn ); }; print_topic $topic, $text; ## Extract usage and config file docs for sources, filters and dests next unless $topic =~ /^(vcp$|source::|filter::|dest::)/i; pod2usage( -input => $fn, -verbose => 0, -exitval => 'noexit', ) ; print_topic "$topic usage", $text; if ( $topic ne "vcp" ) { print_topic "$topic description", pod_paragraphs_to_string @{VCP::PodDESCRIPTIONParser->parse( $fn )}; my $class = "VCP::$topic"; eval "require $class" or die "$@: VCP::$class\n"; my @classes = class_hierarchy $class; my $opts_hash = VCP::PodOPTIONSParser->parse( reverse @classes ); ## reverse()d because we want parent classes to be scanned ## first so derived classes can replace options docs. for ( sort keys %$opts_hash ) { ( my $name = $_ ) =~ s/^--?//; print_topic( "$topic option $name", pod_paragraphs_to_string( @{$opts_hash->{$_}} ) ); }; } } { @topics = sort @topics; print_topic "topics", join "", "vcp help topics:\n\n", wrap_into_3_columns( @topics ); } { print_topic "", <<'TOPIC'; vcp - Version Copy, a tool for copying versions file repositories help topics (use "vcp help " to see): vcp General help for the vcp command source::cvs Extracting from a cvs repository source::p4 Extracting from a p4 repository source::vss Extracting from a VSS repository dest::cvs Inserting in to a cvs repository dest::p4 Inserting in to a p4 repository newlines Newline, ^Z and NULL issues process How vcp works license Copyright and license information topics All available topics The PAGER environment variable specifies pager program to use for these help topics. TOPIC } print OUTPUT <get( \@_ ); } sub error { CORE::print STDERR shift->get( \@_ ); } 1; POSTAMBLE