#!/usr/bin/perl

use CGI;
use Mysql;
use Getopt::Long;

use Env qw(LSBUSER LSBDBPASSWD LSBDB LSBDBHOST);

sub usage()
{
    print STDERR "Usage: mkfunclist -v <lsbversion>\n";
die;
}

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

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

sub getinterfacename($)
{
local($Iid)=@_;
my($select,%entry);

if( $Iid eq "" ) {return "";}

if( $intname[$Iid] ) { return $intname[$Iid]; }

#print STDERR "Looking for Iname for $Iid\n";

$select = "SELECT Iname FROM Interface ";
$select.= "WHERE Iid=$Iid";
$isth = $Dbh->query($select) || die $Dbh->errmsg();
%entry=$isth->fetchhash;
$intname[$Iid] = $entry{'Iname'};
return $entry{'Iname'};
}

sub getinterfacevisibility($)
{
local($Iid)=@_;
my($select,%entry);

if( $Iid eq "" ) {return "";}

if( $intvisibility[$Iid] ) { return $intvisibility[$Iid]; }

$select = "SELECT Isrcbin FROM Interface ";
$select.= "WHERE Iid=$Iid";
$isth = $Dbh->query($select) || die $Dbh->errmsg();
%entry=$isth->fetchhash;
$intvisibility[$Iid] = $entry{'Isrcbin'};
return $entry{'Isrcbin'};
}

