path: root/man/dh_auto_pod

#!/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 (<DH_AUTO_STEP>) {
		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<dh_auto_$_(1)>" } @_);
}

sub get_buildsystem_man_list_for_dh_auto {
	return join("\n\n", map { "L<dh_auto_" . $_->NAME() . "(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;