man/dh_auto_pod

   1 #!/usr/bin/perl -w
   2
   3 package CommandStrip;
   4 use base Pod::Parser;
   5
   6 sub command {
   7         my $parser=shift;
   8         if (!exists $parser->{_stripped_}) {
   9                 $parser->{_stripped_} = 1;
  10                 return;
  11         }
  12         return $parser->SUPER::command(@_);
  13 }
  14
  15 package main;
  16
  17 use strict;
  18 use warnings;
  19 use Debian::Debhelper::Dh_Lib;
  20 use Debian::Debhelper::Dh_Buildsystems;
  21 use Pod::Select;
  22 use IO::String;
  23 use File::Spec;
  24 use Pod::InputObjects;
  25
  26 my @buildsystem_pods;
  27 my $DH_AUTO_POD = "dh_auto.pod";
  28
  29 # Preloads build system PODs
  30 sub get_buildsystem_pods {
  31         my $parser = new Pod::Select();
  32         if (!@buildsystem_pods) {
  33                 my @buildsystems = load_all_buildsystems([ "." ]);
  34                 for my $system (@buildsystems) {
  35                         my $podfile = File::Spec->catfile("Debian/Debhelper/Buildsystem", $system->NAME() . ".pm");
  36                         my $iostr = new IO::String();
  37
  38                         open(my $fh, $podfile) or error("Unable to read $podfile");
  39                         $system->{pod_fh} = $fh;
  40
  41                         # Extract build system name from POD
  42                         $parser->select('NAME');
  43                         strip_first_command($parser, $fh, $iostr);
  44
  45                         # Remove empty lines and join new lines
  46                         $system->{pod_name} = join(" ", grep ! /^\s*$/, split(/\n/, ${$iostr->string_ref()}));
  47
  48                         push @buildsystem_pods, $system;
  49                 }
  50         }
  51         return @buildsystem_pods;
  52 }
  53
  54 # Strips the first command (i.e. line starting with =), prints
  55 # everything else
  56 sub strip_first_command {
  57         my ($parser, $input_fh, $output_fh)=@_;
  58
  59         my $iostr = new IO::String();
  60         seek(\*$input_fh, 0, 0);
  61         $parser->parse_from_filehandle($input_fh, $iostr);
  62         $iostr->pos(0);
  63         CommandStrip->new()->parse_from_filehandle($iostr, $output_fh);
  64         $iostr->close();
  65 }
  66
  67 # Prints everything
  68 sub print_everything {
  69         my ($parser, $input_fh, $output_fh)=@_;
  70         seek(\*$input_fh, 0, 0);
  71         $parser->parse_from_filehandle($input_fh, $output_fh);
  72 }
  73
  74 # Prints POD paragraph
  75 # Common parameters -name, -text. Results into =${-name} ${-text}
  76 sub print_pod_parag {
  77         my %args=@_;
  78         my $output_fh = $args{output} || \*STDOUT;
  79         print $output_fh Pod::Paragraph->new(@_)->raw_text(), "\n\n";
  80 }
  81
  82 #sub unique_authors {
  83 #       my ($authors, $parser, $fh)=@_;
  84 #       my $iostr = new IO::String();
  85
  86 #       $parser->select('AUTHOR[^\s]*');
  87 #       seek(\*$fh, 0, 0);
  88 #       strip_first_command($parser, $fh, $iostr);
  89 #       $iostr->pos(0);
  90 #       while (my $author = <$iostr>) {
  91 #               $author =~ s/\s+/ /g;
  92 #               $author =~ s/^\s+//;
  93 #               $author =~ s/\s+$//;
  94 #               $authors->{$author} = scalar(keys %$authors)
  95 #                   if !exists $authors->{$author};
  96 #       }
  97 #       $iostr->close();
  98 #}
  99
 100 ############# Generation of dh_auto_step POD #############
 101
 102 sub get_dh_auto_shared_options_for_step {
 103         my $step=shift;
 104         my $parser = new Pod::Select();
 105         my $iostr = new IO::String();
 106
 107         $parser->select('DH_AUTO SHARED OPTIONS');
 108         print_everything($parser, \*DH_AUTO, $iostr);
 109         return ${$iostr->string_ref()};
 110 }
 111
 112 sub get_supported_buildsystems_intro_for_step {
 113         my $step=shift;
 114         my $parser = new Pod::Select();
 115         my $iostr = new IO::String();
 116
 117         # A common "SUPPORTED BUILD SYSTEMS" dh_auto POD
 118         $parser->select('#SUPPORTED BUILD SYSTEMS INTRO FOR DH_AUTO PROGRAMS');
 119         strip_first_command($parser, \*DH_AUTO, $iostr);
 120         return ${$iostr->string_ref()};
 121 }
 122
 123 sub get_supported_buildsystems_list_for_step {
 124         my $step=shift;
 125         my $parser = new Pod::Select();
 126         my $iostr = new IO::String();
 127
 128         # Append build system list from build system PODs
 129         for my $bs (get_buildsystem_pods()) {
 130                 my $bs_fh = $bs->{pod_fh};
 131
 132                 # =head2 Build system name
 133                 print_pod_parag(output => $iostr, -name => 'head2', -text => $bs->{pod_name});
 134
 135                 # Now print DH_AUTO NOTES
 136                 $parser->select('DH_AUTO NOTES');
 137                 strip_first_command($parser, $bs_fh, $iostr);
 138
 139                 # And step specific help follows
 140                 $parser->select('BUILD PROCESS/' . ucfirst($step) . " step");
 141                 strip_first_command($parser, $bs_fh, $iostr);
 142         }
 143         return ${$iostr->string_ref()};
 144 }
 145
 146 sub generate_step_pod {
 147         my $step=shift;
 148         $step = $1 if ($step =~ /dh_auto_(.*)$/);
 149
 150         my $dh_auto_step = "dh_auto_$step";
 151         my $dh_auto_shared_options = get_dh_auto_shared_options_for_step($step);
 152         my $supported_bs_intro = get_supported_buildsystems_intro_for_step($step);
 153         my $supported_bs_list = get_supported_buildsystems_list_for_step($step);
 154         open(DH_AUTO_STEP, "podselect $dh_auto_step |")
 155             or error("Unable to read $dh_auto_step");
 156         while (<DH_AUTO_STEP>) {
 157                 s/#DH_AUTO SHARED OPTIONS#/$dh_auto_shared_options/;
 158                 s/#SUPPORTED BUILD SYSTEMS INTRO#/$supported_bs_intro/;
 159                 s/#SUPPORTED BUILD SYSTEMS LIST#/$supported_bs_list/;
 160                 print $_;
 161         }
 162         close DH_AUTO_STEP;
 163 }
 164
 165 ############# Generation of dh_auto POD #############
 166
 167 sub get_dh_auto_program_list_for_dh_auto {
 168         my @steps=@_;
 169         my $parser = new Pod::Select();
 170         my $collect = "";
 171
 172         $parser->select('NAME');
 173         foreach my $step (@steps) {
 174                 my $iostr = new IO::String();
 175                 open (my $fh, "dh_auto_$step") or die "$_: $!";
 176                 strip_first_command($parser, $fh, $iostr);
 177                 close $fh;
 178                 if (${$iostr->string_ref()} =~ /^(.*?) - (.*)/) {
 179                         $collect .= "=item $1(1)\n\n$2\n\n";
 180                 }
 181         }
 182         return $collect;
 183 }
 184
 185 sub get_supported_buildsystems_for_dh_auto {
 186         my $parser = new Pod::Select();
 187         my $iostr = new IO::String();
 188
 189         # Build system list from build system PODs (NAME + DESCRIPTION)
 190         for my $bs (sort { $a->NAME() cmp $b->NAME() } get_buildsystem_pods()) {
 191                 my $bs_fh = $bs->{pod_fh};
 192
 193                 # =head2 Build system name
 194                 print_pod_parag(output => $iostr, -name => 'head2', -text => $bs->{pod_name});
 195
 196                 $parser->select('DESCRIPTION');
 197                 strip_first_command($parser, $bs_fh, $iostr);
 198         }
 199         return ${$iostr->string_ref()};
 200 }
 201
 202 sub get_buildsystem_details_for_dh_auto {
 203         my @steps=@_;
 204         my $parser = new Pod::Select();
 205         my $iostr = new IO::String();
 206
 207         # Build system details from build system PODs
 208         for my $bs (get_buildsystem_pods()) {
 209                 my $bs_fh = $bs->{pod_fh};
 210
 211                 print_pod_parag(output => $iostr, -name => 'head2', -text => $bs->NAME());
 212
 213                 # Now print DH_AUTO NOTES
 214                 $parser->select('DH_AUTO NOTES');
 215                 strip_first_command($parser, $bs_fh, $iostr);
 216
 217                 # And step specific documentation
 218                 for my $step (@steps) {
 219                         $parser->select('BUILD PROCESS/' . ucfirst($step) . " step");
 220                         print_pod_parag(output => $iostr, -name => 'head3', -text => 'B<' . ucfirst($step) . " step>");
 221                         strip_first_command($parser, $bs_fh, $iostr);
 222                 }
 223         }
 224         return ${$iostr->string_ref()};
 225 }
 226
 227 sub get_dh_auto_program_man_list_for_dh_auto {
 228         return join("\n\n", map { "L<dh_auto_$_(1)>" } @_);
 229 }
 230
 231 sub get_buildsystem_man_list_for_dh_auto {
 232         return join("\n\n", map { "L<dh_auto_" . $_->NAME() . "(7)>" } get_buildsystem_pods());
 233 }
 234
 235 sub generate_dh_auto_pod {
 236         my @steps=@_;
 237         my $parser = new Pod::Select();
 238         my $iostr = new IO::String();
 239
 240         my $dh_auto_list = get_dh_auto_program_list_for_dh_auto(@steps);
 241         my $supported_bs = get_supported_buildsystems_for_dh_auto(@steps);
 242         my $bs_details = get_buildsystem_details_for_dh_auto(@steps);
 243         my $dh_auto_man_list = get_dh_auto_program_man_list_for_dh_auto(@steps);
 244         my $bs_man_list = get_buildsystem_man_list_for_dh_auto();
 245
 246         # Filter out all sections starting with #
 247         $parser->select('[^#].*');
 248         print_everything($parser, \*DH_AUTO, $iostr);
 249
 250         seek(\*$iostr, 0, 0);
 251         while (<$iostr>) {
 252                 s/#DH_AUTO LIST#/$dh_auto_list/;
 253                 s/#SUPPORTED BUILD SYSTEMS#/$supported_bs/;
 254                 s/#BUILD SYSTEM DETAILS#/$bs_details/;
 255                 s/#DH_AUTO MAN LIST#/$dh_auto_man_list/;
 256                 s/#BUILD SYSTEM MAN LIST#/$bs_man_list/;
 257                 print $_;
 258         }
 259         $iostr->close();
 260 }
 261
 262 ############# Entry point #############
 263
 264 my @args;
 265 my $outfile;
 266 foreach (@ARGV) {
 267         if (/^-o(.*)/) {
 268                 $outfile = $1;
 269         }
 270         else {
 271                 push @args, $_;
 272         }
 273 }
 274
 275 if ($outfile) {
 276         open(OUTFILE, ">", $outfile) or die "Unable to open output file $outfile";
 277         open(STDOUT, ">&OUTFILE") or die "Unable to redirect standard output";
 278 }
 279
 280 open(DH_AUTO, $DH_AUTO_POD) or error("Unable to read $DH_AUTO_POD");
 281 if (@args > 0) {
 282         generate_step_pod(@args);
 283 }
 284 else {
 285         generate_dh_auto_pod(qw(configure build test install clean));
 286 }
 287 close DH_AUTO;
 288 close OUTFILE if $outfile;