sub mkclassinfo($$$)
{
local($LIB,$libname,$class)=@_;
my($select,%entry);

$classbase=$$class{'CIname'};
$classbase=~s/_Z//;

# This check is not a good idea - Qt3 and Qt4 have a lot of similar classes
# if( $seenclass{$classbase} ) {
# 	die "Already seen $classbase\n";
# 	}
$seenclass{$classbase}=1;
		
#
# Output array of BaseTypes entries
#
$typeinfoname="_".$classbase."_of_".$libname."_typeinfo";

$select = "SELECT * FROM BaseTypes ";
$select.= "WHERE BTcid=".$$class{'CIid'}." ";
$select.= "ORDER BY BTpos";

#print $select;

print $LIB "char *".$typeinfoname."_name[] = {\n";
$vsth = $Dbh->query($select) || die $Dbh->errmsg();
$numtypeinfofuns=0;
#for(1..$$class{'CInumbasetype'}) {
if( $$class{'CInumbasetype'} == '1' ) {
	%entry=$vsth->fetchhash;
	print $LIB "\t\"".getinterfacename($entry{'BTrttiid'})."\",\n";
	$numtypeinfofuns++;
}
print $LIB "\t};\n\n";

#
# Output typeinfo here.
#
print $LIB "struct classtypeinfo $typeinfoname = {\n";
print $LIB "\t\"".getinterfacename($$class{'CIbasevtable'})."\",\n";
print $LIB "\t\"_ZTS".$classbase."\",\n";
print $LIB "\t".$typeinfoname."_name,\n";
print $LIB "\t};\n\n";

foreach my $pos ( 0..$$class{'CInumvtab'}-1) {
#
# Output array of Vtable entries
#
$vtablename="_".$classbase."_of_".$libname."_vtable";

$select = "SELECT Vtable.*,Architecture.*,Interface.Iid,Interface.Iname,ArchInt.AIarch FROM Vtable ";
$select.= "LEFT JOIN Architecture ON Aid=VTarch ";
$select.= "LEFT JOIN Interface ON Iid=VTviid ";
$select.= "LEFT JOIN ArchInt ON Iid=AIint ";
$select.= "WHERE VTcid=".$$class{'CIid'}." ";
$select.= "AND VTvtpos=$pos ";
$select.= "AND (AIarch IS NOT NULL OR Iname IS NULL) "; # Iname here looks like a hack...
# $select.= "AND AIarch = VTarch ";
$select.= "ORDER BY VTpos";

print $LIB "const char *".$vtablename."_name_$pos [] = {\n";
$vsth = $Dbh->query($select) || die $Dbh->errmsg();
for(1..$vsth->numrows) {
	%entry=$vsth->fetchhash;
	if( $entry{'VTarch'} != $entry{'AIarch'} ) {
	    # it's an arch mismatch only if the second join above worked...
	    if( $entry{'Iname'} eq "" ) {
			print STDERR "Interface ".$entry{'VTviid'}." referenced by ";
			print STDERR "vtable for class ".$entry{'VTcid'}." missing\n";
	    }
		else {
		#   This is a normal situation, since one entry from Interface table can be assigned to more
		#   than one architecture. Maybe it would be better to correct the 'select' above
		#	print STDERR "Arch mismatch for class ".$entry{'VTcid'}.":".$entry{'VTarch'}."!=".$entry{'AIarch'};
		#	print STDERR ":".$entry{'Iname'}."(".$entry{'VTviid'}.")\n";
			next;
	    }
	} 
	if( $entry{'Aname'} eq "All" ) {
		if( $entry{'Iid'} ) {
			$selectNotGeneric = "SELECT AIarch FROM ArchInt ";
			$selectNotGeneric.= "WHERE AIint=$entry{'Iid'} AND AIarch<>1";
			$sthNotGeneric = $Dbh->query($selectNotGeneric) || die $Dbh->errmsg();
			
			# Some architecture specific records found - don't check generic information
			if( $sthNotGeneric->numrows ) {
				next;
			}
		}
		
		$visibility = getinterfacevisibility($entry{'VTviid'});
		if( $visibility eq "SrcOnly" ) {
		    print $LIB "\t\"NULL or ".getinterfacename($entry{'VTviid'})."\",\n";
		}
		else {
		print $LIB "\t\"".getinterfacename($entry{'VTviid'})."\",\n";
		}
	} else {
		print $LIB "#if ".$entry{'Asymbol'}."\n";
		
		$visibility = getinterfacevisibility($entry{'VTviid'});
		if( $visibility eq "SrcOnly" ) {
		    print $LIB "\t\"NULL or ".getinterfacename($entry{'VTviid'})."\",\n";
		}
		else {
		print $LIB "\t\"".getinterfacename($entry{'VTviid'})."\",\n";
		}
		
		print $LIB "#endif\n";
	}
}
print $LIB "\t};\n\n";

} # $$class{'CInumvtab'}

#
# Output classvtable here.
#
print $LIB "struct classvtable $vtablename [".$$class{'CInumvtab'}."] = {\n";

foreach my $pos ( 0..$$class{'CInumvtab'}-1) {
print $LIB "\t{\n";

#vcall offset are architecture sensitive
$select = "SELECT * FROM ClassVtab ";
$select.= "LEFT JOIN ArchClass ON CVpos=ACpos AND CVcid=ACcid ";
$select.= "LEFT JOIN Architecture ON Aid=ACaid ";
$select.= "WHERE ACcid=".$$class{'CIid'}." ";
$select.= "AND CVpos=$pos ";
$vsth = $Dbh->query($select) || die $Dbh->errmsg();
die "No ClassVtabs for ".$$class{'CIid'}." at position $pos\n" if( $vsth->numrows == 0 );
$category=0;
$rttiid=0;
for(1..$vsth->numrows) {
	%entry=$vsth->fetchhash;
	if( $entry{'Aname'} eq "All" ) {
		if( $vsth->numrows != 1 ) {
			printf STDERR "vcall offset for All, but more than one entry: ".$$class{'CIname'}."\n";
		}
		print $LIB "\t".$entry{'ACvoffset'}.",\n";
		print $LIB "\t".$entry{'ACbaseoffset'}.",\n";
	} else {
		print $LIB "#if ".$entry{'Asymbol'}."\n";
		print $LIB "\t".$entry{'ACvoffset'}.",\n";
		print $LIB "\t".$entry{'ACbaseoffset'}.",\n";
		print $LIB "#endif\n";
	}
	$category=$entry{'CVclass'};
	$rttiid=$entry{'CVrtti'};
}

print $LIB "\t".$category.",\t/* Vtable category */\n";
print $LIB "\t".$entry{'CVnumvtfuncs'}.",\t/* Number of Vfuncs */\n";
print $LIB "\t\"".getinterfacename($rttiid)."\",\n";
print $LIB "\t".$vtablename."_name_$pos,\n";
print $LIB "\t},\n";

} # $$class{'CInumvtab'}
print $LIB "};\n\n";

#
# Output base info type here.
#
$baseinfoname="_".$classbase."_of_".$libname."_baseinfo";

$select = "SELECT * FROM VMIBaseTypes ";
$select.= "LEFT JOIN Architecture ON Aid=VBTaid ";
$select.= "WHERE VBTcid=".$$class{'CIid'}." ";
$select.= "ORDER BY VBTpos";

#print $select;

print $LIB "struct base_type_info ".$baseinfoname."[] = {\n";
$vsth = $Dbh->query($select) || die $Dbh->errmsg()."$select\n";
for(1..$vsth->numrows) {
	%entry=$vsth->fetchhash;
	if (not $entry{'Aname'}) {
		next; # unsupported architecture found
	}
	
	if( $entry{'Aname'} eq "All" ) {
		print $LIB "\t{\"".getinterfacename($entry{'VBTbasetype'})."\",";
		print $LIB "\t".$entry{'VBTflags'}."U},\n";
	} else {
		print $LIB "#if ".$entry{'Asymbol'}."\n";
		print $LIB "\t{\"".getinterfacename($entry{'VBTbasetype'})."\",";
		print $LIB "\t".$entry{'VBTflags'}."U},\n";
		print $LIB "#endif\n";
	}
}
print $LIB "\t};\n\n";

print $LIB "struct classinfo ".$$class{'CIname'}."_of_".$libname."_classinfo = {\n";
print $LIB "\t\"".$$class{'CIname'}."\",\n";
print $LIB "\t\"".getinterfacename($$class{'CIvtable'})."\",\n";
print $LIB "\t\"".getinterfacename($$class{'CIrtti'})."\",\t/* RTTI */\n";
print $LIB "\t\"".getinterfacename($$class{'CIbase'})."\",\n";
print $LIB "\t\"_ZTT".$classbase."\",\t/* VTT */\n";
print $LIB "\t".$$class{'CInumvtab'}.",\n";
print $LIB "\t$numtypeinfofuns,\n";
print $LIB "\t".$$class{'CInumvmitypes'}.",\n";
print $LIB "\t".$$class{'CInumvtt'}.",\t/* numVTT */\n";
print $LIB "\t".$$class{'CIflags'}."U,\n";
print $LIB "\t&$typeinfoname,\n";
print $LIB "\t$vtablename,\n";
print $LIB "\t$baseinfoname,\n";
print $LIB "\t};\n\n";
}

