Makefile Documentation

#! /bin/perl
# -*- coding:utf-8 -*-
# makefiledoc.pl

use strict;

# ==================================================
# 追加修正可能な出力処理部
# ==================================================

# 1行出力コールバック関数
#
# コールバック関数への引数
#   第1引数 -- 直前の行の種類
#   第2引数 -- 現在の行の種類
#   次のどれかが渡される
#     * 'none' -- なし
#     * 'title' -- タイトルの行
#     * 'var' -- 変数の説明の行
#     * 'target' -- ターゲットの説明の行
#   第3引数 -- 行の種類、名前、説明文字列からなる配列への参照
#              タイトルのときは名前は空
#
#  第2引数と第3引数の第1要素が同じで冗長だが、気にしないように。

sub OutHtml($$$) {
    my ($prev, $cur, $refData) = @_;
    my $name = $refData->[1];
    my $desc = $refData->[2];

    print "<table border=\"1\">\n"
	if ($cur eq 'var' || $cur eq 'target') && ($prev eq 'none' || $prev eq 'title');
    print "</table>\n"
	if ($cur eq 'title' || $cur eq 'none') && ($prev eq 'var' || $prev eq 'target');
    print "<h2>$desc</h2>\n"  if $cur eq 'title';
    print "<tr><td><b>$name</b></td><td>$desc</td><tr>\n"
	if $cur eq 'var';
    print "<tr><td><i>$name</i>&nbsp;<b>:</b></td><td>$desc</td><tr>\n"
	if $cur eq 'target';
}

sub OutText($$$) {
    my ($prev, $cur, $refData) = @_;
    my $name = $refData->[1];
    my $desc = $refData->[2];
    
    print " * $name -- $desc\n" if $cur eq 'var';
    print " * $name : -- $desc\n" if $cur eq 'target';
    print "\n$desc\n\n" if $cur eq 'title';
}

sub OutMake($$$) {
    my ($prev, $cur, $refData) = @_;
    my $name = $refData->[1];
    my $desc = $refData->[2];
    
    print "\t\@echo \"$name='\$($name)'\"\n" if $cur eq 'var';
}

# 出力スタイル登録簿

my %Styles = (
# HTML style
    html => {
	begin => <<EOS,
<head>
  <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
  <title>Makefile Documentation</title>
</head>
<bdy>
  <h1>Makefile Documentation</h1>
EOS
	end => <<EOS,
</body> 
</html>
EOS
	out => \&OutHtml
    },

# Text style
    text => {
	begin => <<EOS,
;; -*- coding:utf-8 -*-

Makefile Documentation

EOS
	end => <<EOS,

EOS
	out => \&OutText
    },

# Make print_vars style
    make => {
	begin => <<EOS,
print_vars:
EOS
	end => <<EOS,
EOS
	out => \&OutMake
    },
    );

# ==================================================
# コマンドライン引数の処理
# ==================================================

sub Usage() {
    print STDERR "arguments: [style-option] makefile\n";
    print STDERR "options:\n";
    foreach (keys %Styles) {
	print "\t--$_\n"
    }
    exit 0;
}

my $style = 'html';
if ($ARGV[0] =~ /--(.*)/) {
    shift; 
    &Usage() if !(exists $Styles{$1});
    $style = $1;
}

my $in;
if (@ARGV) {
    open $in, $ARGV[0] or die "$!";
} else {
    $in = *STDIN;
}

# ==================================================
# 主処理
# ==================================================

# 状態定数
my $NEUTRAL = 0;
my $DOC_COMMENT = 1;  # 直前にdocコメント行出現

# 正規表現パターン
my $reCommentLine = '^\s*#\*\s*(.*)$'; # $1 = コメント本文
my $reVarDefLine = '^\s*(\w+)\s*.?='; # $1 = 変数名
my $reIfLine = '^\s*if.?def\s+(\w+)'; # $1 = 変数名
my $reRuleLine = '^(\w+)\s*:'; # $1 = ターゲット名

my @doc = ();
my $doc_comment = '';
my $state = $NEUTRAL;
while (<$in>) {
    if ($state == $NEUTRAL) {
	if (/$reCommentLine/) {
	    $doc_comment = $1;
	    $state = $DOC_COMMENT;
	}
    } elsif ($state == $DOC_COMMENT) {
	if (/$reVarDefLine/ || /$reIfLine/) {
	    push(@doc, ['var', $1, $doc_comment]);
	    $doc_comment = '';
	    $state = $NEUTRAL;
	} elsif (/$reCommentLine/) {
	    push(@doc, ['title', '', $doc_comment]);
	    $doc_comment = $1;
	    $state = $DOC_COMMENT;
	} elsif (/$reRuleLine/) {
	    push(@doc, ['target', $1, $doc_comment]);
	    $doc_comment = '';
	    $state = $NEUTRAL;
	} else {
	    push(@doc, ['title', '', $doc_comment]);
	    $doc_comment = '';
	    $state = $NEUTRAL;
	}
    } else {
	die "Panic!";
    }
}

&Out(\@doc, $style);

sub Out($$) {
    my @doc = @{$_[0]};
    my $style = $_[1];

    print $Styles{$style}->{begin};
    my $prev = 'none';
    my $cur;
    foreach (@doc) {
	$cur = $_->[0];
	$Styles{$style}->{out}->($prev, $cur, $_);
	$prev = $cur;
    }
    $Styles{$style}->{out}->($prev, 'none', undef);
    print $Styles{$style}->{end};
}