libglobus-common-dev 14.5-1 / usr / bin / globus-makefile-header

#! /usr/bin/perl

# 
# Copyright 1999-2006 University of Chicago
# 
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
# 
# http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# 


my ($prefix, $exec_prefix, $libdir, $perlmoduledir);
my ($sbindir, $bindir, $includedir, $datarootdir,
    $datadir, $libexecdir, $sysconfdir, $sharedstatedir,
    $localstatedir, $aclocaldir);
BEGIN
{
    if (exists $ENV{GLOBUS_LOCATION})
    {
        $prefix = $ENV{GLOBUS_LOCATION};
    }
    else
    {
        $prefix = "/usr";
    }

    $exec_prefix = "${prefix}";
    $libdir = "${exec_prefix}/lib";
    $sbindir = "${exec_prefix}/sbin";
    $bindir = "${exec_prefix}/bin";
    $includedir = "${prefix}/include/globus";
    $datarootdir = "${prefix}/share";
    $datadir = "${datarootdir}";
    $perlmoduledir = "/usr/share/perl5";
    $libexecdir = "${datadir}/globus";
    $sysconfdir = "/etc";
    $sharedstatedir = "/var/lib";
    $localstatedir = "/var";
    $aclocaldir = "${datadir}/globus/aclocal";

    if (exists $ENV{GPT_LOCATION})
    {
        unshift(@INC, "$ENV{GPT_LOCATION}/lib/perl");
    }

    unshift(@INC, "${perlmoduledir}");
}

use strict;
use Globus::Core::Paths;
use Getopt::Long;
use Cwd;

#
# do GPT version checking
#

my($environment);

if ( defined eval "require Grid::GPT::V1::Package" )
{
    $environment = "gpt2";
}
else
{
    print "globus-makefile-header requires the GPT perl module.\n";
    print "If you want to use it you have to install the grid-packaging-tools package.\n";
    print "Consider using alternatives like pkg-config instead.\n";

    exit 1;
}

#
# 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 ( @ARGV && ($ARGV[0] ne "") )
{
    push(@pkgs, @ARGV);
}
@pkgs = buildMultiArg(@pkgs);

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

if ( !@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);
    if(!($hash->{container}->{GLOBUS_LD}))
    {
        $hash->{container}->{GLOBUS_LD} = $hash->{container}->{GLOBUS_CC};
        my $ordering=$hash->{ordering};
        push (@$ordering, "GLOBUS_LD");
    }
    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, $extlibslist);

    #
    # 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::Core::Paths::datadir/globus/packages");
    $installation->set_depenv('Build');

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

    my $verpkgs;

    $verpkgs = $installation->query_pkgset(pkgnames => $pkgs, flavor => $flavor, pkgtype => 'dev');
    for my $l(@{$verpkgs->{'pkgs'}})
    {
        my $vername=$l->{'depnode'}->{'Name'};
        $vername =~ tr/a-z/A-Z/;
        my $vernum = $l->{'depnode'}->{'Version'}->{'major'}."."
            .$l->{'depnode'}->{'Version'}->{'minor'}."." 
            .$l->{'depnode'}->{'Version'}->{'age'};

        push(@$header, $vername."_VERSION= ".$vernum."\n");
    }

    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'};
    $extlibslist = $liblines->{'extlibs'};

    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;
    $cflagslist =~ s:\\::g;

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

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

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

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


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

    push(@$header, "GLOBUS_CFLAGS=\"$cflagslist\"");
    push(@$header, "GLOBUS_INCLUDES=\"-I$Globus::Core::Paths::includedir -I$Globus::Core::Paths::flavorincludedir $includeslist\"");
    push(@$header, "GLOBUS_LIBS=\"$libslist\"");
    push(@$header, "GLOBUS_LDFLAGS=\"-L$Globus::Core::Paths::libdir\"");
    push(@$header, "GLOBUS_PKG_LIBS=\"$pkglibslist $extlibslist\"");
}

### 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) = @_;

    open(IN, "/bin/sh $Globus::Core::Paths::libexecdir/globus-build-env-$flavor.sh makefile-header|") || die "ERROR: Cannot open $Globus::Core::Paths::libexecdir/globus-build-env-$flavor.sh!\n$common_error\n";

    push(@$header, <IN>);

    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::Core::Paths::libexecdir/globus-sh-tools-vars.sh") || die "ERROR: Cannot open $Globus::Core::Paths::libexecdir/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);

        if ($key =~ /cross_compiling/ ) {
            $value =~ s/CROSS/GLOBUS_CROSS/;
        }
        $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);
    }
}