#!/usr/bin/perl

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell

use strict;
use Carp;
use Getopt::Long;
use Cwd;
use Config;

#
# Do a perl check for version >= 5.005.  See 'gpt-translate-interpreter' should you
# need to alter the invocation path to a valid perl interpreter in the GPT front-end
# programs.
#

if ( ! ( defined eval "require 5.005" ) )
{
    die "GPT requires at least Perl version 5.005";
}

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

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

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

if ( defined($gpt_path) )
{
    $gpath = $gpt_path;
}

if ( defined($globus_path) && !defined($gpath) )
{
    $gpath = $globus_path;
}

if ( ! -d "$globus_path/etc/globus_packages" )
{
    die("Can't find a globus_packages directory to work on in your GLOBUS_LOCATION!\n");
}

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

if ( ! ( defined eval "require Grid::GPT::GPTObject" ) )
{
    die("$gpath does not appear to hold a valid GPT installation\n");
}

require Pod::Usage;

my($force, $error, $version, $help, $man, $location);

# sub pod2usage {
#   my $ex = shift;
#   print "gpt-postinstall [-help -force -version]\n";
#   exit $ex;
# }

GetOptions( 'force'      => \$force,
            'version'    => \$version,
            'help|?'     => \$help,
            'location=s' => \$globus_path, 
            'man'        => \$man)
  or Pod::Usage::pod2usage(0);

Pod::Usage::pod2usage(1) if $help;
Pod::Usage::pod2usage(-verbose => 2) if $man;

require Grid::GPT::GPTIdentity;
Grid::GPT::GPTIdentity::print_gpt_version() if defined $version;

require Grid::GPT::Installation;
require Grid::GPT::SetupInstallation;
require Grid::GPT::PackageFactory;

my @postpkgs;
my %postcommands;

my $locations = new Grid::GPT::Locations( installdir => $globus_path );
my $installation = new Grid::GPT::Installation(locations => $locations);
my $setupinstallation = new Grid::GPT::SetupInstallation(locations => $locations);


## my $installation = new Grid::GPT::Installation(pkgdir => "$globus_path/etc/globus_packages");
## my $setupinstallation = new Grid::GPT::SetupInstallation(pkgdir => "$globus_path/etc/globus_packages");

my $list = $installation->setup_pkgs();

@$list = grep {$_->pkgtype() =~ m!pgm! } @$list;

if ( !defined($force) )
  {
    $list = $setupinstallation->check_for_setup_needs(pkgs => $list);
  }

my @setupcommands;
my $setupcmd;
my $depnode;

my $pkgset = new Grid::GPT::PkgSet;

#
# our first pass checks for collisions against the post install program.  it
# only adds packages to our package set that require post install programs which
# we haven't seen yet be run.
#

for my $l (@$list)
  {
    #            $l->printnode();
    
    $setupcmd = trimSetupCommand($l->{'depnode'}->{'Post_Install_Program'});
    
    if ( ! grep(/^$setupcmd$/, @setupcommands) )
      {
        $depnode = $l->{'depnode'};
        push(@setupcommands, $setupcmd);
        $pkgset->add_package(pkg => $depnode);
      }
  }

#
# print out the unsorted commands (for debugging)
#

#        printf("\nunsorted commands\n");
#        for my $s (@setupcommands)
#        {
#            printf("command = '%s'\n", $s);
#        }

        #
        # prep the package set and sort
        #

        $pkgset->set_depenv('Setup');
#open (OUT, ">./deptable.html");

#select(OUT);

#print "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">
#<html>
#  <head>
#    <title>Globus Packages</title>
#  </head>

#  <body>

#    <h1>Installation Dependency Tree</h1>\n";

#$pkgset->printtablehtml();

#print "  </body>
#</html>
#";
        $pkgset->sort_pkgs();

        #
        # zero out our list of setup commands
        #

        @setupcommands = ();

        #
        # grab the packages that have been sorted and add them onto setup commands
        #

        for my $p (@{$pkgset->sorted()})
        {
            $setupcmd = trimSetupCommand($p->{'depnode'}->{'Post_Install_Program'});
            $setupcmd = formatSetupCommand($setupcmd);
            if (length($setupcmd) > 0)
            {
                push(@setupcommands, $setupcmd);
            }
        }

