#!/usr/bin/env perl

use strict;

#
# dig the globus and gpt paths out of the user's environment variables
#

my $gpt_path = $ENV{GPT_LOCATION};
my $globus_path = $ENV{GLOBUS_LOCATION};
my $gpath;

if ( !defined($gpt_path) && !defined($globus_path) )
{
    die("ERROR: GPT_LOCATION or GLOBUS_LOCATION needs to be set before running this script");
}

if ( defined($gpt_path) )
{
    $gpath = $gpt_path;
    if ( ! -d $gpath )
    {
        die("ERROR: $gpath doesn't exist!\n");
    }
}

if ( !defined($gpath) && defined($globus_path) )
{
    $gpath = $globus_path;
    if ( ! -d $gpath )
    {
        die("ERROR: $gpath doesn't exist!\n");
    }
}


use Getopt::Long;
use Cwd;
use Config;

#
# do GPT version checking
#

my($environment);
@INC = ("$gpath/lib/perl", "$gpath/lib/perl/$Config{'archname'}", @INC);

if ( defined eval "require Grid::GPT::V1::Package" )
{
    $environment = "gpt2";
}
else
{
    die("ERROR: GPT V1 no longer supported");
}

#
# argument specification
#

my($flavor, $static, $link, @pkgs, $help, $verbose);

GetOptions(
            'flavor=s' => \$flavor,
            'static' => \$static,
            'link=s' => \$link, # deprecated feature
            'pkg=s' => \@pkgs,
            'help|?' => \$help,
          ) or pod2usage(1);

if ( defined($link) && !defined($static) )
{
    if ($link eq "static")
    {
        $static = 1;
    }
}

my($args);

if ( defined($help) )
{
    pod2usage(0);
}

if ( !defined($flavor) )
{
    pod2usage(1);
}

if ( defined(@ARGV) && ($ARGV[0] ne "") )
{
    push(@pkgs, @ARGV);
}
@pkgs = buildMultiArg(@pkgs);

if ( grep(/^ANY$/, @pkgs) )
{
    @pkgs = ("ANY");
}

if ( !defined(@pkgs) || (scalar(@pkgs) == 0) )
{
    @pkgs = ("ANY");
}

$args = {};
$args->{flavor} = $flavor;
$args->{static} = $static;
$args->{pkgs} = \@pkgs;

#
# finish require'ing our include files
#

require Grid::GPT::Installation;
require Grid::GPT::SetupInstallation;
require Grid::GPT::PkgSet;
require Grid::GPT::BuildLine;

#
# begin actual globus-makefile-header gpt 2.0-based code
#

my($common_error) = "(Hint: This error is most commonly caused when no packages of the specified flavor type are installed..)";

#
# get to work
#

main($args);

exit;

#
# subroutines
#

### main( $args )
#
# driver function
#

sub main
{
    my($args) = @_;
    my($header, $hash);
    $header = [];

    getDevLines($header, $args);
    getBuildEnvLines($header);
    getBuildShellTools($header);
    $hash = buildEnvHash($header);
    displayHash($hash);

    exit(0);
}

### buildMultiArg( @exclude )
#
# given a multiargument list, format it
#

sub buildMultiArg
{
    my (@in_arr) = @_;
    my (@out_arr);

    @out_arr = split(/,/, join(',', @in_arr));

    return @out_arr;
}

### getDevLines( $header, $args )
#
# append a globus location's build information to our header array
#

