#!/usr/bin/perl -w package CommandStrip; use base Pod::Parser; sub command { my $parser=shift; if (!exists $parser->{_stripped_}) { $parser->{_stripped_} = 1; return; } return $parser->SUPER::command(@_); } package main; use strict; use warnings; use Debian::Debhelper::Dh_Lib; use Debian::Debhelper::Dh_Buildsystems; use Pod::Select; use IO::String; use File::Spec; use Pod::InputObjects; my @buildsystem_pods; my $DH_AUTO_POD = "dh_auto.pod"; # Preloads build system PODs sub get_buildsystem_pods { my $parser = new Pod::Select(); if (!@buildsystem_pods) { my @buildsystems = load_all_buildsystems([ "." ]); for my $system (@buildsystems) { my $podfile = File::Spec->catfile("Debian/Debhelper/Buildsystem", $system->NAME() . ".pm"); my $iostr = new IO::String(); open(my $fh, $podfile) or error("Unable to read $podfile"); $system->{pod_fh} = $fh; # Extract build system name from POD $parser->select('NAME'); strip_first_command($parser, $fh, $iostr); # Remove empty lines and join new lines $system->{pod_name} = join(" ", grep ! /^\s*$/, split(/\n/, ${$iostr->string_ref()})); push @buildsystem_pods, $system; } } return @buildsystem_pods; } # Strips the first command (i.e. line starting with =), prints # everything else sub strip_first_command { my ($parser, $input_fh, $output_fh)=@_; my $iostr = new IO::String(); seek(\*$input_fh, 0, 0); $parser->parse_from_filehandle($input_fh, $iostr); $iostr->pos(0); CommandStrip->new()->parse_from_filehandle($iostr, $output_fh); $iostr->close(); } # Prints everything sub print_everything { my ($parser, $input_fh, $output_fh)=@_; seek(\*$input_fh, 0, 0); $parser->parse_from_filehandle($input_fh, $output_fh); } # Prints POD paragraph # Common parameters -name, -text. Results into =${-name} ${-text} sub print_pod_parag { my %args=@_; my $output_fh = $args{output} || \*STDOUT; print $output_fh Pod::Paragraph->new(@_)->raw_text(), "\n\n"; } #sub unique_authors { # my ($authors, $parser, $fh)=@_; # my $iostr = new IO::String(); # $parser->select('AUTHOR[^\s]*'); # seek(\*$fh, 0, 0); # strip_first_command($parser, $fh, $iostr); # $iostr->pos(0); # while (my $author = <$iostr>) { # $author =~ s/\s+/ /g; # $author =~ s/^\s+//; # $author =~ s/\s+$//; # $authors->{$author} = scalar(keys %$authors) # if !exists $authors->{$author}; # } # $iostr->close(); #} ############# Generation of dh_auto_step POD ############# sub get_dh_auto_shared_options_for_step { my $step=shift; my $parser = new Pod::Select(); my $iostr = new IO::String(); $parser->select('DH_AUTO SHARED OPTIONS'); print_everything($parser, \*DH_AUTO, $iostr); return ${$iostr->string_ref()}; } sub get_supported_buildsystems_intro_for_step { my $step=shift; my $parser = new Pod::Select(); my $iostr = new IO::String(); # A common "SUPPORTED BUILD SYSTEMS" dh_auto POD $parser->select('#SUPPORTED BUILD SYSTEMS INTRO FOR DH_AUTO PROGRAMS'); strip_first_command($parser, \*DH_AUTO, $iostr); return ${$iostr->string_ref()}; } sub get_supported_buildsystems_list_for_step { my $step=shift; my $parser = new Pod::Select(); my $iostr = new IO::String(); # Append build system list from build system PODs for my $bs (get_buildsystem_pods()) { my $bs_fh = $bs->{pod_fh}; # =head2 Build system name print_pod_parag(output => $iostr, -name => 'head2', -text => $bs->{pod_name}); # Now print DH_AUTO NOTES $parser->select('DH_AUTO NOTES'); strip_first_command($parser, $bs_fh, $iostr); # And step specific help follows $parser->select('BUILD PROCESS/' . ucfirst($step) . " step"); strip_first_command($parser, $bs_fh, $iostr); } return ${$iostr->string_ref()}; } sub generate_step_pod { my $step=shift; $step = $1 if ($step =~ /dh_auto_(.*)$/); my $dh_auto_step = "dh_auto_$step"; my $dh_auto_shared_options = get_dh_auto_shared_options_for_step($step); my $supported_bs_intro = get_supported_buildsystems_intro_for_step($step); my $supported_bs_list = get_supported_buildsystems_list_for_step($step); open(DH_AUTO_STEP, "podselect $dh_auto_step |") or error("Unable to read $dh_auto_step"); while () { s/#DH_AUTO SHARED OPTIONS#/$dh_auto_shared_options/; s/#SUPPORTED BUILD SYSTEMS INTRO#/$supported_bs_intro/; s/#SUPPORTED BUILD SYSTEMS LIST#/$supported_bs_list/; print $_; } close DH_AUTO_STEP; } ############# Generation of dh_auto POD ############# sub get_dh_auto_program_list_for_dh_auto { my @steps=@_; my $parser = new Pod::Select(); my $collect = ""; $parser->select('NAME'); foreach my $step (@steps) { my $iostr = new IO::String(); open (my $fh, "dh_auto_$step") or die "$_: $!"; strip_first_command($parser, $fh, $iostr); close $fh; if (${$iostr->string_ref()} =~ /^(.*?) - (.*)/) { $collect .= "=item $1(1)\n\n$2\n\n"; } } return $collect; } sub get_supported_buildsystems_for_dh_auto { my $parser = new Pod::Select(); my $iostr = new IO::String(); # Build system list from build system PODs (NAME + DESCRIPTION) for my $bs (sort { $a->NAME() cmp $b->NAME() } get_buildsystem_pods()) { my $bs_fh = $bs->{pod_fh}; # =head2 Build system name print_pod_parag(output => $iostr, -name => 'head2', -text => $bs->{pod_name}); $parser->select('DESCRIPTION'); strip_first_command($parser, $bs_fh, $iostr); } return ${$iostr->string_ref()}; } sub get_buildsystem_details_for_dh_auto { my @steps=@_; my $parser = new Pod::Select(); my $iostr = new IO::String(); # Build system details from build system PODs for my $bs (get_buildsystem_pods()) { my $bs_fh = $bs->{pod_fh}; print_pod_parag(output => $iostr, -name => 'head2', -text => $bs->NAME()); # Now print DH_AUTO NOTES $parser->select('DH_AUTO NOTES'); strip_first_command($parser, $bs_fh, $iostr); # And step specific documentation for my $step (@steps) { $parser->select('BUILD PROCESS/' . ucfirst($step) . " step"); print_pod_parag(output => $iostr, -name => 'head3', -text => 'B<' . ucfirst($step) . " step>"); strip_first_command($parser, $bs_fh, $iostr); } } return ${$iostr->string_ref()}; } sub get_dh_auto_program_man_list_for_dh_auto { return join("\n\n", map { "L" } @_); } sub get_buildsystem_man_list_for_dh_auto { return join("\n\n", map { "LNAME() . "(7)>" } get_buildsystem_pods()); } sub generate_dh_auto_pod { my @steps=@_; my $parser = new Pod::Select(); my $iostr = new IO::String(); my $dh_auto_list = get_dh_auto_program_list_for_dh_auto(@steps); my $supported_bs = get_supported_buildsystems_for_dh_auto(@steps); my $bs_details = get_buildsystem_details_for_dh_auto(@steps); my $dh_auto_man_list = get_dh_auto_program_man_list_for_dh_auto(@steps); my $bs_man_list = get_buildsystem_man_list_for_dh_auto(); # Filter out all sections starting with # $parser->select('[^#].*'); print_everything($parser, \*DH_AUTO, $iostr); seek(\*$iostr, 0, 0); while (<$iostr>) { s/#DH_AUTO LIST#/$dh_auto_list/; s/#SUPPORTED BUILD SYSTEMS#/$supported_bs/; s/#BUILD SYSTEM DETAILS#/$bs_details/; s/#DH_AUTO MAN LIST#/$dh_auto_man_list/; s/#BUILD SYSTEM MAN LIST#/$bs_man_list/; print $_; } $iostr->close(); } ############# Entry point ############# my @args; my $outfile; foreach (@ARGV) { if (/^-o(.*)/) { $outfile = $1; } else { push @args, $_; } } if ($outfile) { open(OUTFILE, ">", $outfile) or die "Unable to open output file $outfile"; open(STDOUT, ">&OUTFILE") or die "Unable to redirect standard output"; } open(DH_AUTO, $DH_AUTO_POD) or error("Unable to read $DH_AUTO_POD"); if (@args > 0) { generate_step_pod(@args); } else { generate_dh_auto_pod(qw(configure build test install clean)); } close DH_AUTO; close OUTFILE if $outfile;