sub mklibsyms($$)
{
local($libname,$lid)=@_;

$select = "SELECT DISTINCT * FROM Interface ";
$select.= "INNER JOIN LGInt on Iid=LGIint ";
$select.= "INNER JOIN LibGroup ON LGIlibg=LGid ";
$select.= "LEFT JOIN ArchInt ON AIint=Iid ";
$select.= "LEFT JOIN Architecture ON Aid=AIarch ";
$select.= "LEFT JOIN Version ON Vid=AIversion ";
$select.= "LEFT JOIN ArchType ON ATtid=Ireturn AND ATaid=Aid ";
$select.= "LEFT JOIN ModLib ON MLlid=LGlib ";
$select.= "LEFT JOIN Module ON MLmid=Mid ";
$select.= "WHERE LGlib=$lid ";
$select .= "AND (AIappearedin <= '$lsbversion' and AIappearedin<>'') ";
$select .= "AND (AIwithdrawnin IS NULL OR AIwithdrawnin >'$lsbversion') ";
$select.= "AND ( AIarch != 8 ) "; # 8 == None
$select.= "ORDER BY Iname,Aid ";

#print $select;

$lsth = $Dbh->query($select) || die $Dbh->errmsg();

open(LIB,">$libname.c");
open(TXT,">$libname.txt");
print LIB "#include <stdlib.h>\n";
print LIB "#include \"elfchk.h\"\n";
print LIB "struct versym ".$libname."[] = {\n";

$numsyms=0;
$lastname="";
for(1..$lsth->numrows) {
	%entry=$lsth->fetchhash;
	if( $entry{'Iname'} ne $lastname ) {
		$numsyms++;
		$lastname=$entry{'Iname'};
		}
	if( $entry{'ATsize'} eq "" ) { $entry{'ATsize'}=0;}
	if( $entry{'Aid'} && $entry{'Aname'} ne 'All' ) {
		print LIB "#if $entry{'Asymbol'}\n";
		printf LIB "\t{\"%s\",\"%s\",",$entry{'Iname'},$entry{'Vname'};
		printf LIB "0,%s,%s,",$entry{'Mname'},$entry{'ATsize'};
		if( $entry{'Itype'} eq "Data" ) {
			print LIB "0";
		} else {
			print LIB "1";
		}
		printf LIB "},\n";
		print LIB "#endif\n";
	} else {
		if( $entry{'Aid'} && $entry{'Aname'} eq 'All' ) {
			if( $entry{'Iid'} ) {
				$selectNotGeneric = "SELECT AIarch FROM ArchInt ";
				$selectNotGeneric.= "WHERE AIint=$entry{'Iid'} AND AIarch<>1";
				$sthNotGeneric = $Dbh->query($selectNotGeneric) || die $Dbh->errmsg();
	
				# Some architecture specific records found - don't check generic information
                    if ($sthNotGeneric->numrows) {
					next;
				}
			}
		}
		printf LIB "\t{\"%s\",\"%s\",",$entry{'Iname'},$entry{'Vname'};
		printf LIB "0,%s,%s,",$entry{'Mname'},$entry{'ATsize'};
		if( $entry{'Itype'} eq "Data" ) {
			print LIB "0";
		} else {
			print LIB "1";
		}
		printf LIB "},\n";
		printf TXT $entry{'Iname'}."\n";
	}
}
print LIB "\t{0,0}};\n\n";

print "$numsyms symbols\n";

#
# Now, look for class data that me be present
#
$select = "SELECT DISTINCT * FROM ClassInfo ";
$select.= "LEFT JOIN ArchClass ON ACcid=CIid ";
$select.= "LEFT JOIN LibGroup ON LibGroup.LGid=CIlibg ";
$select.= "LEFT JOIN Library ON LibGroup.LGLIB=Library.Lid ";
$select.= "WHERE Library.Lid=$lid ";
$select.= "AND ACappearedin<>'' AND ACappearedin <= '$lsbversion' ";
$select.= "AND (ACwithdrawnin IS NULL OR ACwithdrawnin > '$lsbversion') ";
$select.= "AND CInumvtab > 0 ";
$select.= "GROUP BY ACcid";
#$select.= "AND CIname LIKE '_ZSd'";

#print $select."\n";

$lsth = $Dbh->query($select) || die $Dbh->errmsg();
$classinfos="";
for(1..$lsth->numrows) {
	%entry=$lsth->fetchhash;
	#print $_.":".$entry{'CIname'}."\n";
	mkclassinfo(LIB,$libname,\%entry);
	$classinfos.=$classinfo."\t&".$entry{'CIname'}."_of_".$libname."_classinfo,\n";
}

print LIB "struct classinfo *".$libname."_classinfo[] = {\n";
print LIB $classinfos."\n\tNULL\t};\n";

close(TXT);
close(LIB);
}