sub getDevLines
{
    my($header, $args) = @_;
    my($installation, $liblines);
    my($cflagslist, $includeslist, $libslist, $pkglibslist);

    #
    # pull out the command-line arguments
    #

    my($flavor, $static, $pkgs);
    $flavor = $args->{flavor};
    $static = $args->{static};
    $pkgs = $args->{pkgs};

    #
    # point our installation object at our globus location
    #

    $installation = new Grid::GPT::Installation(pkgdir => "$globus_path/etc/globus_packages");
    $installation->set_depenv('Build');

    #
    # grab a set of packages that match what we are asked to find
    #

    my $libpkgs = $installation->query_pkgset(pkgnames => $pkgs, flavor => $flavor);
    my $testpkgs = $libpkgs->{pkgs};
    if (!@$testpkgs)
    {
        printf("No packages were found that matched your query!\n");
        exit(1);
    }
    my $libenvs = $libpkgs->get_sorted_buildenvs();
    $liblines = Grid::GPT::BuildLine::create_buildlines($libenvs);

    #
    # pull out the build information
    #

    $cflagslist = $liblines->{'cflags'};
    $includeslist = $liblines->{'includes'};
    $libslist = $liblines->{'libs'};
    $pkglibslist = $liblines->{'pkglibs'};

    if ( defined($static) )
    {
        $pkglibslist = Grid::GPT::BuildLine::convert_static_libs($pkglibslist, $flavor);
        $libslist = Grid::GPT::BuildLine::convert_static_libs($libslist, $flavor);
    }

    #
    # format our output for beauty's sake
    #

    $cflagslist =~ s:\s+: :g;
    $cflagslist =~ s:^\s|\s$::g;

    $includeslist =~ s:\s+: :g;
    $includeslist =~ s:^\s|\s$::g;

    $libslist =~ s:\s+: :g;
    $libslist =~ s:^\s|\s$::g;

    $pkglibslist =~ s:\s+: :g;
    $pkglibslist =~ s:^\s|\s$::g;

    #
    # push all of our entries onto our header array
    #

    push(@$header, "GLOBUS_CFLAGS=\"$cflagslist\"");
    push(@$header, "GLOBUS_INCLUDES=\"-I${globus_path}/include/$flavor $includeslist\"");
    push(@$header, "GLOBUS_LIBS=\"$libslist\"");
    push(@$header, "GLOBUS_LDFLAGS=\"-L${globus_path}/lib\"");
    push(@$header, "GLOBUS_PKG_LIBS=\"$pkglibslist\"");
    push(@$header, "GLOBUS_LIBTOOL=\"$globus_path/sbin/libtool-$flavor\"");
}

### getBuildEnvLines( $header )
#
# grab all of the data in globus-build-env-<flavor>, prepend GLOBUS_ to each entry, and
# add to our header
#

