#!/usr/bin/env perl
use strict;
use File::Basename;
use Env qw ( @LD_LIBRARY_PATH );
#
# Create tops dynamically loadable shared objects.
# Albert Danial    March 21 2003
#
# Oct 16 2004:  Still don't have the correct switches to allow a function
# in one .tx file to invoke a function in another .tx file.
#

my $compiler = "gcc";
my $script   = basename $0;
my $TOPS     = figure_out_tops_path();

die "Usage:  $script  [compiler switches] <C file>  [.o file(s), -I<path>, -L<path>, -l<lib>]
                Creates a tops dynamically loadable shared object.
                The shared object will have a .tx extension.
                Current settings: 
                   compiler        = $compiler
                   tops source dir = $TOPS

" unless scalar @ARGV;
my $compile_opt = "";
my $link_opt    = "";
my $fullname    = "";
foreach (@ARGV) {
    if      (/^-I/)  {            # -I; needed for compiling
        $compile_opt .= "$_ ";
    } elsif (/^-L/i) {            # -L or -l; needed for linking
        $link_opt    .= "$_ ";
    } elsif (/\.[ao]$/) {         # object code needed for linking
        $link_opt    .= "$_ ";
    } elsif (/\.[c]$/) {          # the main C code
        $fullname     =  $_;
    } else {                      # everything else for compiling
        $compile_opt .= "$_ ";
    }
}

die "$script:  bad extension on $fullname; expecting .c extension" 
    unless  $fullname =~ /\.c$/;

my $rootname = basename $fullname;     # eg:  fullname=abc/def/ghi.c  rootname=ghi
$rootname =~ s/\.c$//;
validate_function_name($fullname, $rootname);
unlink "$rootname.tx" if -r "$rootname.tx";

my $command = 
      "$compiler $compile_opt -Isrc -fPIC -I$TOPS/src -c $fullname";
# print  $command, "\n";
system $command;
die "Unable to produce object file from $fullname" unless -r "$rootname.o";
$command = "$compiler -shared -o $rootname.tx $rootname.o $link_opt";

# segfault:
#$command = "$compiler -Wl,-rpath -shared -o $rootname.tx $rootname.o $link_opt";
# $command = "$compiler -s -shared -rdynamic -o $rootname.tx $rootname.o $link_opt";
print  $command, "\n";
system $command;

if (-r "$rootname.tx") {
    print "Created $rootname.tx";
    unlink "$rootname.o";
} else {
    die "Failed to create .tx file from $fullname";
}

if (@LD_LIBRARY_PATH) {
    print "; tops will look for it in one of these directories:\n";
    print "    ", join(", ", @LD_LIBRARY_PATH), "\n";
} else {
    print "\n\n  WARNING!\n\n";
    print "  LD_LIBRARY_PATH is null.  $rootname.tx will only be loaded\n";
    print "  dynamically if LD_LIBRARY_PATH is defined as one or more\n";
    print "  directories and the file $rootname.tx is placed in one of\n";
    print "  those directories.  In bash/ksh/sh, set LD_LIBRARY_PATH\n";
    print "  like this:\n";
    print "     export LD_LIBRARY_PATH=/home/topsuser/txdir:.:/opt/tops/tx\n\n";
}

sub validate_function_name { # {{{1
    my ($file, $rootname, ) = @_;
    # Make sure the C function contained within the file has the
    # same name as the file itself.
    # Example:  the file hello.c should have a declaration "int hello()"
    my $found_it = 0;
    open  IN, $file or die "Cannot read $file:  $!\n";
    while (<IN>) {
        next if /^\s*$/; # skip blank lines
        next if /^\s*#/; #      pragma's
        if (/^\s*int\s+(\w+)\s*\(\s*\)/) {
            $found_it = 1 if $1 eq $rootname;
        }
    }
    close IN;
    die "Unable to find 'int $rootname()' function definition\n" unless $found_it;
    return;
} # 1}}}
sub figure_out_tops_path { # {{{1
    my $TOPS = ".";  # default = current directory
    if      (defined $ENV{TOPS_SYSPATH}) {
        $TOPS = $ENV{TOPS_SYSPATH};
        $TOPS =~ s{sys/*$}{};
    } elsif (defined $ENV{TOPS_USRPATH}) {
        $TOPS = $ENV{TOPS_USRPATH};
        $TOPS =~ s{usr/*$}{};
    } elsif (defined $ENV{TOPS_HOME}) {
        $TOPS = $ENV{TOPS_HOME};
    } elsif (-r "$ENV{HOME}/.topsrc") {
        open  IN, "$ENV{HOME}/.topsrc" or return $TOPS;
        while (<IN>) {
            next unless /^\s*TOPS_(USR)?PATH\s+(\S+)\s*$/;
            $TOPS = $2;
            $TOPS =~ s{(usr|sys)/*$}{};
        }
        close IN;
    }
    return $TOPS;
} # 1}}}