#        printf("\nsorted commands\n");
#        for my $s (@setupcommands)
#        {
#            printf("command = '%s'\n", $s);
#        }

        if ( (scalar(@setupcommands) == 0) && !defined($error) )
        {
            printf("All of the packages in your GLOBUS_LOCATION are already set up.\n");
            exit;
        }
        else
        {
            runSetupCommands(@setupcommands);
        }

exit;

### getFileLocation( $entity )
#
# given an entity in the form of a unix-style path, remove the trailing entry
# and return its parent directory.
#

sub getFileLocation
{
    my($entity) = @_;
    my($dir);

    $dir = $entity;

    $dir =~ s:/+:/:g;    # remove consecutive slashes
    $dir =~ s:/$::g;     # remove trailing slash (just in case)
    $dir =~ s:/[^/]*$::; # remove trailing filename

    return $dir;
}

### runSetupCommands
#
# given a list of setup commands, run them (in order)
#

sub runSetupCommands
{
    my (@setupcommands) = @_;
    my $olddir;

    for my $s (@setupcommands)
    {
        printf("running %s...\n", $s);
        action($s, getFileLocation($s));
    }
}

### formatSetupCommand( $setupcmd )
#
# prepend the setup path to the setup command
#

sub formatSetupCommand
{
    my($setupcmd) = @_;
    my($newcmd, $tmpcmd1, $tmpcmd2);

    #
    # first check in $GL/setup/globus/ to maintain backwards compatibility
    #

    $tmpcmd1 = $globus_path . "/setup/globus/" . $setupcmd;

    if ( -x $tmpcmd1 )
    {
        $newcmd = $tmpcmd1;

        return $newcmd;
    }

    #
    # otherwise check in $GL/setup/ to support new-style paths
    #

    $tmpcmd2 = $globus_path . "/setup/" . $setupcmd;

    if ( -x $tmpcmd2 )
    {
        $newcmd = $tmpcmd2;

        return $newcmd;
    }

    #
    # warn that we can't find a match for $setupcmd
    #

    printf("WARNING: cannot locate an executable file at either\n");
    printf("\t'$tmpcmd1'\n");
    printf("or\n");
    printf("\t'$tmpcmd2'\n");
    printf("...giving up.\n");

    $error = 1;

    return "";
}

### trimSetupCommand( $setupcmd )
#
# given a string, trim extraneous characters off of it
#

sub trimSetupCommand
{
    my ($setupcmd) = @_;

    $setupcmd =~ s:\n+::g;
    $setupcmd =~ s:^[\s]+|[\s]+$::g;
    $setupcmd =~ s:\s+: :g;

    return $setupcmd;
}

### 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");
    my $result = 
      system(
             "GLOBUS_LOCATION=$locations->{'installdir'}; \\
export GLOBUS_LOCATION; \\
GPT_LOCATION=$gpath; \\
export GPT_LOCATION; \\
$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);
    }
}

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

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

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

=head1 NAME

B<gpt-postinstall> - Searches for post install scripts and executes them

=head1 SYNOPSIS

  gpt-postinstall [-help -force -version -man -location ]

=head1 DESCRIPTION

B<gpt-postinstall> Searches an installation for post-install scripts
that have not been run yet and executes them.  These scripts are
installed by Setup packages and are designed to localize an
installation. The I<-force> flag can be used to re-run all of the
setup scripts.

=head1 OPTIONS

=over 8

=item B<-force>

forces all action to be taken, regardless of state.

=item B<-help>

Print a brief help message and exits.

=item B<-man>

Prints the manual page and exits.

=item B<-version>

Prints the version of GPT and exits.

=item B<-location>

Location indicates the path to the Globus installation that will be used.

=back

=head1 SEE ALSO

gpt-install(1) gpt-uninstall(1) gpt-verify(1)

=head1 AUTHOR

Michael Bletzinger E<lt>mbletzin.ncsa.uiuc.eduE<gt> and Eric Blau
E<lt>eblau.ncsa.uiuc.eduE<gt>

=cut