sub getBuildEnvLines
{
    my($header) = @_;
    my($copy);

    open(IN, "$globus_path/libexec/globus-build-env-$flavor.sh") || die "ERROR: Cannot open $globus_path/libexec/globus-build-env-$flavor.sh!\n$common_error\n";

    while (<IN>)
    { 
        if ( /\S/ ) #if not whitespace
        { 
            my $copy=$_;

            # if copy does NOT match an uppercase letter followed by a _ then another uppercase letter 
            # skip PERL, 'cause it's defined in sh-tools too

            if ( ( $copy !~ /^([A-Z]+)_([A-Z]+)/ ) && ( $copy !~ /^PERL/ ) && ( $copy !~ /^#/ ) )
            {
                push(@$header, "GLOBUS_" . $copy);
            }
        }
    }   

    close(IN);
}

### getBuildShellTools( $header )
#
# grab all of the defines from $GL/libexec/globus-sh-tools.sh
#

sub getBuildShellTools
{
    my($header) = @_;
    my($copy);

    open(IN, "$globus_path/libexec/globus-sh-tools-vars.sh") || die "ERROR: Cannot open $globus_path/libexec/globus-sh-tools-vars.sh!\n$common_error\n";

    while (<IN>) 
    {
        if ( /\S/ )
        {
            $copy = $_;

            if ( $copy !~ /^#/ )
            {
                push(@$header, $copy);
            }
        }
    }

    close(IN);
}

### buildEnvHash( $header )
#
# from an array of k/v pairs, build a proper hash of those tuples.
#

sub buildEnvHash
{
    my($header) = @_;
    my($hash, $container, $ordering);
    my($key, $value, @restofstring);
    my($temp);

    $hash = {};
    $hash->{container} = {};
    $hash->{ordering} = [];

    foreach my $i (@$header)
    {
        $container = $hash->{container};
        $ordering = $hash->{ordering};

        ($key, @restofstring) = split(/=/, $i);
  
        if ( $key =~ m/\S/ )
        {
            #
            # we shouldn't have any comments in our hash anyway, but just in case
            #

            if ( $key =~ m/^#/ )
            {
                next;
            }

            if ( !grep(/^$key$/, @$ordering) )
            {
                push(@$ordering, $key);
            }

            #
            # create a value from the rest of the string info
            #

            $value = join("=", @restofstring);
            $value = stripHashValue($value);

            #
            # first match when $value contains something meaningful.  handle the degenerate case
            # next.
            #

            if ( $value =~ m/\S/ )
            {
                $temp = $container->{$key};
                if ( defined($temp) )
                {
                    $container->{$key} = $temp . " " . $value;
                }
                else
                {
                    $container->{$key} = $value;
                }
            }
            else
            {
                if ( !defined($container->{$key}) )
                {
                    $container->{$key} = "";
                }
            }
        }
    }

    return $hash;
}

### stripHashValue( $value )
#
# strip from $value all extraneous information
#

sub stripHashValue
{
    my($value) = @_;

    $value =~ s:\s+: :g;
    $value =~ s:\n+::g;
    $value =~ s:"::g;
    $value =~ s:^\s|\s$::g;

    return $value;
}

### formatHashValue( $value )
#
# properly format $value for use in our hash
#

sub formatHashValue
{
    my($value) = @_;

#    $value =~ s:(.*):"\1":;

    return $value;
}

### displayHash( $hash )
#
# pretty print our hash tree
#

sub displayHash
{
    my($hash) = @_;
    my($container, $ordering);
    my($key, $value);

    $container = $hash->{container};
    $ordering = $hash->{ordering};

    for my $key (@$ordering)
    {
        $value = $container->{$key};

        #
        # we'll assume that $value is already stripped of extraneous info
        #

        $value = stripHashValue($value);
        $value = formatHashValue($value);

        $key =~ s/cross_compiling/CROSS_COMPILING/;
        $value =~ s/\$GLOBUS_FLAVOR_NAME/$flavor/g;

        printf("$key = $value\n");
    }

    printf("\n");
}

### pod2usage( )
#
# our stub usage function in place of Pod::Usage
#

sub pod2usage
{
    my $ex=shift;
    print "Usage: Please specify a build flavor: --flavor=<flavorname>\n";
    print "\tand one or more package names on which you depend, e.g.\n";
    print "\n             globus-makefile-header --flavor=gcc32dbg globus_io\n\n";
    print "\tIf you are linking statically, you can append the --static flag\n";
    print "\tto get a proper list of dependencies.  Otherwise, the dependencies\n";
    print "\twill be printed in shared form.\n";
    exit $ex;
}

### inform( $content, $override )
#
# inform the user of an event
#

sub inform
{
    my ($content, $override) = @_;

    if ( $verbose or defined($override) )
    {
        print "$content\n";
    }
}

### action( $command, $dir )
#
# perform some command and inform the user
#

sub action
{
    my ($command, $dir) = @_;
    my $pwd;
    if (defined $dir) {
        $pwd = cwd();
        inform("[ Changing to $dir ]");
        chdir($dir);
    }

    # Log the step
    inform($command);

    # Perform the step
    my $result = system("$command 2>&1");

    if ($result or $?)
    {
        # results are bad print them out.
        die("ERROR: Command failed\n");
    }

    if (defined $dir)
    {
        inform("[ Changing to $pwd ]");
        chdir($pwd);
    }
}
