mkcmdlist0000775000076400007640000000417711027740045011510 0ustar matsmats#!/usr/bin/perl use Getopt::Long; use DBI; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); sub usage() { print STDERR "mkcmdlist -v [-m ]\n Default moduleid is 1 (i.e LSB Core)\n"; die; } # Uncomment to trace SQL statments #$trace=1; # # 1) process the arguments # # We can get module id from Module Table. Commands list will be generated as per modules. GetOptions("m=i" => \$moduleid, "v=s" => \$lsbversion); if( !$moduleid ) { $moduleid=1; } if( !$lsbversion ) { usage(); } # # 2) Establish connection to the database # my $dbh = DBI->connect('DBI:mysql:database='.$LSBDB.';host='.$LSBDBHOST, $LSBUSER, $LSBDBPASSWD) or die "Couldn't connect to database: ".DBI->errstr; printf("\n"); printf("\n"); print "\n"; print "Command Behavior\n"; print "\n"; print "This section contains descriptions for commands and utilities whose\n"; print "specified behavior in the LSB contradicts or extends the standards\n"; print "referenced. It also contains commands and utilities only required by\n"; print "the LSB and not specified by other standards.\n"; print "\n"; # # 3) get & print the library info # $select = "SELECT * FROM Command "; $select.= "Left JOIN ModCmd ON MCcid=Cid "; $select.= "LEFT JOIN Standard ON Sid=Cstandard "; $select.= "WHERE MCmid=$moduleid AND MCappearedin <= '$lsbversion' AND MCappearedin <>'' "; $select.= "AND (MCwithdrawnin IS NULL OR MCwithdrawnin > '$lsbversion') "; $select.= "AND Cbuiltin != 'Yes' "; $select.= "AND Sname='LSB' " ; $select.= "ORDER BY Cname"; print STDERR $select,"\n" if $trace; $cth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $cth->execute or die "Couldn't execute $select query: ".DBI->errstr; for(1..$cth->rows) { $entry = $cth->fetchrow_hashref() or die "Fetchrow failed on $select query: ".DBI->errstr; print "m4_include(".$entry->{'Cname'}.".sgml)\n"; } $cth->finish; $dbh->disconnect; print "\n"; printf("\n"); mkcmdtable0000775000076400007640000002074611027740677011637 0ustar matsmats#!/usr/bin/perl # # Linux Standard Base, http://www.linuxbase.org/ # George Kraft IV, gk4@us.ibm.com, 03/09/2000 # Nick Stoughton, nick@usenix.org, 2004 - 2005 # # use DBI; use Getopt::Long; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); local %references; local %standards; my $builtins = 0; sub usage() { print STDERR "mkcmdtable -v [-b] [-m ]\n Default moduleid is 1 (i.e LSB Core).\n"; die; } ################################################################################ # lsbOpenDB ################################################################################ sub lsbOpenDB { $dbh = DBI->connect("DBI:mysql:$LSBDB:$LSBDBHOST", $LSBUSER, $LSBDBPASSWD); die unless $dbh; $sth = $dbh->prepare( "SHOW TABLES" ); $sth->execute; } ################################################################################ # lsbCloseDB ################################################################################ sub lsbCloseDB { $sth = $dbh->prepare( "SHOW TABLES" ); $sth->execute; $sth->finish; $dbh->disconnect; } ################################################################################ # builtinexcepts ################################################################################ sub builtinexcepts { print << "END_BIEXCEPT_TEXT"; The built in commands and utilities shall be provided by the sh utility itself, and need not be implemented in a manner so that they can be accessed via the exec family of functions as defined in and should not be invoked directly by those standard utilities that execute other utilities ( env find nice nohup time xargs ). Rationale (Informative) Since the built in utilities must affect the environment of the calling process, they have no effect when executed as a file. END_BIEXCEPT_TEXT } ################################################################################ # cmdexcepts ################################################################################ sub cmdexcepts { print << "END_EXCEPT_TEXT"; If any operand (except one which follows ) starts with a hyphen, the behavior is unspecified. Rationale (Informative) Applications should place options before operands, or use , as needed. This text is needed because, by default, GNU option parsing differs from POSIX, unless the environment variable posixly_correct is set. For example, ls . -a in GNU ls means to list the current directory, showing all files (that is, is an operand and is an option). In POSIX, and are both operands, and the command means to list the current directory, and also the file named -a. Suggesting that applications rely on the setting of the POSIXLY_CORRECT environment variable, or try to set it, seems worse than just asking the applications to invoke commands in ways which work with either the POSIX or GNU behaviors. END_EXCEPT_TEXT } ################################################################################ # lsbCommands ################################################################################ sub lsbCommands { my $status, $title, $tbl, $MainTitle, $builtinCheck; if ($builtins) { $status = 'Included'; $builtinCheck = 'Command.Cbuiltin = \'Yes\''; $title = 'shell built in utilities'; $tbl = "tbl-builtins"; $MainTitle = "Built In Utilities"; } else { $status = 'Included'; $builtinCheck = 'Command.Cbuiltin <> \'Yes\''; # let's include 'Unknown' builtins here $title = 'commands and utilities'; $tbl = "tbl-cmds"; $MainTitle = "Commands And Utilities"; } $sth = $dbh->prepare("SELECT DISTINCT Sfull, Sid, Sname FROM Standard,Command LEFT JOIN ModCmd ON Command.cid=ModCmd.MCcid WHERE ModCmd.MCmid=$moduleid AND Standard.Sid=Command.Cstandard AND (MCappearedin<>'' AND MCappearedin<='$lsbversion' AND (MCwithdrawnin IS NULL OR MCwithdrawnin>'$lsbversion') ) AND $builtinCheck ORDER BY Sname"); $sth->execute; if ($sth->rows > 0) { $sth->finish; printf("\n"); printf("\n"); printf("An LSB conforming implementation shall provide the\n"); printf("%s as described in , with at least the behavior\n", $title, $tbl); printf("described as mandatory in the referenced underlying\n"); printf("specification, with the following exceptions:\n"); $builtins ? builtinexcepts : cmdexcepts; printf("\n"); $sth = $dbh->prepare("SELECT Cname, Cstandard, Sfull, Sid, Sname FROM Command LEFT JOIN ModCmd ON Command.cid=ModCmd.MCcid LEFT JOIN Standard ON Command.Cstandard=Standard.Sid WHERE (MCappearedin<>'' AND MCappearedin<='$lsbversion' AND (MCwithdrawnin IS NULL OR MCwithdrawnin>'$lsbversion') ) AND $builtinCheck AND ModCmd.MCmid=$moduleid ORDER BY Command.Cname"); $sth->execute; if ($sth->rows < 1) { printf("No Commands or Utilities found!\n"); return; } printf("\n"); printf("$MainTitle\n"); printf("\n"); printf("\n"); printf("\n"); my $col = 0; #column count my $row = 0; my $totalrows = int(($sth->rows+4) / 5); my $cmds = $sth->fetchall_arrayref({}); while ($row < $totalrows) { # # fixed width table ... 5 columns # if ($col == 5) { last if(++$row >= $totalrows); printf("\n"); $col = 0; } my $idx = ($row + ($col++ * $totalrows)); $field = $cmds->[($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->{'Cstandard'}}; #$ftid = sprintf("std-fn-%s-%s", # $field[1], $permutation{$field[1]}); printf("%s\n", $field->{'Cname'}); # 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-cmd%s-%d", $builtins ? "bi":"" ,$field->{'Sid'}; $references{$refstr} = $field->{'Sname'}; $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(" [%d]\n", $refstr, $refno+1 ); } printf("\n"); } printf("\n"); printf("\n"); printf("\n"); printf("
\n"); # # now print out the referenced standards list # if ($#ref >= 0) { print "Referenced Specification(s)\n"; for $r (0..$#ref) { $refstr = $ref[$r]; $references{$refstr} = "This specification" if ($references{$refstr} eq "Linux Standard Base"); printf "[%d]\n", $refstr, $r+1, makeid($references{$refstr}); } } } printf("\n"); } ################################################################################ # makeid ################################################################################ sub makeid($) { my ($name) = @_; $name =~ s/\s+/./g; $name =~ s/[^A-Za-z0-9.]+/./g; # finally, remove any repeated . (e.g. "RPC...XDR" which arose from "RPC & XDR") $name =~ s/\.\.+/./g; return $name; } ################################################################################ # main ################################################################################ # We can get module id from Module Table. Commands list will be generated as per modules. GetOptions("b" => \$builtins, "m=i" => \$moduleid, "v=s" => \$lsbversion); if(!$moduleid) { $moduleid=1; } if(!$lsbversion) { usage(); } lsbOpenDB; lsbCommands; lsbCloseDB; exit; # EOF mkdyntagtable0000775000076400007640000000473611027740764012360 0ustar matsmats#!/usr/bin/perl use Getopt::Long; use DBI; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); sub usage() { print STDERR "mkdyntagtable -a -s -v lsbversion [-c ] [-d]\n"; die; } # Uncomment to trace SQL statments #$trace=1; # # 1) process the arguments # $numcols=1; $dodesc=0; GetOptions("a=s" => \$archname, "s=s" => \$stdname, "c=i" => \$numcols, "v=s" => \$lsbversion, "d" => \$dodesc); if( !$archname ) { usage(); } if( !$stdname ) { usage(); } if( !$lsbversion ) { usage(); } # # 2) Establish connection to the database # my $dbh = DBI->connect('DBI:mysql:database='.$LSBDB.';host='.$LSBDBHOST, $LSBUSER, $LSBDBPASSWD) or die "Couldn't connect to database: ".DBI->errstr; # # 3) get & print the architecture info # $select = "SELECT * FROM Architecture WHERE "; $select.= "Architecture.Aname=".$dbh->quote($archname); print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $entry=$sth->fetchrow_hashref or die "Fetchrow failed on $select query: ".DBI->errstr; $Aid=$entry->{'Aid'}; $Aname=$entry->{'Aname'}; $sth->finish; if( not $Aname ) { die "Unsupported architecture"; } $select = "SELECT DEname,ADEdescription "; $select.= "FROM DynamicEntries "; $select.= "LEFT JOIN ArchDE ON ADEdeid=DEid "; $select.= "LEFT JOIN Standard ON ADEstd=Sid "; $select.= "WHERE Sname=".$dbh->quote($stdname)." "; $select.= "AND ADEaid=$Aid "; $select.= "AND (ADEappearedin <= '$lsbversion' and ADEappearedin<>'') "; $select.= "AND (ADEwithdrawnin IS NULL OR ADEwithdrawnin > '$lsbversion')"; $select.= " ORDER BY DynamicEntries.DEname "; print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; printf("\n"); printf("\n"); if($sth->rows) { print "\n"; for(1..$sth->rows) { print "\n"; $entry=$sth->fetchrow_hashref or die "Fetchrow failed on $select query: ".DBI->errstr; printf "%s\n",$entry->{'DEname'}; printf "%s\n",$entry->{'ADEdescription'}; print "\n"; } print "\n"; } printf("\n"); $sth->finish; $dbh->disconnect; mkilmodlist0000775000076400007640000000537511027741036012053 0ustar matsmats#!/usr/bin/perl # # generate list of modules for an interpreted language # which have to be defined in LSB. That is, they're either # unique to LSB or extend the referenced standard # use DBI; use Getopt::Long; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); sub usage() { print STDERR "mkilmodlist -v -l ]\n"; die; } # Uncomment to trace SQL statments #$trace=1; # # 1) process the arguments # GetOptions( "l=s" => \$language, "v=s" => \$lsbversion ); if ( !$language ) { usage(); } if ( !$lsbversion ) { usage(); } # # 2) Establish connection to the database # my $dbh = DBI->connect( 'DBI:mysql:database=' . $LSBDB . ';host=' . $LSBDBHOST, $LSBUSER, $LSBDBPASSWD ) or die "Couldn't connect to database: " . DBI->errstr; # # 3) sanity check that the language name is valid # $select = "SELECT ILid FROM InterpretedLanguage WHERE ILname=\"$language\""; print STDERR $select, "\n" if $trace; $cth = $dbh->prepare($select) or die "Couldn't prepare $select query: " . DBI->errstr; $cth->execute or die "Couldn't execute $select query: " . DBI->errstr; if ($cth->rows == 0) { print "Unknown language\n"; die; } printf("\n"); printf("\n"); print "\n"; print "Module Behavior\n"; print "\n"; print "This section contains descriptions $language modules whose\n"; print "specified behavior in the LSB contradicts or extends the standards\n"; print "referenced. It also contains modules only required by the LSB\n"; print "and not specified by other standards.\n"; print "\n"; # # 4) get & print the module info # $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 Sname='LSB' "; $select .= "ORDER BY ILMname"; print STDERR $select, "\n" if $trace; $cth = $dbh->prepare($select) or die "Couldn't prepare $select query: " . DBI->errstr; $cth->execute or die "Couldn't execute $select query: " . DBI->errstr; for ( 1 .. $cth->rows ) { $entry = $cth->fetchrow_hashref() or die "Fetchrow failed on $select query: " . DBI->errstr; print "m4_include(" . $entry->{'ILMname'} . ".sgml)\n"; } $cth->finish; $dbh->disconnect; print "\n"; printf("\n"); mkilmodtable0000775000076400007640000001106411027743052012157 0ustar matsmats#!/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 [-b] -l \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"; $MainTitle = "$language Modules"; $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 .= "ORDER BY ILMname"; print STDERR $select, "\n" if $trace; $sth = $dbh->prepare($select); $sth->execute; printf("\n"); printf("\n"); printf("\n"); printf("An LSB conforming implementation shall provide the\n"); printf("%s as described in \n", $title, $tbl ); printf("with at least the behavior described as mandatory\n"); printf("in the referenced underlying specification\n"); printf("\n"); if ( $sth->rows < 1 ) { printf("No $language modules found!\n"); } else { printf("\n"); printf("$MainTitle\n"); printf("\n"); printf("\n"); printf("\n"); my $col = 0; #column count my $row = 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("\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( "%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->{'Sname'}; $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( " [%d]\n", $refstr, $refno + 1 ); } printf("\n"); } printf("\n"); printf("\n"); printf("\n"); printf("
\n"); # # now print out the referenced standards list # if ( $#ref >= 0 ) { print "Referenced Specification(s)\n"; for $r ( 0 .. $#ref ) { $refstr = $ref[$r]; $references{$refstr} = "This specification" if ( $references{$refstr} eq "Linux Standard Base" ); printf "[%d]\n", $refstr, $r + 1, makeid( $references{$refstr} ); } } } $sth->finish; printf("\n"); $sth = $dbh->prepare("SHOW TABLES"); $sth->execute; $sth->finish; $dbh->disconnect; exit; mkinterfacesgmltable0000775000076400007640000000250511027743114013675 0ustar matsmats#!/usr/bin/perl use CGI; use Carp; use Mysql; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); $query = new CGI(%ARGV); $Dbh = Mysql->connect($LSBDBHOST,$LSBDB,$LSBUSER, $LSBDBPASSWD) || die $Mysql::db_errstr; $select ="SELECT DISTINCT Interface.Iname "; $select .="FROM Standard,Interface,LibInt,Library "; if ( $query->param('Sname') ) { push(@where,"Standard.Sname=".$Dbh->quote($query->param('Sname'))); push(@where,"Interface.Istandard=Standard.Sid"); } if ( $query->param('Lname') ) { push(@where,"Library.Lname=".$Dbh->quote($query->param('Lname'))); push(@where,"LibInt.LIlib=Library.Lid"); push(@where,"LibInt.LIint=Interface.Iid"); } else { push(@where,"Interface.Iname NOT LIKE '\\_\\_%'"); } if( scalar(@where) > 0 ) { $select .= " WHERE ".join(" AND ",@where); } $select .=" ORDER BY Interface.Iname "; #printf $select,"\n"; $sth = $Dbh->query($select) || die $select."\n".$Dbh->errmsg(); for(1..$sth->numrows) { %entry=$sth->fetchhash; $entry[$_]=$entry{'Iname'}; } print "\n"; $inc=($sth->numrows+4)/5; for(1..$inc) { print ""; printf "%s",$entry[$_]; printf "%s",$entry[$_+$inc]; printf "%s",$entry[$_+(2*$inc)]; printf "%s",$entry[$_+(3*$inc)]; printf "%s",$entry[$_+(4*$inc)]; print "\n"; } print "\n"; mkinterfacetable0000775000076400007640000000300211027743131013002 0ustar matsmats#!/usr/bin/perl use CGI; use Carp; use Mysql; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); $query = new CGI(%ARGV); $Dbh = Mysql->connect($LSBDBHOST,$LSBDB,$LSBUSER, $LSBDBPASSWD) || die $Mysql::db_errstr; $select ="SELECT DISTINCT Interface.Iname "; $select .="FROM Standard,Interface,LibInt,Library "; if ( $query->param('Sname') ) { push(@where,"Standard.Sname=".$Dbh->quote($query->param('Sname'))); push(@where,"Interface.Istandard=Standard.Sid"); } if ( $query->param('nSname') ) { push(@where,"Standard.Sname=".$Dbh->quote($query->param('nSname'))); push(@where,"Interface.Istandard!=Standard.Sid"); } if ( $query->param('Lname') ) { push(@where,"Library.Lname=".$Dbh->quote($query->param('Lname'))); push(@where,"LibInt.LIlib=Library.Lid"); push(@where,"LibInt.LIint=Interface.Iid"); } push(@where,"Interface.Iname NOT LIKE '\\_\\_%'"); if( scalar(@where) > 0 ) { $select .= " WHERE ".join(" AND ",@where); } $select .=" ORDER BY Interface.Iname "; #printf $select,"\n"; $sth = $Dbh->query($select) || die $select."\n".$Dbh->errmsg(); for(1..$sth->numrows) { %entry=$sth->fetchhash; $entry[$_]=$entry{'Iname'}; } print "\n"; print "\n"; print "\n"; $inc=($sth->numrows+4)/5; for(1..$inc) { print ""; printf "",$entry[$_]; printf "",$entry[$_+$inc]; printf "",$entry[$_+(2*$inc)]; printf "",$entry[$_+(3*$inc)]; printf "",$entry[$_+(4*$inc)]; print "\n"; } print "
%s%s%s%s%s
\n"; print "\n"; print "\n"; mkintlist0000775000076400007640000001045511030214553011525 0ustar matsmats#!/usr/bin/perl use Getopt::Long; use DBI; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); sub usage() { print STDERR "mkintlist -a -v \n"; die; } # Uncomment to trace SQL statments #$trace=1; # # 1) process the arguments # GetOptions("a=s" => \$archname, "v=s" => \$lsbversion); if( !$archname ) { usage(); } if( !$lsbversion ) { usage(); } # # 2) Establish connection to the database # $dbh = DBI->connect('DBI:mysql:database='.$LSBDB.';host='.$LSBDBHOST, $LSBUSER, $LSBDBPASSWD) or die "Couldn't connect to database: ".DBI->errstr; # # 3) get & print the architecture info # $select = "SELECT * FROM Architecture WHERE "; $select.= "Architecture.Aname=".$dbh->quote($archname); print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $entry=$sth->fetchrow_hashref; $Aid=$entry->{'Aid'}; $Aname=$entry->{'Aname'}; $sth->finish; #print "\n"; #print "Alphabetical Listing of Interfaces\n"; #print "\n"; #print "\n"; # # 4) get & print the library info # $select = "SELECT * FROM Library LEFT JOIN ArchLib ON ALlid=Lid WHERE "; $select.= "(ALappearedin <= '$lsbversion' AND ALappearedin >'' "; $select.= "AND (ALwithdrawnin IS NULL OR ALwithdrawnin > '$lsbversion') ) "; $select.= "AND ALaid=$Aid "; print STDERR $select,"\n" if $trace; $lth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $lth->execute or die "Couldn't execute $select query: ".DBI->errstr; for(1..$lth->rows) { $entry=$lth->fetchrow_hashref; $Lid=$entry->{'Lid'}; $Lname=$entry->{'Lname'}; $select = "SELECT Iname,AIdeprecatedsince,Vname "; $select.= "FROM Interface "; $select.= "LEFT JOIN LGInt ON LGIint=Iid "; $select.= "LEFT JOIN LibGroup ON LGIlibg=LGid "; $select.= "LEFT JOIN ArchInt ON Iid=AIint "; $select.= "LEFT JOIN Version ON Vid=AIversion "; $select.= "WHERE LGlib=$Lid AND Itype='Function' "; $select.= "AND AIarch=$Aid "; $select.= "AND (AIappearedin <= '$lsbversion' and AIappearedin > '') "; $select.= "AND (AIwithdrawnin IS NULL OR AIwithdrawnin >'$lsbversion') "; # Include only arch specific interfaces if( $Aid!=1 ) { $select.= "AND Iid NOT IN "; $select.= "(SELECT AIint FROM ArchInt "; $select.= " WHERE AIarch=1 "; $select.= "AND (AIappearedin <= '$lsbversion' and AIappearedin > '') "; $select.= "AND (AIwithdrawnin IS NULL OR AIwithdrawnin >'$lsbversion') )"; } $select.= "ORDER BY Iname"; $inh = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $inh->execute or die "Couldn't execute $select query: ".DBI->errstr; if( $inh->rows == 0) { $inh->finish; next; } print "$Lname Function Interfaces\n"; # # 7) Get a list of the interfaces in the library # { local(*std); local(*symver); local(*entry); print STDERR $select,"\n" if $trace; for(1..$inh->rows) { $entry=$inh->fetchrow_hashref; print $entry->{'Iname'}."(".$entry->{'Vname'}.")"; if( $entry->{'AIdeprecatedsince'} and $entry->{'AIdeprecatedsince'} le $lsbversion ) { print " *Deprecated*"; } print "\n"; } } $inh->finish; # # 8) Make a table of data interfaces # { local(*datasym); local(*std); $select = "SELECT * FROM Interface "; $select.= "LEFT JOIN LGInt ON Iid=LGIint "; $select.= "LEFT JOIN LibGroup ON LGIlibg=LGid "; $select.= "LEFT JOIN ArchInt ON Iid=AIint "; $select.= "WHERE Itype='Data' AND LGlib=$Lid AND AIarch=$Aid "; $select.= "AND (AIappearedin <= '$lsbversion' and AIappearedin<>'') "; $select.= "AND (AIwithdrawnin IS NULL OR AIwithdrawnin >'$lsbversion') "; if( $Aid!=1 ) { $select.= "AND Iid NOT IN "; $select.= "(SELECT AIint FROM ArchInt "; $select.= " WHERE AIarch=1 "; $select.= "AND (AIappearedin <= '$lsbversion' and AIappearedin<>'') "; $select.= "AND (AIwithdrawnin IS NULL OR AIwithdrawnin >'$lsbversion') ) "; } $select.= "ORDER BY Iname"; print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; if ($sth->rows > 0 ) { print "$Lname Data Interfaces\n"; for(1..$sth->rows) { $datasym=$sth->fetchrow_hashref; print $datasym->{'Iname'}."(".$datasym->{'Vname'}.")\n"; } } $sth->finish; } } $lth->finish; $dbh->disconnect; mklibapnd0000775000076400007640000002340711027744507011466 0ustar matsmats#!/usr/bin/perl use Getopt::Long; use DBI; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); sub usage() { print STDERR "mklibapdn -a -v [-m module]\n Default module is 1 (i.e LSB Core)\n"; die; } sub makeid($) { my ($name) = @_; $name =~ s/\s+/./g; $name =~ s/[^A-Za-z0-9.]+/./g; # finally, remove any repeated . (e.g. "RPC...XDR" which arose from "RPC & XDR") $name =~ s/\.\.+/./g; return $name; } # Uncomment to trace SQL statments #$trace=1; # # 1) process the arguments # GetOptions("a=s" => \$archname, "v=s" => \$lsbversion, "m=s" => \$module); if( !$module ) { $module='LSB_Core'; } if( !$archname ) { usage(); } if( !$lsbversion ) { usage(); } # # 2) Establish connection to the database # $dbh = DBI->connect('DBI:mysql:database='.$LSBDB.';host='.$LSBDBHOST, $LSBUSER, $LSBDBPASSWD) or die "Couldn't connect to database: ".DBI->errstr; # # 3) get & print the architecture info # $select = "SELECT * FROM Architecture WHERE "; $select.= "Architecture.Aname=".$dbh->quote($archname); print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $entry=$sth->fetchrow_hashref; $Aid=$entry->{'Aid'}; $Aname=$entry->{'Aname'}; $sth->finish; printf("\n"); printf("\n"); print "\n"; print "Alphabetical Listing of Interfaces\n"; print "\n"; print "\n"; # # 4) get & print the library info # $select = "SELECT * FROM Library "; $select.= "LEFT JOIN ArchLib ON ALlid=Lid "; if( $module ) { $select.= "LEFT JOIN ModLib ON MLlid=Lid "; $select.= "LEFT JOIN SubModule ON MLmid=SMid "; } $select.= "WHERE (ALappearedin <= '$lsbversion' AND ALappearedin<>'' "; $select.= "AND (ALwithdrawnin IS NULL OR ALwithdrawnin > '$lsbversion') ) "; if( $module ) { $select.= "AND SMname='".$module."' "; } if( $Aid != 1 ) { $select.= "AND (ALaid=$Aid OR (ALaid=1 AND Lid NOT IN ( "; $select.= "SELECT Lid FROM Library "; $select.= "LEFT JOIN ArchLib ON ALlid=Lid "; $select.= "WHERE (ALappearedin <= '$lsbversion' AND ALappearedin<>'' "; $select.= "AND (ALwithdrawnin IS NULL OR ALwithdrawnin > '$lsbversion') ) "; $select.= "AND ALaid=$Aid ) ) ) "; } else { $select.= "AND ALaid=$Aid "; } $select.= "AND Library.Lname!='libstdcxx' "; $select.= "ORDER BY Lname "; print STDERR $select,"\n" if $trace; $lth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $lth->execute or die "Couldn't execute $select query: ".DBI->errstr; for(1..$lth->rows) { $entry=$lth->fetchrow_hashref; $Lid=$entry->{'Lid'}; $Lname=$entry->{'Lname'}; $select = "SELECT Iname,ISsid,Vname,Sname "; $select.= "FROM Interface "; $select.= "INNER JOIN LGInt ON Iid=LGIint "; $select.= "INNER JOIN LibGroup ON LGIlibg=LGid "; $select.= "LEFT JOIN ArchInt ON Iid=AIint "; $select.= "LEFT JOIN Version ON Vid=AIversion "; $select.= "LEFT JOIN IntStd ON ISiid=Iid "; $select.= "LEFT JOIN Standard ON Sid=ISsid "; $select.= "WHERE Itype='Function' "; $select.= "AND LGlib=$Lid AND AIarch=$Aid "; $select.= "AND (AIappearedin <= '$lsbversion' and AIappearedin<>'') "; $select.= "AND (AIwithdrawnin IS NULL OR AIwithdrawnin >'$lsbversion')"; $select.= "AND (ISappearedin <= '$lsbversion' and ISappearedin<>'') "; $select.= "AND (ISwithdrawnin IS NULL OR ISwithdrawnin >'$lsbversion') "; $select.= "ORDER BY Iname"; $inh = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $inh->execute or die "Couldn't execute $select query: ".DBI->errstr; if( $inh->rows == 0) { $inh->finish; next; } print "\n"; print "", $Lname, "\n"; print "\n"; print "\n"; # # 6) Get a list of the Standards that are used by this library # print "\n"; $select = "SELECT DISTINCT Sname,Sid FROM Standard,LibGroup,LGInt,Interface "; $select.= "LEFT JOIN ArchInt ON Iid=AIint "; $select.= "LEFT JOIN IntStd ON Iid=ISiid "; $select.= "WHERE Sid=ISsid AND Iid=LGIint AND LGIlibg=LGid "; $select.= "AND LGlib=$Lid AND AIarch=$Aid "; $select.= "AND (ISappearedin <= '$lsbversion' and ISappearedin<>'') "; $select.= "AND (ISwithdrawnin IS NULL OR ISwithdrawnin >'$lsbversion') "; $select.= "ORDER BY Sname"; print STDERR $select,"\n" if $trace; $lsh = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $lsh->execute or die "Couldn't execute $select query: ".DBI->errstr; local @refname; if( $lsh->rows) { print "The behavior of the interfaces in this library is specified "; print "by the following Standards."; print "\n"; for(1..$lsh->rows) { local(*entry); $entry=$lsh->fetchrow_hashref; $refname[$_] = $entry->{'Sname'}; print "\n"; printf " [%s]\n", makeid($entry->{'Sname'}), $entry->{'Sname'}; print "\n"; } print "\n"; } $lsh->finish; print "\n"; print "\n"; print "$Lname Function Interfaces\n"; print "\n"; print "\n"; # # 7) Get a list of the interfaces in the library # { local(*std); local(*symver); local(*entry); local(*xrefs); local(*refs); # we did the following query back at step 4, # and the results are still there waiting to be fetched ... #$select = "SELECT Iname,ISsid,Vname,Sname "; #$select.= "FROM Interface,LGInt,LibGroup "; #$select.= "LEFT JOIN Version ON Vid=Iversion "; #$select.= "LEFT JOIN IntStd ON ISiid=Iid "; #$select.= "LEFT JOIN Standard ON Sid=ISsid "; #$select.= "WHERE Iid=LGIint AND LGIlibg=LGid AND Itype='Function' "; #$select.= "AND LGlib=$Lid AND Iarch=$Aid AND Istdstatus='Included' "; #$select.= "AND (ISappearedin <= '$lsbversion' and ISappearedin<>'') "; #$select.= "AND (ISwithdrawnin IS NULL OR ISwithdrawnin >'$lsbversion') "; #$select.= "ORDER BY Iname"; #$inh = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; #$inh->execute or die "Couldn't execute $select query: ".DBI->errstr; print STDERR $select,"\n" if $trace; for(1..$inh->rows) { $entry=$inh->fetchrow_hashref; $entry[$_]=$entry->{'Iname'}; $std[$_]=$entry->{'ISsid'}; $xrefs[$_]=sprintf ("std.%s", makeid($entry->{'Sname'})); $refs[$_]=sprintf "[%s]", $entry->{'Sname'}; $symver[$_]=$entry->{'Vname'}; } # we now have @entry, an array of interface names # @std, an array of Standards (by Sid), # @refs, an array of xref labels to the standards in the normative refs, # and @symver, an array of symbol versions # # # this is a three column table # # inc is the last row number ... $inc=int(($inh->rows+2)/3); for(1..$inc) { print ""; printf "%s", $entry[$_]; if( $symver[$_] ) { printf "(%s)", $symver[$_]; } if( $std[$_] ) { printf "%s", $xrefs[$_], $refs[$_]; } printf ""; printf "%s", $entry[$_+$inc]; if( $symver[$_+$inc] ) { printf "(%s)", $symver[$_+$inc]; } if( $std[$_+$inc] ) { printf "%s", $xrefs[$_+$inc], $refs[$_+$inc]; } printf ""; printf "%s", $entry[$_+(2*$inc)]; if( $symver[$_+(2*$inc)] ) { printf "(%s)", $symver[$_+(2*$inc)]; } if( $std[$_+(2*$inc)] ) { printf "%s", $xrefs[$_+(2*$inc)], $refs[$_+(2*$inc)]; } printf ""; print "\n"; } } $inh->finish; print "\n"; print "\n"; print "
\n"; # # 8) Make a table of data interfaces # { local(*datasym); local(*symver); local(*std); local(*xrefs); local(*refs); $select = "SELECT Iname,ISsid,Vname,Sname "; $select.= "FROM Interface "; $select.= "INNER JOIN LGInt ON Iid=LGIint "; $select.= "INNER JOIN LibGroup ON LGIlibg=LGid "; $select.= "LEFT JOIN ArchInt ON Iid=AIint "; $select.= "LEFT JOIN IntStd ON Iid=ISiid "; $select.= "LEFT JOIN Version ON Vid=AIversion "; $select.= "LEFT JOIN Standard ON Sid=ISsid "; $select.= "WHERE Itype='Data' "; $select.= "AND LGlib=$Lid AND AIarch=$Aid "; $select.= "AND (AIappearedin <= '$lsbversion' and AIappearedin<>'') "; $select.= "AND (AIwithdrawnin IS NULL OR AIwithdrawnin >'$lsbversion') "; $select.= "AND (ISappearedin <= '$lsbversion' and ISappearedin<>'') "; $select.= "AND (ISwithdrawnin IS NULL OR ISwithdrawnin >'$lsbversion') "; $select.= "ORDER BY Iname"; print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; if ($sth->rows > 0 ) { for(1..$sth->rows) { $datasym=$sth->fetchrow_hashref; $datasym[$_]=$datasym->{'Iname'}; $std[$_]=$datasym->{'ISsid'}; $xrefs[$_]=sprintf ("std.%s", makeid($datasym->{'Sname'})); $refs[$_]=sprintf "[%s]", $datasym->{'Sname'}; $symver[$_]=$datasym->{'Vname'}; } print "\n"; print "$Lname Data Interfaces\n"; print "\n"; print "\n"; $inc=($sth->rows+2)/3; for(1..$inc) { print ""; printf "%s",$datasym[$_]; if( $datasym[$_] && $std[$_] ) { printf "%s", $xrefs[$_], $refs[$_]; } printf ""; printf "%s",$datasym[$_+$inc]; if( $datasym[$_+$inc] && $std[$_+$inc] ) { printf "%s", $xrefs[$_+$inc], $refs[$_+$inc]; } printf ""; printf "%s",$datasym[$_+(2*$inc)]; if( $datasym[$_+(2*$inc)] && $std[$_+(2*$inc)] ) { printf "%s", $xrefs[$_+(2*$inc)], $refs[$_+(2*$inc)]; } printf ""; print "\n"; } print "\n"; print "\n"; print "
\n"; } $sth->finish; } print "\n"; } $lth->finish; $dbh->disconnect; print "\n"; printf("\n"); mklibsgmltable0000775000076400007640000000713311027744531012511 0ustar matsmats#!/usr/bin/perl use Getopt::Long; use DBI; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); sub usage() { print STDERR "mklibsgmltable -a -v [-f] [-m modname ] [[-l incllibs] | [-x excllibs ]]\n"; die; } sub quotify($) { my ($str) = @_; $str =~ s/,/','/g; $str = "'" . $str . "'"; return $str; } # Uncomment to trace SQL statments #$trace=1; # # 1) process the arguments # $numcols=1; $dodesc=0; GetOptions("a=s" => \$archname, "f" => \$future, "l=s" => \$inclib, "m=s" => \$module, "v=s" => \$lsbversion, "x=s" => \$excllib); if( !$archname ) { usage(); } if( !$lsbversion ) { usage(); } if( $inclib && $excllib ) { usage(); } # # 2) Establish connection to the database # $dbh = DBI->connect('DBI:mysql:database='.$LSBDB.';host='.$LSBDBHOST, $LSBUSER, $LSBDBPASSWD) or die "Couldn't connect to database: ".DBI->errstr; # # 3) get & print the architecture info # $select = "SELECT * FROM Architecture "; $select.= "WHERE Architecture.Aname=".$dbh->quote($archname); print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $entry=$sth->fetchrow_hashref; $sth->finish; $Aid=0; if( $entry->{'Aid'} ) { $Aid=$entry->{'Aid'}; } if( (not $entry->{'Aname'}) and ($archname ne 'None') ) { die "Unsupported architecture"; } $Aname=$entry->{'Aname'}; if( $archname eq 'None' ) { $Aid=1; } # # 4) Get the data # $select = "SELECT * FROM Library "; if( $module ) { $select.= "LEFT JOIN ModLib ON MLlid=Lid "; $select.= "LEFT JOIN SubModule ON MLmid=SMid "; } $select.= "LEFT JOIN ArchLib ON Lid=ALlid "; if( $future ) { $select.= "WHERE (Lcandidatefor<>'' OR (ALappearedin <= '$lsbversion' AND ALappearedin<>'' "; $select.= "AND (ALwithdrawnin IS NULL OR ALwithdrawnin > '$lsbversion') ) ) "; } else { $select.= "WHERE (ALappearedin <= '$lsbversion' AND ALappearedin<>'' "; $select.= "AND (ALwithdrawnin IS NULL OR ALwithdrawnin > '$lsbversion') ) "; } if( $module ) { $select.= "AND SMname IN (".quotify($module).") "; } if( $inclib ) { $select.= "AND Lname IN (".$inclib.") "; } if( $excllib ) { $select.= "AND Lname NOT IN (".$excllib.") "; } $select.= "AND ALaid=$Aid"; #$select .=" ORDER BY Lname "; #printf STDERR $select,"\n"; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; printf("\n"); printf("\n"); print "\n"; if( $archname ne 'None' ) { for(1..$sth->rows) { $entry=$sth->fetchrow_hashref; if( $entry->{'ALrunname'} eq "" ) { next; } print ""; printf "%s", makeid($entry->{'Lname'}), $entry->{'ALrunname'}, $entry->{'Lname'}; printf "%s",$entry->{'ALrunname'}; print "\n"; } } else { for(1..$sth->rows) { $entry=$sth->fetchrow_hashref; if( $entry->{'ALrunname'} ne "" ) { next; } print ""; printf "%s", makeid($entry->{'Lname'}), "See archLSB", $entry->{'Lname'}; printf "%s","See archLSB"; print "\n"; } } $sth->finish; $dbh->disconnect; print "\n"; printf("\n"); sub makeid { my ($name) = @_; $name =~ s/\s+/./g; $name =~ s/[^A-Za-z0-9.]+/./g; # finally, remove any repeated . (e.g. "RPC...XDR" which arose from "RPC & XDR") $name =~ s/\.\.+/./g; return $name; } mklibspec0000775000076400007640000007003711030214650011460 0ustar matsmats#!/usr/bin/perl use Getopt::Long; use DBI; use IPC::Open2; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); my $trace = 0; sub usage() { print STDERR "mklibspec -l -a -v [-c cols] [-d]\n"; die; } sub unmangle($) { local($int) = @_; # handle qt3 hack $int =~ s/^_Y/_Z/; if (!defined($cxxfilt)) { $cxxfilt = open2(\*CXXRDR, \*CXXWRT, "c++filt") or die "Could not open c++filt: $!"; } print CXXWRT "$int\n"; $int = ; chomp($int); $int =~ s//\>/g; return $int; } sub makeid($) { my ($name) = @_; $name =~ s/\s+/./g; $name =~ s/[^A-Za-z0-9.]+/./g; # finally, remove any repeated . (e.g. "RPC...XDR" which arose from "RPC & XDR") $name =~ s/\.\.+/./g; return $name; } sub output_table($$$$$$$) { local ($i,$name,*int,*symver,*stdnum,*stdname,$title) = @_; local *ref; print "\n"; print "$title\n"; print "\n"; print "\n"; my $trows=int(($i+($numcols-1))/$numcols); my $intnum = 1; for $row (1..$trows) { print "\n"; for $col (0..$numcols-1) { printf ""; #my $intnum = $row+($col*$trows); if( $int[$intnum] ) { # the reference stuff is now somewhat simpler than # it used to be. Up front, we calculated a hash # with all of the references. LINK to that table # by looking up the number from the %ref_list hash. my $interface = $int[$intnum]; $interface = unmangle($interface) if ($demangle); printf "%s%s", $interface, $interface; if( $symver[$intnum] ) { printf "(%s)", $symver[$intnum]; } if( $stdname[$intnum] ) { printf " [%s]", makeid($Lname), $ref_list{$stdname[$intnum]}, $stdname[$intnum]; } $intnum++; } printf "\n"; } print "\n"; } print "\n"; print "\n"; print "
\n"; } sub getinterfacename($) { local($Iid)=@_; my($select,$entry); if( $Iid eq "" ) {return "";} #print STDERR "Looking for Iname for $Iid\n"; $select = "SELECT Iname FROM Interface "; $select.= "WHERE Iid=$Iid"; #print $select; $isth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $isth->execute or die "Couldn't execute $select query: ".DBI->errstr; $entry=$isth->fetchrow_hashref; $isth->finish; return $entry->{'Iname'}; } sub getinterfacevisibility($) { local($Iid)=@_; my($select,%entry); if( $Iid eq "" ) {return "";} $select = "SELECT Isrcbin FROM Interface "; $select.= "WHERE Iid=$Iid"; $isth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $isth->execute or die "Couldn't execute $select query: ".DBI->errstr; $entry=$isth->fetchrow_hashref; $isth->finish; return $entry->{'Isrcbin'}; } sub output_classinfo($) { local ($class) = @_; #print STDERR $$class{'CIname'}."\n"; local $classname = unmangle($$class{'CIname'}); print "\n\n"; print "\n"; print ""; print "Class data for ".$classname; print "\n"; print "\n"; print "\n"; # # Display Vtable info # if( $$class{'CIvtable'} ) { # # we are in a class ... always unmangle (ignore -d) # local $tblref = sprintf "cls-%s", nmhash($$class{'CIvtable'}); $select = "SELECT * FROM ClassVtab "; $select.= "LEFT JOIN ArchClass ON ACcid = CVcid "; $select.= "AND ACpos = CVpos "; $select.= "WHERE CVcid=".$$class{'CIid'}." "; $select.= "AND ( ACaid = $Aid or ACaid = 1 ) "; $select.= "ORDER BY CVpos"; $vtsth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $vtsth->execute or die "Couldn't execute $select query: ".DBI->errstr; if( $vtsth->rows ) { print "\n"; print "The virtual table for the $classname class\n"; print "is described by \n"; print "\n"; } else { print "\n"; print "The virtual table for the $classname class\n"; #XXX #print "is described in the relevant architecture specific part of &ISOSTD;.\n"; print "is described in the relevant architecture specific part of this specification.\n"; print "\n"; } for(1..$vtsth->rows) { $classvtab = $vtsth->fetchrow_hashref; print "\n"; printf "\n", $classvtab->{'CVpos'}; print ""; if( $classvtab->{'CVpos'} == 0 ) { print "Primary "; } else { print "Secondary "; } $intname=unmangle(getinterfacename($$class{'CIvtable'})); if( $intname ne '' ) { print $intname; } else { print getinterfacename($$class{'CIvtable'})." ".$$class{'CIvtable'}; die "Can't get the vtable name"; } print "\n"; #print "\n"; print "\n"; print "\n"; print "\n"; print "Base Offset\n"; print ""; print $classvtab->{'ACbaseoffset'}; print "\n"; print "\n"; print "\n"; print "Virtual Base Offset\n"; print ""; print $classvtab->{'ACvoffset'}; print "\n"; print "\n"; print "\n"; print "RTTI\n"; print ""; $func=unmangle(getinterfacename($classvtab->{'CVrtti'})); printf "%s%s", $func, $func; print "\n"; print "\n"; $select = "SELECT * FROM Vtable "; $select.= "LEFT JOIN Architecture ON VTarch=Aid "; $select.= "WHERE VTcid=".$$class{'CIid'}." "; $select.= "AND VTvtpos=".$classvtab->{'CVpos'}." "; $select.= "AND ( Aid=$Aid OR Aid=1 ) "; $select.= "ORDER BY VTpos"; $vsth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $vsth->execute or die "Couldn't execute $select query: ".DBI->errstr; $lastpost=0; for(1..$vsth->rows) { $ventry=$vsth->fetchrow_hashref; for(($lastpos+1)..($ventry->{'VTpos'}-1)) { print "\n"; print "vfunc[$_]:\n"; print ""; printf "See The Architecture Specific Specification"; print "\n"; print "\n"; } print "\n"; print "vfunc[".$ventry->{'VTpos'}."]:\n"; print ""; if( $ventry->{'VTviid'} != 0 ) { $func=unmangle(getinterfacename($ventry->{'VTviid'})); $visibility = getinterfacevisibility($ventry->{'VTviid'}); if( $visibility eq "SrcOnly" ) { printf "%sNULL or %s", $func, $func; } else { printf "%s%s", $func, $func; } } else { printf "Unspecified"; } print "\n"; print "\n"; $lastpos=$ventry->{'VTpos'}; } $vsth->finish; print "\n"; print "\n"; print "
\n"; } $vtsth->finish } # # Display RTTI info # if( $$class{'CIrtti'} ) { local $tblref = sprintf "rtti-%s", nmhash($$class{'CIrtti'}); print "\n"; print "The Run Time Type Information for the $classname class\n"; print "is described by \n"; print "\n"; print "\n"; print "\n"; print "".unmangle(getinterfacename($$class{'CIrtti'}))."\n"; print "\n"; print "\n"; print "\n"; print "Base Vtable\n"; print ""; $func=unmangle(getinterfacename($$class{'CIbasevtable'})); printf "%s%s", $func, $func; print "\n"; print "\n"; print "\n"; print "Name\n"; print ""; $func="_ZTS".substr($$class{'CIname'},2,256); $func = unmangle($func); printf "%s%s", $func, $func; print "\n"; print "\n"; if( $$class{'CInumbasetype'} == '1' ) { $select = "SELECT * FROM BaseTypes "; $select.= "LEFT JOIN ClassInfo ON BTcid=CIid "; $select.= "WHERE CIid=".$$class{'CIid'}." "; $select.= "ORDER BY BTpos"; $vsth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $vsth->execute or die "Couldn't execute $select query: ".DBI->errstr; # for(1..$$class{'CInumbasetype'}) { $entry=$vsth->fetchrow_hashref; print "\n"; print "basetype:\n"; print ""; $func=unmangle(getinterfacename($$entry{'BTbasetype'})); printf "%s%s", $func, $func; print "\n"; print "\n"; # } $vsth->finish; } if( $$class{'CInumvmitypes'} ) { print "\n"; print "flags:\n"; print "".$$class{'CIflags'}."\n"; print "\n"; $select = "SELECT * FROM VMIBaseTypes "; $select.= "LEFT JOIN ClassInfo ON VBTcid=CIid "; $select.= "WHERE CIid=".$$class{'CIid'}." "; $select.= "ORDER BY VBTpos"; $vsth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $vsth->execute or die "Couldn't execute $select query: ".DBI->errstr; for(1..$$class{'CInumvmitypes'}) { $entry=$vsth->fetchrow_hashref; print "\n"; print "basetype:\n"; print ""; $func=unmangle(getinterfacename($entry->{'VBTbasetype'})); printf "%s%s", $func, $func; print "\n"; print "".$entry->{'VBTflags'}."\n"; print "\n"; } $vsth->finish; } print "\n"; print "\n"; print "
\n"; } # # Display VTT info # if( $$class{'CIvtt'} ) { local $tblref = sprintf "vtt-%s", nmhash($$class{'CIvtt'}); print "\n"; print "The VTT for the $classname class\n"; print "is described by \n"; print "\n"; print "\n"; print "\n"; print "".unmangle(getinterfacename($$class{'CIvtt'}))."\n"; print "\n"; print "\n"; print "\n"; print "VTT Name\n"; print ""; $func=getinterfacename($$class{'CIvtt'}); printf "%s%s", $func, $func; print "\n"; print "\n"; print "\n"; print "Number of Entries\n"; print ""; print $$class{'CInumvtt'}; print "\n"; print "\n"; print "\n"; print "\n"; print "
\n"; } print "\n"; } sub getinterfaces($$$$) { local ($Lname, $LGname, $type, $needpara) = @_; local(*entry); local(*symver); local(*stdnum); local(*stdname); local($table_title); local($name); local($where); local($safeLname)=$Lname; $safeLname =~ s/_/-/g; if ($type eq "functions" || $type eq "methods") { $where = "WHERE LGIlibg=$LGid AND Itype='Function' "; $where.= "AND (AIappearedin <= '$lsbversion' and AIappearedin<>'') "; $where.= "AND (AIwithdrawnin IS NULL OR AIwithdrawnin >'$lsbversion')"; $where.= "AND AIarch=$Aid "; $name = "ints"; $table_title = "$Lname - $LGname Function Interfaces"; } elsif ($type eq "deprecated functions") { $where = "WHERE LGIlibg=$LGid AND Itype='Function' "; $where.= "AND AIdeprecatedsince <= '$lsbversion' "; $where.= "AND AIarch=$Aid "; $name = "depints"; $table_title = "$Lname - $LGname Deprecated Function Interfaces"; } elsif ($type eq "data interfaces") { $where = "WHERE LGIlibg=$LGid AND Itype != 'Function' "; $where.= "AND (AIappearedin <= '$lsbversion' and AIappearedin<>'') "; $where.= "AND (AIwithdrawnin IS NULL OR AIwithdrawnin >'$lsbversion') "; $where.= "AND AIarch=$Aid "; $name = "data"; $table_title = "$Lname - $LGname Data Interfaces"; } elsif ($type eq "deprecated data interfaces") { $where = "WHERE LGIlibg=$LGid AND Itype != 'Function' "; $where.= "AND AIdeprecatedsince <= '$lsbversion' "; $where.= "AND AIarch=$Aid "; $name = "ddata"; $table_title = "$Lname - $LGname Deprecated Data Interfaces"; } else { die "Unknown type $type"; } $select = "SELECT DISTINCT Iname, AIarch, Vname, ISsid, Sname FROM Interface "; $select.= "LEFT JOIN LGInt ON Iid=LGIint "; $select.= "LEFT JOIN ArchInt ON Iid=AIint "; $select.= "LEFT JOIN Version ON Vid=AIversion "; $select.= "LEFT JOIN IntStd ON ISiid=Iid "; $select.= "LEFT JOIN Standard ON Sid=ISsid "; $select.= "$where "; $select.= "AND (ISappearedin <= '$lsbversion' and ISappearedin<>'') "; $select.= "AND (ISwithdrawnin IS NULL OR ISwithdrawnin >'$lsbversion') "; $select.= "ORDER BY Iname"; print STDERR $select,"\n" if $trace; $inh = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $inh->execute or die "Couldn't execute $select query: ".DBI->errstr; $i=0; for(1..$inh->rows) { $entry=$inh->fetchrow_hashref; if( $entry[$i] ne $entry->{'Iname'} ) { $i++; } $entry[$i]=$entry->{'Iname'}; if( $entry->{'AIarch'} == $Aid ) { $symver[$i]=$entry->{'Vname'}; } $stdnum[$i]=$entry->{'ISsid'}; $stdname[$i]=$entry->{'Sname'}; } $inh->finish; if( $i > 0 ) { $arch_type = ($archname eq "All") ? "generic" : "architecture specific"; $tblname = sprintf "tbl-%s-%s-%s", $safeLname, nmhash($LGname), $name; $tblname =~ s/[^A-Za-z0-9.]+/-/g; $tblname =~ s/\+/x/g; # change the C++ names into Cxx print "\n"; print "An LSB conforming implementation shall provide the $arch_type $type\n"; print "for $LGname specified in ,\n"; print "with the full mandatory functionality as described in the referenced\n"; print "underlying specification.\n"; print "\n"; if ($type =~ /deprecated.*/) { print ""; print "These interfaces are deprecated, and applications\n"; print "should avoid using them.\n"; print "These interfaces may be withdrawn\n"; print "in future releases of this specification.\n"; print "\n"; } print "\n"; output_table($i,$tblname,*entry,*symver,*stdnum,*stdname,$table_title); } elsif ($needpara) { # # no functions/methods are defined for this library in THIS architecture # but they may be defined for other architectures. # Add appropriate note to this effect. # printf "\n"; printf "No external $type are defined for $Lname - $LGname\n"; printf "in this part of the specification. See also the %s.\n", $Aid == 1 ? "relevant architecture specific part of this specification" : "generic specification"; #XXX #$Aid == 1 ? "relevant architecture specific part of &ISOSTD;" : "generic specification, &ISOSTD-1;"; printf "\n"; } } sub nmhash($) { local ($name) = @_; # generate a five char name from the (long) libgroup name local ($sname) = lc(substr($name, 0, 5)); $namehash{$sname} = $name if (!defined ($namehash{$sname})); until (!defined($namehash{$sname}) || ($namehash{$sname} eq $name)) { $sname++; $sname =~ s/_/-/g; } $namehash{$sname} = $name; return $sname; } sub data_def_header() { print "\n"; print "Data Definitions for $Lname\n"; print "\n"; print "This section defines global identifiers and their values that are associated\n"; print "with interfaces contained in $Lname.\n"; print "These definitions are organized into groups that\n"; print "correspond to system headers. This convention is used as a\n"; print "convenience for the reader, and does not imply the existence\n"; print "of these headers, or their content.\n"; print "Where an interface is defined as requiring a particular system header file\n"; print "all of the data definitions for that system header file presented here shall be in effect.\n"; print "\n"; print "\n"; print "This section gives data definitions to promote binary application\n"; print "portability, not to repeat source interface definitions available\n"; print "elsewhere. System providers and application developers should use this ABI\n"; print "to supplement - not to replace - source interface definition specifications.\n"; print "\n"; print "\n"; print "This specification uses the C Language as the reference programming "; print "language, and "; print "data definitions are specified in ISO C format. The C language "; print "is used here as a convenient notation. Using a C language "; print "description of these data objects does not preclude their use "; print "by other programming languages."; print "\n"; $done_data_def_header++; } # the main program ... # Uncomment to trace SQL statements #$trace=1; # A default value $numcols=4; $demangle = 0; # # 1) process the arguments # GetOptions("l=s" => \$libname, "c=i" => \$numcols, "v=s" => \$lsbversion, "d" => \$demangle, "a=s" => \$archname); if( !$libname ) { usage(); } if( !$archname ) { usage(); } if( !$lsbversion ) { usage(); } # # 2) Establish connection to the database # $dbh = DBI->connect('DBI:mysql:database='.$LSBDB.';host='.$LSBDBHOST, $LSBUSER, $LSBDBPASSWD) or die "Couldn't connect to database: ".DBI->errstr; # # 3) get & print the architecture info # $select = "SELECT Aname,Aid FROM Architecture WHERE "; $select.= "Architecture.Aname=".$dbh->quote($archname); print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $entry=$sth->fetchrow_hashref; $sth->finish; $Aid=$entry->{'Aid'}; $Aname=$entry->{'Aname'}; $safelibname=$libname; $safelibname =~ s/_/-/g; printf("\n"); printf("\n"); print "\n"; print "Interfaces for ", $libname, "\n"; print "\n"; print " defines the library name and shared object name\n"; print "for the $libname library\n"; print "\n"; # # 4) get & print the library info # $select = "SELECT * FROM Library "; $select.= "LEFT JOIN ArchLib ON Lid=ALlid "; $select.= "WHERE Library.Lname=".$dbh->quote($libname)." "; $select.= "AND ( (ALappearedin <= '$lsbversion' AND ALappearedin<>'' "; $select.= "AND (ALwithdrawnin IS NULL OR ALwithdrawnin > '$lsbversion') ) "; $select.= "OR Lcandidatefor<>'' )"; $select.= "AND ALaid=$Aid"; print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $entry=$sth->fetchrow_hashref; $sth->finish; $Lid=$entry->{'Lid'}; $Lname=$entry->{'Lname'}; $Larch=$entry->{'ALaid'}; if( $Larch == $Aid ) { print "\n"; print "$Lname Definition\n"; print "\n"; print "\n"; print "\n"; print "Library:\n"; print "", $entry->{'Lname'}, "\n"; print "\n"; print "\n"; print "SONAME:\n"; if( $entry->{'ALrunname'} ne "" ) { print "", $entry->{'ALrunname'}, "\n"; } else { print "See archLSB.\n"; } print "\n"; print "\n"; print "\n"; print "
\n"; } # # 5) Check for additional description text for the library # if(open(DESC,"<$Lname.txt" )) { while() { print $_; } close DESC; } # # 6) Get a list of the Standards that are used by this library # print "\n"; $select = "SELECT DISTINCT Sname,Sid FROM Standard "; $select.= "LEFT JOIN IntStd ON ISsid=Sid "; $select.= "LEFT JOIN Interface ON Iid=ISiid "; $select.= "LEFT JOIN LGInt ON LGIint=Iid "; $select.= "LEFT JOIN LibGroup ON LGid=LGIlibg "; $select.= "LEFT JOIN ArchInt ON AIint=Iid "; $select.= "WHERE LGlib=$Lid "; $select.= "AND (AIappearedin <= '$lsbversion' AND AIappearedin<>'') "; $select.= "AND (AIwithdrawnin IS NULL OR AIwithdrawnin >'$lsbversion')"; $select.= "AND (ISappearedin <= '$lsbversion' AND ISappearedin<>'') "; $select.= "AND (ISwithdrawnin IS NULL OR ISwithdrawnin >'$lsbversion') "; $select.= "AND AIarch=$Aid "; $select.= "ORDER BY Sname"; print STDERR $select,"\n" if $trace; #my %ref_list; $lsh = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $lsh->execute or die "Couldn't execute $select query: ".DBI->errstr; if( $lsh->rows) { print "The behavior of the interfaces in this library is specified "; print "by the following specifications:"; print "\n"; for(my $refno=1; $refno <= $lsh->rows; $refno++) { local(*entry); $entry=$lsh->fetchrow_hashref; printf "\n", makeid($Lname), $refno; printf "[%s] \n", $entry->{'Sname'}, makeid($entry->{'Sname'}); print "\n"; $ref_list{$entry->{'Sname'}} = $refno; } print "\n"; } $lsh->finish; print "\n"; # # 7) Get a list of the libgroups in the library # $select = "SELECT * FROM LibGroup WHERE LGlib=$Lid ORDER BY LGorder"; print STDERR $select,"\n" if $trace; $lgh = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $lgh->execute or die "Couldn't execute $select query: ".DBI->errstr; if ($lgh->rows == 0) { if ($archname eq "All") { print "\n"; print "There are no generic interfaces to this library\n"; #XX #print "Please refer to the relevant architecture specific part of &ISOSTD; for details\n"; print "Please refer to the relevant architecture specific part of this specification for details\n"; print "\n"; } else { print "\n"; print "The $archname architecture has no architecture specific interfaces\n"; print "to this library. Please refer to the generic specification.\n"; print "\n"; } } for(1..$lgh->rows) { local(*entry); local(*std); $entry=$lgh->fetchrow_hashref; $LGid=$entry->{'LGid'}; $LGname=$entry->{'LGname'}; print "\n"; $LGname=unmangle($LGname) if ($demangle); print "\n"; print "\n"; print ""; print $LGname; print "\n"; print "\n"; print "\n"; # # 8) For each group, make a table of the class data # { local(*entry); local(*inh); $select = "SELECT * FROM ClassInfo "; $select.= "LEFT JOIN LibGroup ON CIlibg=LGid "; $select.= "LEFT JOIN ClassVtab ON CVcid=CIid "; $select.= "LEFT JOIN ArchClass ON ACcid=CIid "; $select.= "WHERE LGid=$LGid "; if( $Aid != 1 ) { $select.= "AND (ACaid=1 OR ACaid=$Aid) "; } $select.= "AND ACappearedin<>'' AND ACappearedin <= '$lsbversion' "; $select.= "AND (ACwithdrawnin IS NULL OR ACwithdrawnin > '$lsbversion') "; $select.= "AND CVpos=0 "; $select.= "GROUP BY ACcid "; $inh = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $inh->execute or die "Couldn't execute $select query: ".DBI->errstr; print STDERR $select,"\n" if $trace; for(1..$inh->rows) { $entry=$inh->fetchrow_hashref; output_classinfo($entry); } $inh->finish; } # # 9) For each group, make a table of the interfaces # print "\n\n"; print "\n"; print ""; print "Interfaces for ".$LGname; print "\n"; getinterfaces( $Lname, $LGname, $demangle ? "methods" : "functions", 1); # # 10) For each group, make a table of the deprecated interfaces # getinterfaces($Lname, $LGname, "deprecated functions", 0); # # 11) Make a table of data interfaces # getinterfaces($Lname, $LGname, "data interfaces", 0); # # 12) Make a table of deprecated data interfaces # getinterfaces($Lname, $LGname, "deprecated data interfaces", 0); print "\n"; print "\n"; } $lgh->finish; print "\n"; # # List the data definitions by including the related headers here # # # Now, get a list of all headers associate with this library # local ($data_def_header); $data_def_header = 0; $select = "SELECT DISTINCT Hname,Hid FROM Header "; $select.= "WHERE Hlib=$Lid "; $select.= "AND Happearedin <= '$lsbversion' AND Happearedin <>'' "; $select.= "AND (Hwithdrawnin IS NULL OR Hwithdrawnin > '$lsbversion') "; $select.= "ORDER BY Hname"; $hdh = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $hdh->execute or die "Couldn't execute $select query: ".DBI->errstr; if( $hdh->rows ) { for(1..$hdh->rows) { local(*entry); $entry=$hdh->fetchrow_hashref; $Hname=$entry->{'Hname'}; $headroot="../../../build_env/headers/$archname/$lsbversion/".$Hname; $headname=$headroot.".defs"; if (!open(HEADER,"<".$headname) && !open(HEADER,"<../".$headname)) { print "\n"; next; } if( -s HEADER ) { # Make sure it's not empty data_def_header() if (!$done_data_def_header); print "\n"; print ""; print $entry->{'Hname'}; print "\n"; print "\n"; $headnote=$headroot.".notes"; if (open(HEADNOTE, "<$headnote") || open(HEADNOTE,"<../$headnote")) { print $_ while (); close(HEADNOTE); } print "\n"; print "\n"; while(
) { s/\&/&/g; s/\\n"; print "\n"; } else { print "\n"; # # perhaps we should print a : # "No additional data interfaces are defined for $Hname" # message here ?? # } } print "\n" if ($done_data_def_header); } $hdh->finish; # # List the Interface Definitions of things specified by the LSB document. # $select = "SELECT Iname,ISsid FROM Interface "; $select.= "LEFT JOIN LGInt ON Iid=LGIint "; $select.= "LEFT JOIN LibGroup ON LGid=LGIlibg "; $select.= "LEFT JOIN Library ON Lid=LGlib "; $select.= "LEFT JOIN IntStd ON ISiid=Iid "; $select.= "LEFT JOIN Standard ON Sid=ISsid "; $select.= "LEFT JOIN ArchInt ON Iid=AIint "; $select.= "WHERE Lid=$Lid AND AIarch=$Aid "; $select.= "AND (AIappearedin <= '$lsbversion' and AIappearedin<>'') "; $select.= "AND (AIwithdrawnin IS NULL OR AIwithdrawnin >'$lsbversion')"; $select.= "AND (ISappearedin <= '$lsbversion' and ISappearedin<>'') "; $select.= "AND (ISwithdrawnin IS NULL OR ISwithdrawnin >'$lsbversion') "; # Don't try to include the description of generic interfaces # into the arch specific document if( $Aid!=1 ) { $select.= "AND Iid NOT IN "; $select.= "(SELECT DISTINCT AIint FROM ArchInt"; $select.= " WHERE AIarch=1 "; $select.= " AND (AIappearedin <= '$lsbversion' and AIappearedin<>'') "; $select.= " AND (AIwithdrawnin IS NULL OR AIwithdrawnin >'$lsbversion') )"; } $select.= "AND Sname='LSB'"; $select.= "ORDER BY Iname"; print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; if($sth->rows) { print "\n"; print "Interface Definitions for ", $libname, "\n"; print "\n"; print "The interfaces defined on the following pages are included in $libname and are defined\n"; print "by this specification.\n"; print "Unless otherwise noted, these interfaces shall be included\n"; print "in the source standard.\n"; print "\n"; print "\n"; print "Other interfaces listed in shall behave as described\n"; print "in the referenced base document."; if( $Aid != 1 ) { print " For interfaces referencing LSB and not listed below, please see the generic part of the specification.\n" } else { print "\n"; } print "\n"; for(1..$sth->rows) { local(*entry); $entry=$sth->fetchrow_hashref; # NB: Footnotes must be unique across the entire document # NB: names are NOT demangled here ... if (-f $entry->{'Iname'}.".sgml") { print "m4_include(".$entry->{'Iname'}.".sgml)\n"; } else { $missing++; print "\n"; print "\n"; } } print "\n"; } $sth->finish; $dbh->disconnect; printf STDERR ("Skipped %d missing interfaces\n", $missing) if ($missing); printf("\n"); mklsbmanpage0000775000076400007640000002410510761554030012154 0ustar matsmats#! /usr/bin/perl # # mklsbmanpage # - based on mksynop, write out an entire man page for a given interface. # NB the database does not (currently) hold names for the positional # parameters stored in the Parameter table, so we temporarily # call them "arg1", "arg2" etc # use DBI; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); use strict; use Getopt::Long; my $level = 0; my $dbh; my $lsbversion; my $arch; my $Aid; # # sub indent($) { # function abandoned! } # # return content # 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("", $tagname); } else { $retstr .= sprintf("<%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 "" if (!defined ($type) || $type eq "" || $type eq "void"); return "" 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 displaytyperef($) { my ($param) = @_; my($select,$sth,$type); my ($tselect, $tmselect, $Tid, $tmh, $tmentry, $nameonly); my ($tth, $TMtypeid, $th, $entry); my $retval = ""; if( $$param{'Ttype'} eq "Intrinsic" ) { $retval .= $$param{'Tname'}; return $retval; } if( $$param{'Ttype'} eq "Literal" ) { $retval .= $$param{'Tname'}; return $retval; } if( $$param{'Ttype'} eq "Const" ) { $select = "SELECT * FROM Type left join ArchType on ATtid=Tid WHERE Tid=".$$param{'ATbasetype'}." AND ATaid IN(1,$Aid) GROUP BY Tid"; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $type=$sth->fetchrow_hashref; $sth->finish; if( $type->{'Ttype'} eq "Pointer" ) { $retval .= displaytyperef($type); $retval .= "const "; } else { $retval .= "const "; $retval .= displaytyperef($type); } return $retval; } if( $$param{'Ttype'} eq "Pointer" ) { $select = "SELECT * FROM Type left join ArchType on ATtid=Tid WHERE Tid=".$$param{'ATbasetype'}." AND ATaid IN(1,$Aid) GROUP BY Tid"; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $type=$sth->fetchrow_hashref; $sth->finish; $retval .= displaytyperef($type); $retval .= " *"; return $retval; } if( $$param{'Ttype'} eq "Struct" ) { $retval .= "struct ".$$param{'Tname'}; return $retval; } if( $$param{'Ttype'} eq "Typedef" ) { $retval .= $$param{'Tname'}; return $retval; } if( $$param{'Ttype'} eq "Union" ) { $retval .= "union ".$$param{'Tname'}; return $retval; } if( $$param{'Ttype'} eq "Enum" ) { $retval .= "enum ".$$param{'Tname'}; return $retval; } if( $$param{'Ttype'} eq "Array" ) { my $basetype=$$param{'ATbasetype'}; $tselect="SELECT * FROM Type left join ArchType on ATtid=Tid WHERE Tid=$basetype AND ATaid IN(1,$Aid) GROUP BY Tid"; $tth = $dbh->prepare($tselect) or die "Couldn't prepare $tselect query: ".DBI->errstr; $tth->execute or die "Couldn't execute $tselect query: ".DBI->errstr; $type=$tth->fetchrow_hashref; $tth->finish; if( !$nameonly ) { $nameonly=1; $retval .= displaytyperef($type); $nameonly=0; } else { $retval .= displaytyperef($type); } if( $$param{'Tname'} =~ "fptr" ) { $$param{'Tname'} =~ s/fptr-//; } return $retval; } if( $$param{'Ttype'} eq "FuncPtr" ) { $select = "SELECT * FROM Type left join ArchType on ATtid=Tid WHERE Tid=".$$param{'ATbasetype'}." AND ATaid IN(1,$Aid) GROUP BY Tid"; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $type=$sth->fetchrow_hashref; $sth->finish; $Tid=$$param{'Tid'}; $retval .= displaytyperef($type); $retval .= "(*"; if( $$param{'Tname'} =~ "fptr" ) { $$param{'Tname'} =~ s/fptr-//; } #print $$param{'Tname'}; $retval .= ")"; $retval .= "("; $tmselect="SELECT * FROM TypeMember WHERE TMmemberof=$Tid AND TMaid in(1,$Aid) "; $tmselect.=" ORDER BY TMposition"; $tmh = $dbh->prepare($tmselect) or die "Couldn't prepare $tmselect query: ".DBI->errstr; $tmh->execute or die "Couldn't execute $tmselect query: ".DBI->errstr; if($tmh->rows == 0) { $retval .= "void"; } for(1..$tmh->rows) { $tmentry=$tmh->fetchrow_hashref; $TMtypeid=$tmentry->{'TMtypeid'}; $tselect="SELECT * FROM Type left join ArchType on ATtid=Tid WHERE Tid=$TMtypeid AND ATaid IN(1,$Aid) GROUP BY Tid"; $th = $dbh->prepare($tselect) or die "Couldn't prepare $tselect query: ".DBI->errstr; $th->execute or die "Couldn't execute $tselect query: ".DBI->errstr; $entry=$th->fetchrow_hashref; $th->finish; $nameonly=1; displaytype($entry); #print $tmentry->{'TMname'}; if( $tmentry->{'TMarray'} ) { $retval .= "[".$tmentry->{'TMarray'}."]"; } if( $_ != $tmh->rows ) { $retval .= ","; } $nameonly=0; } $tmh->finish; $retval .= ")\n"; return $retval; } $retval .= $$param{'Ttype'}; return $retval; } sub trim($) { my ($str) = @_; $str =~ s/^ *(.*)$/\1/; $str =~ s/(.*) +$/\1/; return $str; } 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; sub mksynop($) { my ($func) = @_; # # we need four things from the db for the interface requested: # - 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] # my $sql = "select * from Interface "; $sql .= "left join ArchInt on Iid=AIint "; $sql .= "left join Type on Tid=Ireturn "; $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; my $type = displaytyperef($entry); my $hdr = sprintf("#include <%s>",$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"; 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; my $argno = 0; if ($sth->rows == 0) { # a void ... push(@args, { 'type' => undef, 'name' => "irrelevant", }); } while (($entry = $sth->fetchrow_hashref)) { my $argname = sprintf("arg%d", $argno++); my $argtype = displaytyperef($entry); 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; } sub refmeta($$) { my ($lib, $interface) = @_; print "\n"; print "$interface\n"; print "$lib\n"; print "\n"; } sub namediv($$) { my ($lib, $interface) = @_; print "\n"; print "\n"; print "$interface\n"; print "INSERT PURPOSE HERE\n"; print "\n"; print "\t$interface\n"; print "\n"; } sub section($$) { my ($title, $interface) = @_; print "\n"; print "$title\n"; print "\n"; print "INSERT TEXT HERE\n"; print "\n"; print "\n"; } sub usage() { die "Usage: mklsbmanpage -v -a \n"; } GetOptions( "v=s" => \$lsbversion, "a=s" => \$arch ); if( !$lsbversion ) { usage(); } 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"; } } my $lib = $ARGV[0]; my $interface = $ARGV[1]; printf "\n\n", $lib, $interface; refmeta($lib, $interface); namediv($lib, $interface); mksynop($interface); section('Description', $interface); section('Return Value', $interface); section('Errors', $interface); printf "\n"; $dbh->disconnect; mkmanpage0000775000076400007640000000146311027745102011453 0ustar matsmats#!/usr/bin/perl use Getopt::Long; use POSIX qw(strftime); sub usage() { print STDERR "mkmanpage -n \n"; die; } # # 1) process the arguments # GetOptions("n=s" => \$manname); if( !$manname ) { usage(); } $date = strftime "%e %b %Y", gmtime(); print " ".$manname." What Section?? ".$manname; print " What is this? ".$date." "; print "return_type ".$manname."(parameters)"; print " ".$date." Description "; mkrpmtagtable0000775000076400007640000000604411027745561012356 0ustar matsmats#!/usr/bin/perl use Getopt::Long; use DBI; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); sub usage() { print STDERR "mkrpmtagtable -g -t -v \n"; die; } # Uncomment to trace SQL statments #$trace=1; # # 1) process the arguments # GetOptions("g=s" => \$groupname, "v=s" => \$lsbversion, "t=s" => \$title); if( !$groupname ) { usage(); } if( !$title ) { usage(); } if( !$lsbversion ) { usage(); } # # 2) Establish connection to the database # $dbh = DBI->connect('DBI:mysql:database='.$LSBDB.';host='.$LSBDBHOST, $LSBUSER, $LSBDBPASSWD) or die "Couldn't connect to database: ".DBI->errstr; # # 3) get the data # $select = "SELECT * FROM RpmTag "; $select.= "WHERE Rgroup=".$dbh->quote($groupname); $select.= " AND (Rappearedin IS NOT NULL and Rappearedin <= '$lsbversion' and Rappearedin<>'') "; $select.= " AND (Rwithdrawnin IS NULL OR Rwithdrawnin > '$lsbversion') "; $select.= " ORDER BY Rtag "; print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; printf("\n"); printf("\n"); if($sth->rows) { print "\n"; print "$title\n"; print "\n"; print "\n"; print "\n"; print "Name"; print "Tag Value"; print "Type"; print "Count"; print "Status"; print "\n"; print "\n"; print "\n"; for(1..$sth->rows) { print ""; $entry=$sth->fetchrow_hashref; printf "%s",$entry->{'Rname'}; printf "%s",$entry->{'Rtag'}; printf "%s",$entry->{'Rtype'}; if( $entry->{'Rcount'} ) { printf "%s",$entry->{'Rcount'}; } else { printf ""; } printf "%s",$entry->{'Rstatus'}; print "\n"; } print "\n"; print "\n"; print "
\n"; } $sth->finish; $select = "SELECT * FROM RpmTag "; $select.= "WHERE Rgroup=".$dbh->quote($groupname); $select.= " AND (Rappearedin IS NOT NULL and Rappearedin <= '$lsbversion' and Rappearedin<>'') "; $select.= " AND (Rwithdrawnin IS NULL OR Rwithdrawnin > '$lsbversion') "; $select.= " ORDER BY Rtag "; #print $select,"\n"; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; if($sth->rows) { print "\n"; for(1..$sth->rows) { print ""; $entry=$sth->fetchrow_hashref; printf "%s",$entry->{'Rname'}; printf "%s",$entry->{'Rdescription'}; print "\n"; } print "\n"; } $sth->finish; $dbh->disconnect; printf("\n"); mksectiontable0000775000076400007640000000707711027745270012534 0ustar matsmats#!/usr/bin/perl use Getopt::Long; use DBI; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); sub usage() { print STDERR "mksectiontable -a -s -t -v \n"; die; } # Uncomment to trace SQL statments #$trace=1; # # 1) process the arguments # GetOptions("a=s" => \$archname, "s=s" => \$stdname, "v=s" => \$lsbversion, "t=s" => \$title); if( !$archname ) { usage(); } if( !$stdname ) { usage(); } if( !$title ) { usage(); } if( !$lsbversion ) { usage(); } # # 2) Establish connection to the database # $dbh = DBI->connect('DBI:mysql:database='.$LSBDB.';host='.$LSBDBHOST, $LSBUSER, $LSBDBPASSWD) or die "Couldn't connect to database: ".DBI->errstr; # # 3) get & print the architecture info # $select = "SELECT * FROM Architecture WHERE "; $select.= "Architecture.Aname=".$dbh->quote($archname); print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $entry=$sth->fetchrow_hashref; $sth->finish; $Aid=$entry->{'Aid'}; $Aname=$entry->{'Aname'}; if( not $Aname ) { die "Unsupported architecture"; } # # 4) Get the data # $select = "SELECT * "; $select.= "FROM ElfSections "; $select.= "LEFT JOIN ArchES ON AESesid=ESid "; $select.= "INNER JOIN Standard on AESstd=Sid "; $select.= "LEFT JOIN SectionTypes ON STid=AEStype "; $select.= "WHERE Sname=".$dbh->quote($stdname); $select.= " AND AESaid=$Aid"; $select.= " AND (AESappearedin <= '$lsbversion' and AESappearedin<>'') "; $select.= " AND (AESwithdrawnin IS NULL OR AESwithdrawnin > '$lsbversion')"; $select.= " ORDER BY ElfSections.ESname "; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; printf("\n"); printf("\n"); if($sth->rows) { print "\n"; print "$title\n"; print "\n"; print "\n"; print "\n"; print "Name"; print "Type"; print "Attributes"; print "\n"; print "\n"; print "\n"; for(1..$sth->rows) { print ""; $entry=$sth->fetchrow_hashref; printf "%s",$entry->{'ESname'}; printf "%s",$entry->{'STname'}; printf "%s",$entry->{'AESattributes'}; print "\n"; } print "\n"; print "\n"; print "
\n"; } $sth->finish; $select = "SELECT * "; $select.= "FROM Standard,ElfSections "; $select.= "LEFT JOIN ArchES ON AESesid=ESid "; $select.= "WHERE AESstd=Sid and Sname=".$dbh->quote($stdname); $select.= " AND AESaid=$Aid"; $select.= " AND (AESappearedin <= '$lsbversion' and AESappearedin<>'') "; $select.= " AND (AESwithdrawnin IS NULL OR AESwithdrawnin > '$lsbversion')"; $select.= " ORDER BY ElfSections.ESname "; #print $select,"\n"; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; if($sth->rows) { print "\n"; for(1..$sth->rows) { print ""; $entry=$sth->fetchrow_hashref; printf "%s",$entry->{'ESname'}; printf "%s",$entry->{'AESdescription'}; print "\n"; } print "\n"; } $sth->finish; $dbh->disconnect; printf("\n"); mksecttypestable0000775000076400007640000000504411027745323013102 0ustar matsmats#!/usr/bin/perl use Getopt::Long; use DBI; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); sub usage() { print STDERR "mksecttypestable -a -s -t \n"; die; } # Uncomment to trace SQL statments #$trace=1; # # 1) process the arguments # GetOptions("a=s" => \$archname, "s=s" => \$stdname, "t=s" => \$title); if( !$archname ) { usage(); } if( !$stdname ) { usage(); } if( !$title ) { usage(); } # # 2) Establish connection to the database # $dbh = DBI->connect('DBI:mysql:database='.$LSBDB.';host='.$LSBDBHOST, $LSBUSER, $LSBDBPASSWD) or die "Couldn't connect to database: ".DBI->errstr; # # 3) get & print the architecture info # $select = "SELECT * FROM Architecture WHERE "; $select.= "Architecture.Aname=".$dbh->quote($archname); print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $entry=$sth->fetchrow_hashref; $sth->finish; $Aid=$entry->{'Aid'}; $Aname=$entry->{'Aname'}; if( not $Aname ) { die "Unsupported architecture"; } $select = "SELECT * "; $select.= "FROM SectionTypes,Standard "; $select.= "WHERE STstandard=Sid and Sname=".$dbh->quote($stdname); $select.= " AND STarch=$Aid"; $select.= " ORDER BY SectionTypes.STname "; #print $select,"\n"; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; printf("\n"); printf("\n"); # # Tables need IDs so we can XREF them ... # local $tbl_id; $tbl_id = "tbl.$stdname"; printf "\n", $tbl_id; print "$title\n"; print "\n"; print "\n"; print "\n"; print "Name"; print "Value"; print "Description"; print "\n"; print "\n"; print "\n"; for(1..$sth->rows) { print ""; $entry=$sth->fetchrow_hashref; $stname = $entry->{'STname'}; $stname =~s/\_//g; printf "%s", $stname, $entry->{'STname'}, $entry->{'STname'}; printf "0x%x",$entry->{'STvalue'}; printf "%s",$entry->{'STdescription'}; print "\n"; } $sth->finish; $dbh->disconnect; print "\n"; print "\n"; print "
\n"; printf("\n"); mkspectable0000775000076400007640000000231611027745342012011 0ustar matsmats#!/usr/bin/perl use CGI; use Carp; use Mysql; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); $query = new CGI(%ARGV); $Dbh = Mysql->connect($LSBDBHOST,$LSBDB,$LSBUSER, $LSBDBPASSWD) || die $Mysql::db_errstr; $select ="SELECT DISTINCT Interface.Iname "; $select .="FROM Standard,Interface,StandInt"; if ( $query->param('Sname') ) { push(@where,"Standard.Sname=".$Dbh->quote($query->param('Sname'))); push(@where,"Standard.Sid=StandInt.SIstand"); push(@where,"Interface.Iid=StandInt.SIint"); } push(@where,"Interface.Iname NOT LIKE '\\_\\_%'"); if( scalar(@where) > 0 ) { $select .= " WHERE ".join(" AND ",@where); } $select .=" ORDER BY Interface.Iname "; #printf $select,"\n"; $sth = $Dbh->query($select) || die $select."\n".$Dbh->errmsg(); for(1..$sth->numrows) { %entry=$sth->fetchhash; $entry[$_]=$entry{'Iname'}; } print "\n"; print "\n"; print "\n"; $inc=($sth->numrows+4)/5; for(1..$inc) { print ""; printf "",$entry[$_]; printf "",$entry[$_+$inc]; printf "",$entry[$_+(2*$inc)]; printf "",$entry[$_+(3*$inc)]; printf "",$entry[$_+(4*$inc)]; print "\n"; } print "
%s%s%s%s%s
\n"; print "\n"; print "\n"; mkstandardsgmltable0000775000076400007640000000606011027745372013545 0ustar matsmats#!/usr/bin/perl use Carp; use Getopt::Long; use DBI; use HTML::Entities; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); sub usage() { print STDERR "mkstandardsgmltable -a \n"; die; } sub quote($) { my ($type) = @_; return $type if ($type =~ /^'.*'$/); my @tlist = split(/,/, $type); foreach $t (@tlist) { $t = "'$t'" if ($t !~ /^'.*'$/); } return join(',', @tlist); } # Uncomment to trace SQL statments #$trace=1; # # 1) process the arguments # my $Stype="'Standard','Reference'"; GetOptions( "a=s" => \$archname, "s=s" => \$specids, "x=s" => \$exclids, "t=s" => \$Stype, ); if( !$archname && !$specids ) { usage(); } # # 2) Establish connection to the database # $dbh = DBI->connect('DBI:mysql:database='.$LSBDB.';host='.$LSBDBHOST, $LSBUSER, $LSBDBPASSWD) or die "Couldn't connect to database: ".DBI->errstr; # # 3) get & print the architecture info # if( $archname ) { $select = "SELECT * FROM Architecture WHERE "; $select.= "Architecture.Aname=".$dbh->quote($archname); print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $entry=$sth->fetchrow_hashref; $sth->finish; $Aid=$entry->{'Aid'}; if( not $entry->{'Aname'} ) { die "Unsupported architecture"; } } else { $Aid=0; } # check Stype is quoted properly $Stype = quote($Stype); $select = "SELECT * FROM Standard "; $select.= "WHERE Stype in ($Stype) "; $select.= "AND ( Sarch=$Aid OR Sarch=1 ) "; if( $specids ) { $select.= "AND Sname IN ( $specids ) "; } if( $exclids ) { $select.= "AND Sname NOT IN ( $exclids ) "; } # $select .= "AND Sname != 'LSB' "; $select.= "ORDER BY Sshort"; print STDERR $select,"\n" if $trace; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; printf("\n"); printf("\n"); print "\n"; print ""; print "NameTitleURL"; print ""; print "\n"; print "\n"; for(1..$sth->rows) { $entry=$sth->fetchrow_hashref; print ""; # Don't print the nickname. It may be confusing #printf "%s",$entry->{'Sname'}; printf "%s",makeid($entry->{'Sname'}),$entry->{'Sshort'},$entry->{'Sshort'}; printf "%s", $entry->{'Sfull'}; printf "%s", encode_entities($entry->{'Surl'},"%&"), encode_entities($entry->{'Surl'}); #printf "%s",$entry->{'Sdescription'}; print "\n"; } $sth->finish; $dbh->disconnect; print "\n"; printf("\n"); sub makeid { my ($name) = @_; $name =~ s/\s+/./g; $name =~ s/[^A-Za-z0-9.]+/./g; # finally, remove any repeated . (e.g. "RPC...XDR" which arose from "RPC & XDR") $name =~ s/\.\.+/./g; return $name; } mksynop0000775000076400007640000002220010761554030011205 0ustar matsmats#! /usr/bin/perl # # mksynop # - write out the XML/SGML synopsis for function/interface X # from info in the db. # NB the database does not (currently) hold names for the positional # parameters stored in the Parameter table, so we temporarily # call them "arg1", "arg2" etc # use DBI; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); use strict; use Getopt::Long; my $level = 0; my $dbh; my $lsbversion; my $Aid; my $arch; # # sub indent($) { # function abandoned } # # return content # 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("", $tagname); } else { $retstr .= sprintf("<%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 "" if (!defined ($type) || $type eq "" || $type eq "void"); return "" 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 displaytyperef($) { my ($param) = @_; my($select,$sth,$type); my ($tselect, $tmselect, $Tid, $tmh, $tmentry, $nameonly); my ($tth, $TMtypeid, $th, $entry); my $retval = ""; if( $$param{'Ttype'} eq "Intrinsic" ) { $retval .= $$param{'Tname'}; return $retval; } if( $$param{'Ttype'} eq "Literal" ) { $retval .= $$param{'Tname'}; return $retval; } if( $$param{'Ttype'} eq "Const" ) { $select = "SELECT * FROM Type left join ArchType on ATtid=Tid WHERE Tid=".$$param{'ATbasetype'}." AND ATaid IN (1,$Aid) GROUP BY Tid"; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $type=$sth->fetchrow_hashref; $sth->finish; if( $type->{'Ttype'} eq "Pointer" ) { $retval .= displaytyperef($type); $retval .= "const "; } else { $retval .= "const "; $retval .= displaytyperef($type); } return $retval; } if( $$param{'Ttype'} eq "Pointer" ) { $select = "SELECT * FROM Type left join ArchType on ATtid=Tid WHERE Tid=".$$param{'ATbasetype'}." AND ATaid IN (1,$Aid) GROUP BY Tid"; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $type=$sth->fetchrow_hashref; $sth->finish; $retval .= displaytyperef($type); $retval .= " *"; return $retval; } if( $$param{'Ttype'} eq "Struct" ) { $retval .= "struct ".$$param{'Tname'}; return $retval; } if( $$param{'Ttype'} eq "Typedef" ) { $retval .= $$param{'Tname'}; return $retval; } if( $$param{'Ttype'} eq "Union" ) { $retval .= "union ".$$param{'Tname'}; return $retval; } if( $$param{'Ttype'} eq "Enum" ) { $retval .= "enum ".$$param{'Tname'}; return $retval; } if( $$param{'Ttype'} eq "Array" ) { my $basetype=$$param{'ATbasetype'}; $tselect="SELECT * FROM Type left join ArchType on ATtid=Tid WHERE Tid=$basetype AND ATaid IN (1,$Aid) GROUP BY Tid"; $tth = $dbh->prepare($tselect) or die "Couldn't prepare $tselect query: ".DBI->errstr; $tth->execute or die "Couldn't execute $tselect query: ".DBI->errstr; $type=$tth->fetchrow_hashref; $tth->finish; if( !$nameonly ) { $nameonly=1; $retval .= displaytyperef($type); $nameonly=0; } else { $retval .= displaytyperef($type); } if( $$param{'Tname'} =~ "fptr" ) { $$param{'Tname'} =~ s/fptr-//; } return $retval; } if( $$param{'Ttype'} eq "FuncPtr" ) { $select = "SELECT * FROM Type left join ArchType on ATtid=Tid WHERE Tid=".$$param{'ATbasetype'}." AND ATaid IN (1,$Aid) GROUP BY Tid"; $sth = $dbh->prepare($select) or die "Couldn't prepare $select query: ".DBI->errstr; $sth->execute or die "Couldn't execute $select query: ".DBI->errstr; $type=$sth->fetchrow_hashref; $sth->finish; $Tid=$$param{'Tid'}; $retval .= displaytyperef($type); $retval .= "(*"; if( $$param{'Tname'} =~ "fptr" ) { $$param{'Tname'} =~ s/fptr-//; } #print $$param{'Tname'}; $retval .= ")"; $retval .= "("; $tmselect="SELECT * FROM TypeMember WHERE TMmemberof=$Tid AND TMaid IN (1,$Aid) "; $tmselect.=" ORDER BY TMposition"; $tmh = $dbh->prepare($tmselect) or die "Couldn't prepare $tmselect query: ".DBI->errstr; $tmh->execute or die "Couldn't execute $tmselect query: ".DBI->errstr; if($tmh->rows == 0) { $retval .= "void"; } for(1..$tmh->rows) { $tmentry=$tmh->fetchrow_hashref; $TMtypeid=$tmentry->{'TMtypeid'}; $tselect="SELECT * FROM Type left join ArchType on ATtid=Tid WHERE Tid=$TMtypeid AND ATaid IN (1,$Aid) GROUP BY Tid"; $th = $dbh->prepare($tselect) or die "Couldn't prepare $tselect query: ".DBI->errstr; $th->execute or die "Couldn't execute $tselect query: ".DBI->errstr; $entry=$th->fetchrow_hashref; $th->finish; $nameonly=1; displaytype($entry); #print $tmentry->{'TMname'}; if( $tmentry->{'TMarray'} ) { $retval .= "[".$tmentry->{'TMarray'}."]"; } if( $_ != $tmh->rows ) { $retval .= ","; } $nameonly=0; } $tmh->finish; $retval .= ")\n"; return $retval; } $retval .= $$param{'Ttype'}; return $retval; } sub trim($) { my ($str) = @_; $str =~ s/^ *(.*)$/\1/; $str =~ s/(.*) +$/\1/; return $str; } sub usage() { die "Usage: mksynop -v -a [ ...]\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; 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"; } } # # 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 Type on Tid=Ireturn "; $sql .= "left join ArchInt on Iid=AIint "; $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; my $type = displaytyperef($entry); my $hdr = sprintf("#include <%s>",$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 = sprintf("arg%d", $argno++); my $argtype = displaytyperef($entry); 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; mkusergrpcmds0000775000076400007640000000661111027745425012411 0ustar matsmats#!/usr/bin/perl # # Linux Standard Base, http://www.linuxbase.org/ # George Kraft IV, gk4@us.ibm.com, 03/09/2000 # # use DBI; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); local %references; local %standards; ################################################################################ # lsbOpenDB ################################################################################ sub lsbOpenDB { $dbh = DBI->connect("DBI:mysql:$LSBDB", $LSBUSER, $LSBDBPASSWD); die unless $dbh; $sth = $dbh->prepare( "SHOW TABLES" ); $sth->execute; } ################################################################################ # lsbCloseDB ################################################################################ sub lsbCloseDB { $sth = $dbh->prepare( "SHOW TABLES" ); $sth->execute; $sth->finish; $dbh->disconnect; } ################################################################################ # lsbCommands ################################################################################ sub lsbCommands { $sth = $dbh->prepare("SELECT DISTINCT Command.Cname, Standard.Sid, Standard.Sfull FROM Command left join StandUgCmds on Command.Cid=StandUgCmds.UGCcmd, Standard WHERE StandUgCmds.UGCstand=Standard.Sid AND StandUgCmds.UGClsb='1' ORDER BY Command.Cname"); $sth->execute; if ($sth->rows < 1) { printf("No Commands or Utilities found!\n"); return; } printf("\n"); printf("The behaviour of the interfaces described in this\n"); printf("section are specified by the following Standards."); printf("\n"); printf("\n"); my $i = 0; while (@field = $sth->fetchrow_array) { if (!$standards{$field[1]}) { ++$i; $standards{$field[1]} = $field[2]; $references{$i} = $field[1]; $permutation{$field[1]} = $i; $ref = $i; } else { $ref = $permutation{$field[1]}; } $ftid = sprintf("std-ugc-fn-%s-%s", $field[1], $permutation{$field[1]}); if (!$footer{$ftid}) { $footer{$ftid} = $ref; printf("%s\n", $standards{$field[1]}); printf("\n", $ftid); printf("%s", $standards{$field[1]}); printf("\n"); } } printf("\n"); $sth = $dbh->prepare("SELECT DISTINCT Command.Cname, Standard.Sid, Standard.Sfull FROM Command left join StandUgCmds on Command.Cid=StandUgCmds.UGCcmd, Standard WHERE StandUgCmds.UGCstand=Standard.Sid AND StandUgCmds.UGClsb='1' ORDER BY Command.Cname"); $sth->execute; if ($sth->rows < 1) { printf("No Commands or Utilities found!\n"); return; } printf("\n"); printf("\n"); printf("\n"); printf("\n"); printf("\n"); my $i = 0; while (@field = $sth->fetchrow_array) { $ref = $permutation{$field[1]}; if ($i != 0 && 0 == ($i % 5)) { printf("\n"); } $ftid = sprintf("std-ugc-fn-%s-%s", $field[1], $permutation{$field[1]}); printf("%s\n", $field[0]); printf("\n", $ftid); printf("\n"); ++$i; } printf("\n"); printf("\n"); printf("\n"); printf("
\n"); } ################################################################################ # main ################################################################################ lsbOpenDB; lsbCommands; lsbCloseDB; exit; # EOF mkusergrpint0000775000076400007640000000657211027745456012267 0ustar matsmats#!/usr/bin/perl # # Linux Standard Base, http://www.linuxbase.org/ # George Kraft IV, gk4@us.ibm.com, 03/09/2000 # # use DBI; use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST); local %references; local %standards; ################################################################################ # lsbOpenDB ################################################################################ sub lsbOpenDB { $dbh = DBI->connect("DBI:mysql:$LSBDB", $LSBUSER, $LSBDBPASSWD); die unless $dbh; $sth = $dbh->prepare( "SHOW TABLES" ); $sth->execute; } ################################################################################ # lsbCloseDB ################################################################################ sub lsbCloseDB { $sth = $dbh->prepare( "SHOW TABLES" ); $sth->execute; $sth->finish; $dbh->disconnect; } ################################################################################ # lsbCommands ################################################################################ sub lsbCommands { $sth = $dbh->prepare("SELECT DISTINCT Interface.Iname, Standard.Sid, Standard.Sfull FROM Interface left join StandUgInt on Interface.Iid=StandUgInt.UGIint, Standard WHERE StandUgInt.UGIstand=Standard.Sid AND StandUgInt.UGIlsb='1' ORDER BY Interface.Iname"); $sth->execute; if ($sth->rows < 1) { printf("No Commands or Utilities found!\n"); return; } printf("\n"); printf("The behaviour of the interfaces described in this\n"); printf("section are specified by the following Standards."); printf("\n"); printf("\n"); my $i = 0; while (@field = $sth->fetchrow_array) { if (!$standards{$field[1]}) { ++$i; $standards{$field[1]} = $field[2]; $references{$i} = $field[1]; $permutation{$field[1]} = $i; $ref = $i; } else { $ref = $permutation{$field[1]}; } $ftid = sprintf("std-ugi-fn-%s-%s", $field[1], $permutation{$field[1]}); if (!$footer{$ftid}) { $footer{$ftid} = $ref; printf("%s\n", $standards{$field[1]}); printf("\n", $ftid); printf("%s", $standards{$field[1]}); printf("\n"); } } printf("\n"); $sth = $dbh->prepare("SELECT DISTINCT Interface.Iname, Standard.Sid, Standard.Sfull FROM Interface left join StandUgInt on Interface.Iid=StandUgInt.UGIint, Standard WHERE StandUgInt.UGIstand=Standard.Sid AND StandUgInt.UGIlsb='1' ORDER BY Interface.Iname"); $sth->execute; if ($sth->rows < 1) { printf("No Commands or Utilities found!\n"); return; } printf("\n"); printf("\n"); printf("\n"); printf("\n"); printf("\n"); my $i = 0; while (@field = $sth->fetchrow_array) { $ref = $permutation{$field[1]}; if ($i != 0 && 0 == ($i % 5)) { printf("\n"); } $ftid = sprintf("std-ugi-fn-%s-%s", $field[1], $permutation{$field[1]}); printf("%s\n", $field[0]); printf("\n", $ftid); printf("\n"); ++$i; } printf("\n"); printf("\n"); printf("\n"); printf("
\n"); } ################################################################################ # main ################################################################################ lsbOpenDB; lsbCommands; lsbCloseDB; exit; # EOF