mksynop

#! /usr/bin/perl -I../build_env

#
# mksynop
#   - write out the XML/SGML synopsis for function/interface X
#     from info in the db.
#

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

my $level = 0;
my $dbh;
my $lsbversion;
my $arch;
my $Aid;

#
#
sub indent($) {

    # function abandoned
}

#
# return <tag>content<tag>
# suitably indented.
#
sub tag($$$) {
    my ( $tagname, $content, $multiline ) = @_;
    my $retstr = "";

    $level += 2;
    $retstr .= indent($level);
    if ($multiline) {
        $retstr .= sprintf( "<%s>\n", $tagname );
        $level += 2;
        $retstr .= indent($level);
        $retstr .= sprintf( "%s\n", $content );
        $level -= 2;
        $retstr .= sprintf( "</%s>", $tagname );
    }
    else {
        $retstr .= sprintf( "<%s>%s</%s>\n", $tagname, $content, $tagname );
    }
    $level -= 2;
    return $retstr;
}

sub function($) {
    my ($name) = @_;
    return tag( "function", $name, 0 );
}

sub funcdef($$) {
    my ( $type, $name ) = @_;
    return tag( "funcdef",
        sprintf( "%s\n%s%s", $type, indent( $level + 2 ), function($name) ),
        0 );
}

sub paramdef($$) {
    my ( $type, $name ) = @_;
    return "<void>" if ( !defined($type) || $type eq "" || $type eq "void" );
    return "<varargs>" if ( $type eq "..." );
    return tag( "paramdef",
        sprintf( "%s\n%s%s", $type, indent( $level + 2 ), parameter($name) ),
        0 );
}

sub parameter($) {
    my ($name) = @_;
    tag( "parameter", $name, 0 );
}

sub refsynopsisdiv($) {
    my ($content) = @_;
    tag( "refsynopsisdiv", $content, 1 );
}

sub funcsynopsisinfo($) {
    my ($hdr) = @_;
    return tag( "funcsynopsisinfo", $hdr, 1 );
}

sub funcsynopsis($$$) {
    my ( $hdrinfo, $funcdef, $args ) = @_;

    my $argstr = "";
    for my $arg (@$args) {
        $level += 2;
        $argstr .= paramdef( $arg->{'type'}, $arg->{name} );
        $level -= 2;
    }
    tag( "funcsynopsis",
        sprintf( "%s%s%s", $hdrinfo, funcprototype( $funcdef . $argstr ) ), 1 );
}

sub funcprototype($) {
    my ($hdr) = @_;
    return tag( "funcprototype", $hdr, 1 );
}

sub trim($) {
    my ($str) = @_;

    $str =~ s/^ *(.*)$/\1/;
    $str =~ s/(.*) +$/\1/;
    return $str;
}

sub usage() {
    die "Usage: mksynop -v <lsbversion> -a <archname> [<interface_name> ...]\n";
}

GetOptions( "v=s" => \$lsbversion, "a=s" => \$arch );

if ( !$lsbversion ) { usage(); }

my @args;
die "Invalid database" if ( !defined($LSBDB) || $LSBDB eq "" );
$dbh = DBI->connect( 'DBI:mysql:database=' . $LSBDB . ';host=' . $LSBDBHOST,
    $LSBUSER, $LSBDBPASSWD )
  or die "Couldn't connect to database: " . DBI->errstr;
$specdb::dbh = $dbh;
specdb::prepareQueries();

if ( !$arch ) {
    print STDERR
"Generating generic information. Note that synopsis can vary on different architectures.\n";
    $Aid = 1;
}
else {
    my $select = "SELECT Aid FROM Architecture WHERE Aname='$arch'";
    my $th     = $dbh->prepare($select)
      or die "Couldn't prepare $select query: " . DBI->errstr;
    $th->execute or die "Couldn't execute $select query: " . DBI->errstr;
    my $entry = $th->fetchrow_hashref;
    $th->finish;
    if ( $entry->{'Aid'} ) {
        $Aid = $entry->{'Aid'};
    }
    else {
        die "Illegal architecture\n";
    }
}
$specdb::ArchId = $Aid;

#
# we need four things from the db for the interface in $ARGV[0]
# - the name (well, we've got that anyway)
# - the header file with the prototype
# - the type (as a string)
# - an array of its parameters (in the right order!), [basically, we
#         can only get their type at this time, so make up names for these]
#
for my $func (@ARGV) {
    my $sql = "select * from Interface ";
    $sql .= "left join ArchInt on Iid=AIint ";
    $sql .= "left join Type on Tid=AIreturn ";
    $sql .= "left join Header on Hid=Iheader ";
    $sql .= "where ";
    $sql .= "Iname='$func' and ";
    $sql .= "Itype='Function' AND ";
    $sql .= "(Isrcbin ='SrcOnly' ";
    $sql .= "OR ( AIappearedin <= '$lsbversion' AND AIappearedin > '' ";
    $sql .= "AND (AIwithdrawnin IS NULL OR AIwithdrawnin >'$lsbversion') ) ) ";

    my $sth = $dbh->prepare($sql)
      or die "Couldn't prepare $sql query: " . DBI->errstr;
    $sth->execute or die "Couldn't execute $sql query: " . DBI->errstr;
    if ( $sth->rows() > 0 ) {
        my $entry = $sth->fetchrow_hashref;
        $sth->finish;
        $specdb::TMaid = $Aid;

        my $nameonly = 0;
        if( $entry->{'Ttype'} eq 'FuncPtr' ) {
            $specdb::funcPtrName = $entry->{'Iname'};
            $nameonly = 1;
        }
        my $type = specdb::displaytyperef($entry, $nameonly);

        my $hdr = sprintf( "#include &lt;%s&gt;", $entry->{'Hname'} );

        #
        # and now the args ...
        #
        my $pos = 0;
        my $Iid = $entry->{'Iid'};
        $sql = "select * from Parameter,Type ";
        $sql .= "left join ArchType on ATtid=Tid ";
        $sql .= "where Pint=$Iid and Ptype=Tid AND ATaid IN (1,$Aid) ";
        $sql .= "group by Ppos,ATtid order by Ppos";
        # Note that arch specific basetype will not be handled here correctly
        $sth = $dbh->prepare($sql)
          or die "Couldn't prepare $sql query: " . DBI->errstr;
        $sth->execute or die "Couldn't execute $sql query: " . DBI->errstr;
        my $argno = 0;

        if ( $sth->rows == 0 ) {

            # a void ...
            push(
                @args,
                {
                    'type' => undef,
                    'name' => "irrelevant",
                }
            );
        }
        while ( ( $entry = $sth->fetchrow_hashref ) ) {
            my $argname = $entry->{'Pname'} ? $entry->{'Pname'} : sprintf( "arg%d", $argno++ );
            my $argtype = specdb::displaytyperef($entry,0);

            push(
                @args,
                {
                    'type' => $argtype,
                    'name' => $argname,
                }
            );
        }
        printf "%s\n",
          refsynopsisdiv(
            funcsynopsis(
                funcsynopsisinfo($hdr), funcdef( $type, $func ), \@args
            )
          );
    }
    else {
        printf "%s: no such interface\n", $func;
    }
    $sth->finish;
}
$dbh->disconnect;