create-html-usage.pl

   1 #!/usr/bin/env perl
   2
   3 # create-html-usage.pl -- insert usage lines into README
   4 # Cpoyright (C) 2015 Kyle J. McKay.  All rights reserved.
   5 # License GPLv2 or, at your option, any later version.
   6
   7 use strict;
   8 use warnings;
   9
  10 use File::Basename;
  11
  12 my $mydir = dirname($0);
  13 my $last = undef;
  14
  15 sub get_tg_usage($)
  16 {
  17         my $name = shift;
  18         my $xname;
  19         for ("$mydir/tg-$name", "$mydir/tg--$name") {
  20                 -x $_ and $xname=$_, last;
  21         }
  22         if (defined $xname) {
  23                 my $usage = `"$xname" -h 2>&1`;
  24                 chomp $usage;
  25                 $usage =~ s/^(Usage|\s+Or):\s*/: /mig;
  26                 $usage =~ s/[ \t]*\n[ \t]+/ /gs;
  27                 $usage =~ s/^: //mig;
  28                 return split "\n", $usage;
  29         } elsif ($name eq "help") {
  30                 return "tg help [-w] [<command>]";
  31         } elsif ($name eq "status") {
  32                 my $tgsthelp = $ENV{TG_STATUS_HELP_USAGE} || "status";
  33                 return "tg $tgsthelp";
  34         }
  35         return undef;
  36 }
  37
  38 sub wrap
  39 {
  40         my ($w, $i, $s) = @_;
  41         my $h = ' ' x $i;
  42         my $ans = '';
  43         while (length($s) > $w && $s =~ /^(.{1,$w})(?<=\w)\b[ \t]+(.+)$/s) {
  44                 $ans .= $1."\n";
  45                 $s = "$h$2";
  46         }
  47         $ans .= $s if $s !~ /^\s*$/;
  48         return $ans;
  49 }
  50
  51 my $textmode;
  52 $textmode=1, shift if defined($ARGV[0]) && $ARGV[0] eq '--text';
  53 my $tab = ' ' x 8;
  54 while (my $line = <>) {
  55         chomp $line;
  56         1 while $line =~ s/\t+/" " x (($+[0] - $-[0]) * 8 - $-[0] % 8)/e;
  57         $line =~ s'^``(.*)``$'wrap(78, 4, $1)'e if $textmode;
  58         $line =~ s'^(\s*):`(.+?)`_:'"$1$2  "'e if $textmode;
  59         $line =~ s'^(\s*):(\w+?)_?:'"$1$2"'e if $textmode;
  60         if (defined($last)) {
  61                 printf "%s\n",  $last;
  62                 if ($line =~ /^[~]+$/ && $last =~ /^tg ([^\s]+)$/) {
  63                         my @usage = get_tg_usage($1);
  64                         if (@usage) {
  65                                 printf "%s\n", $line;
  66                                 if ($textmode) {
  67                                         printf "%s", join("",map({wrap(78, 12, "$tab$_")."\n"} @usage));
  68                                 } else {
  69                                         printf "%s", join("",map({"$tab| ".'``'.$_.'``'."\n"} @usage));
  70                                 }
  71                                 $line = "";
  72                         }
  73                 }
  74         }
  75         $last = $line;
  76 }
  77
  78 printf "%s\n", $last if defined($last);
  79 exit 0;