mkilmodtable

#!/usr/bin/perl
#
# generate table of modules for an interpreted language
#

use DBI;
use Getopt::Long;
use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST);

local %references;
local %standards;

sub usage() {
    print STDERR "mkilmodtable -v <lsbversion> [-b] -l <language>\n";
    die;
}

# Uncomment to trace SQL statments
#$trace=1;

sub makeid($) {
    my ($name) = @_;
    $name =~ s/\s+/./g;
    $name =~ s/[^A-Za-z0-9.]+/./g;

    # finally, remove any repeated '.' (might be result of other cleanup)
    $name =~ s/\.\.+/./g;
    return $name;
}

GetOptions(
    "l=s" => \$language,
    "v=s" => \$lsbversion
);
if ( !$language ) { usage(); }
if ( !$lsbversion ) { usage(); }

$dbh = DBI->connect( "DBI:mysql:$LSBDB:$LSBDBHOST", $LSBUSER, $LSBDBPASSWD );
die unless $dbh;

$sth = $dbh->prepare("SHOW TABLES");
$sth->execute;

my $status, $title, $tbl, $MainTitle;
$status    = 'Included';
$title     = $language.' modules';
$tbl       = "tbl-$language-mods";
$footnote  = "ftn-$language-mods";
$MainTitle = "$language Modules";

printf("<!-- Start of generated text - do not edit! -->\n");
printf("<!-- generated from the LSB specification database by mkilmodtable -->\n");

$select  = "SELECT * FROM InterpretedLanguageModule ";
$select .= "LEFT JOIN InterpretedLanguage ON ILMlanguage=ILid ";
$select .= "LEFT JOIN Standard ON Sid=ILstandard ";
$select .= "WHERE ILname = '$language' ";
$select .= "AND ILappearedin <= '$lsbversion' AND ILappearedin <>'' ";
$select .= "AND (ILwithdrawnin IS NULL OR ILwithdrawnin > '$lsbversion') ";
$select .= "AND ILMappearedin <= '$lsbversion' AND ILMappearedin <>'' ";
$select .= "AND (ILMwithdrawnin IS NULL OR ILMwithdrawnin > '$lsbversion') ";
$select .= "AND Sappearedin <= '$lsbversion' AND Sappearedin <>'' ";
$select .= "AND (Swithdrawnin IS NULL OR Swithdrawnin > '$lsbversion') ";
$select .= "ORDER BY ILMname";
print STDERR $select, "\n" if $trace;

$sth = $dbh->prepare($select);
$sth->execute;

printf("<para>\n");
printf("An LSB conforming implementation shall provide the\n");
printf("%s as described in <xref linkend=\"%s\">\n", $title, $tbl );
printf("with at least the behavior described as mandatory\n");
printf("in the referenced underlying specification.\n");
printf("Some %s may be marked as deprecated, and applications\n", $title);
printf("should avoid using these as they may be withdrawn\n");
printf("in future releases of this specification.\n");

printf("</para>\n");

if ( $sth->rows < 1 ) {
    printf("<para>No $language modules found!</para>\n");
} else {

    printf("<table id=\"$tbl\">\n");
    printf("<title>$MainTitle</title>\n");
    printf("<tgroup cols=5>\n");
    printf("<tbody>\n");
    printf("<row>\n");

    my $col       = 0;                               #column count
    my $row       = 0;
    my $hasDeprecated = 0;
    my $totalrows = int( ( $sth->rows + 4 ) / 5 );

    my $mods = $sth->fetchall_arrayref( {} );

    while ( $row < $totalrows ) {
	#
	# fixed width table ... 5 columns
	#
	if ( $col == 5 ) {
	    last if ( ++$row >= $totalrows );
	    printf("</row><row>\n");
	    $col = 0;
	}
	my $idx = ( $row + ( $col++ * $totalrows ) );
	$field = $mods->[ ($idx) ];
	#
	# Shouldn't need this, but we've seen this script
	# go into an infinite loop before, so this is a safeguard.
	#
	die "OVERFLOW!!! $idx > " . $totalrows * 5
	  unless ( $idx <= $totalrows * 5 );

	$ref = $permutation{ $field->{'ILMstandard'} };
	#$ftid = sprintf("std-fn-%s-%s",
	#	$field[1], $permutation{$field[1]});

	printf( "<entry>%s\n", $field->{'ILMname'} );
	#
	# figure out a reference
	# each table is followed by a list of references
	#
	# this is a little complex:
	# %references is a hash, using keys of the form "std-%d-%d"
	#   with values being the names of the standards
	# @ref is an array; each element is a key in %ref
	# $refno is the current index into that array
	#
	if ( $field->{'Sid'} ) {
	    my $refstr = sprintf "std-mod-%d", $field->{'Sid'};
	    $references{$refstr} = $field->{'Stag'};
	    $refno = 0;
	    for $r ( 0 .. $#ref ) {
		$refno = $r;
		last if ( $ref[$r] eq $refstr );
	    }
	    if ( $ref[$refno] ne $refstr ) {
		push( @ref, $refstr );
		$refno = $#ref;
	    }
	    printf( "<link linkend=\"%s\"> [%d]</link>\n",
		$refstr, $refno + 1 );
	}
	#
	# handle deprecated modules - adds a footnote for first one,
	# footnoteref for subsequent ones
	#
	if ( $field->{'ILMdeprecatedsince'} ) {
	    if ( $field->{'ILMdeprecatedsince'} <= $lsbversion ) {
	        if ( $hasDeprecated == 0 ) {
		    printf("<footnote id=%s><para>Deprecated module</para></footnote>\n", $footnote);

		    $hasDeprecated = 1;
		} else {
		    printf("<footnoteref linkend=%s>\n", $footnote);
		}
	    }
	}
	printf("</entry>\n");
    }

    printf("</row>\n");
    printf("</tbody>\n");
    printf("</tgroup>\n");
    printf("</table>\n");

    #
    # now print out the referenced standards list
    #
    if ( $#ref >= 0 ) {
	print
	  "<para><emphasis>Referenced Specification(s)</emphasis></para>\n";
	for $r ( 0 .. $#ref ) {
	    $refstr = $ref[$r];
	    printf
"<formalpara><title id=\"%s\">[%d]</title><para><xref linkend=\"std.%s\"></para></formalpara>\n",
	      $refstr, $r + 1, $references{$refstr};
	}
    }
}
$sth->finish;

printf("<!-- End of text generated from database -->\n");

$sth = $dbh->prepare("SHOW TABLES");
$sth->execute;
$sth->finish;
$dbh->disconnect;
exit;