#
# 2) Establish connection to the database
#

$Dbh = Mysql->connect($LSBDBHOST,$LSBDB,$LSBUSER, $LSBDBPASSWD) || die $Mysql::db_errstr;

#
# 3) Get the list of libs, and process them
#

open(LSB_VER, ">lsb_ver.c");
print LSB_VER "char* LSB_Version_str = \"$lsbversion\";\n";
close(LSB_VER);

open(LIBS,">libs.c");
print LIBS "/* Generated file */\n";
print LIBS "#include <unistd.h>\n";
print LIBS "#include \"libs.h\"\n";
print LIBS "#include \"libchk.h\"\n\n";
print LIBS "#include \"../tetj/tetj.h\"\n\n";

print LIBS "struct modlib modlibs [] = {\n";

open(LIBSH,">libs.h");
print LIBSH "/* Generated file */\n";
print LIBSH "#include \"../elfchk/elfchk.h\"\n\n";

open(MAKE,">libs.mk");
print MAKE "# Generated file #\n";
print MAKE "LIBOBJS = \\\n";

$select = "SELECT DISTINCT Mname,Lid,ALrunname,Asymbol,Aname FROM Module ";
$select.= "LEFT JOIN ModLib ON MLmid=Mid ";
$select.= "LEFT JOIN Library ON Lid=MLlid ";
$select.= "LEFT JOIN ArchLib ON ALlid=Lid ";
$select.= "LEFT JOIN Architecture ON ALaid=Aid ";
$select.= "WHERE ( (ALappearedin <= '$lsbversion' and ALappearedin<>'') ";
$select.= "AND (ALwithdrawnin IS NULL OR ALwithdrawnin > '$lsbversion') ) ";
$select.= "AND Aname!='None' ";
#$select.= "AND Lname='libstdcxx' ";
$select.= "ORDER BY ALrunname,Aid DESC ";

#print "$select\n";

$sth = $Dbh->query($select) || die $Dbh->errmsg();

for(1..$sth->numrows) {
	%entry=$sth->fetchhash;
	if( !$entry{'ALrunname'} ) {
		next;
		}
	$modname=$entry{'Mname'};
	$libname=$entry{'ALrunname'};
	$asym=$entry{'Asymbol'};
	$libname =~ s/\./_/g;
	$libname =~ s/-/_/g;
	$libname =~ s/\+/x/g;
	#$libname =~ s/\//_/g;
	@libname = split('/',$libname);
	$libname = pop(@libname);
	if( $asym != "1" ) {
		print LIBS "#if $asym\n";
		print LIBS "\t{$modname,\"".$entry{'ALrunname'}."\",$libname,".$libname."_classinfo},\n";
		print LIBS "#endif\n";
		print LIBSH "#if $asym\n";
		print LIBSH "extern struct versym ".$libname."[];\n";
		print LIBSH "extern struct classinfo ".$libname."_classinfo[];\n";
		print LIBSH "#endif\n";
	} else {
		if( !$seenit{$libname} ) {
			print LIBS "\t{$modname,\"".$entry{'ALrunname'}."\",$libname,".$libname."_classinfo},\n";
			print LIBSH "extern struct versym ".$libname."[];\n";
			print LIBSH "extern struct classinfo ".$libname."_classinfo[];\n";
			}
	}
	if( !$seenit{$libname} ) {
		print MAKE "\t$libname.o \\\n";
		$seenit{$libname}=1;
		print "Making $libname\n";
		mklibsyms($libname,$entry{'Lid'});
		}
}

print LIBS "{0,NULL,NULL,NULL}\n";
print LIBS "};\n";
close(LIBS);
close(LIBH);
close(MAKE);
