#!/usr/bin/perl

#============================================================================

#

# PUBLIC DOMAIN NOTICE

# National Center for Biotechnology Information

#

# This software/database is a "United States Government Work" under the

# terms of the United States Copyright Act. It was written as part of

# the author's official duties as a United States Government employee and

# thus cannot be copyrighted. This software/database is freely available

# to the public for use. The National Library of Medicine and the U.S.

# Government have not placed any restriction on its use or reproduction.

#

# Although all reasonable efforts have been taken to ensure the accuracy

# and reliability of the software and data, the NLM and the U.S.

# Government do not and cannot warrant the performance or results that

# may be obtained by using this software or data. The NLM and the U.S.

# Government disclaim all warranties, express or implied, including

# warranties of performance, merchantability or fitness for any particular

# purpose.

#

# Please cite the author in any work or product based on this material.

#

# ===========================================================================

use IO::Handle;

use IO::File;

use IPC::Open2;

use FileHandle;

my $libname;

my $libvers;

my $GCC = '';

my @files;

sub USAGE() {

print "Usage: $0 -o <lib name> [-v <lib vers file>] <gcc spec> -- <header files>\n";

exit 1;

}

sub file_contents($) {

local $/;

local $_ = shift;

my $fh;

$fh = new IO::File $_, 'r' or die "can't open $_ for read";

undef $/;

$_ = <$fh>;

undef $fh;

return $_;

}

sub process_args() {

my $i;

for ($i = 0; $i < scalar(@ARGV); ++$i) {

$_ = $ARGV[$i];

last unless /^-(.)/;

if ($1 eq 'o') {

$libname = $ARGV[++$i];

}

elsif ($1 eq 'v') {

$_ = $ARGV[++$i];

$_ = file_contents($_);

chomp;

warn "vers file is empty" if /^$/;

if (/(\d+)\.(\d+)\.(\d+)/) {

$libvers = "$1.$2";

}

else {

warn "'$_' is not a valid version";

}

}

else {

USAGE;

}

}

# USAGE unless $libname;

for ( ; $i != scalar(@ARGV); ++$i) {

$_ = $ARGV[$i];

last if $_ eq '--';

$GCC .= "$_ ";

}

for (++$i; $i != scalar(@ARGV); ++$i) {

push @files, $ARGV[$i];

}

}

sub next_token($) {

local $_;

my $src = shift;

if ($src =~ /^(\s*)/) {

$src = substr $src, length($1);

}

if ($src =~ /^([^ ]+)/) {

$_ = $1;

if (/^([A-Za-z_][A-Za-z0-9_]+)/) {

$_ = $1;

$src = substr $src, length($_);

return ($src, 'ident', $_);

}

else {

$_ = substr $src, 0, 1;

$src = substr $src, 1;

return ($src, 'unknown', $_);

}

}

return ($src, undef, undef);

}

my $id;

my $pt_st = 0;

my $visibility = 'extern';

sub process_token($$) {

my $type = shift;

my $tok = shift;

if ($tok eq ';' || $tok eq ',') {

if (($pt_st == 4 || $pt_st == 5) && $visibility eq 'extern') {

if ($id) {

print "\t$id\n";

}

}

$id = undef;

if ($tok eq ';') {

$pt_st = 0;

$visibility = 'extern';

}

return;

}

if ($pt_st == 0) {

unless ($type eq 'ident') {

$pt_st = 1;

return;

}

if ($tok eq 'extern' || $tok eq 'static') {

$visibility = $tok;

}

elsif ($tok eq 'typedef') {

$pt_st = 1;

}

else {

if ($tok eq 'const' || $tok eq 'volatile') {

$pt_st = 2;

}

else {

$pt_st = ($tok eq 'struct' || $tok eq 'class' || $tok eq 'union' || $tok eq 'enum') ? 3 : 4;

}

}

return;

}

if ($pt_st == 1) {

return;

}

if ($pt_st == 2) {

unless ($type eq 'ident') {

$pt_st = 1;

return;

}

$pt_st = ($tok eq 'struct' || $tok eq 'class' || $tok eq 'union' || $tok eq 'enum') ? 3 : 4;

return;

}

if ($pt_st == 3) {

unless ($type eq 'ident') {

$pt_st = 1;

return;

}

$pt_st = 4;

return;

}

if ($pt_st == 4) {

if ($tok eq '__attribute__') {

$pt_st = 5;

return;

}

$id = $tok if $type eq 'ident';

return;

}

if ($pt_st == 5) {

return;

}

warn 'unpossible';

}

my $level = 0;

sub parse($$);

sub parse($$) {

my $src = shift;

my $end = shift;

my $tok;

my $type;

++$level;

while (($src, $type, $tok) = next_token($src), defined($tok)) {

last if ($tok eq $end);

process_token($type, $tok) if ($level == 1);

$src = parse($src, ')') if ($tok eq '(');

$src = parse($src, '}') if ($tok eq '{');

$src = parse($src, ']') if ($tok eq '[');

}

--$level;

return $src;

}

sub process_files() {

my $gcc_out;

my $gcc_in;

my $src = '';

open2($gcc_in, $gcc_out, "$GCC") or die "can't run preprocessor $GCC";

foreach (@files) {

next unless $_;

$_ = file_contents($_);

next unless $_;

s/^\#include\s.+$//gm unless /weak\.h/;

$gcc_out->print($_);

}

undef $gcc_out; # else gcc won't produce output

while ($_ = <$gcc_in>, defined($_)) {

next if /^\s*$/;

next if /^#/;

chomp;

$src .= " $_";

}

return $src;

}

process_args;

USAGE unless $GCC;

USAGE unless scalar(@files);

if (defined $libname) {

print "LIBRARY $libname\n";

print "VERSION $libvers\n" if $libvers;

print "EXPORTS\n";

}

parse(process_files(), '');

exit 0;