#!/usr/bin/perl
#
# gpt.package
#
# Build a GPT distribution (using epm) from a directory in which GPT is
# installed.
#

#
# do bootstrap includes
#

use strict;                    # turn on perl sadomasochism mode
use Cwd;                       # for absolutePath
use Cwd 'abs_path';            #

#
# derive the directory in which we exist
#

my ($progname, $progdir, $libdir, $supportdir);

$progname = $0;
$progdir = $progname;
$progdir =~ s:/+:/:g;
$progdir =~ s:/[^/]*$:/:g;
$progdir = absolutePath($progdir);

if ($progdir !~ /^\//)
{
    die("I should have an absolute path to work with!\n");
}

$libdir = "$progdir/lib/perl";
$supportdir = "$progdir/support";

#
# standard includes
#

@INC = ("$libdir", @INC);

use Getopt::Long;              # options
use Fcntl;                     # for creating our temporary filename
use POSIX qw(tmpnam);          #
require Pod::Usage;            # help/man page
require CreateFileList;        # create epm filelist string based off of
                               #   our current directory
require AtExit;

#
# global variables
#

my (@cleanupdirs) = ();

#
# register cleanup routine
#

AtExit::atexit(\&cleanup, "This call was registered first");

sub cleanup
{
    if ( defined(@cleanupdirs) && ( scalar(@cleanupdirs) > 0 ) )
    {
        for my $d (@cleanupdirs)
        {
            if ( -d $d )
            {
                action("rm -rf $d");
            }
            elsif ( -e $d )
            {
                printf("weird!  $d exists but it isn't a directory..\n");
            }
        }
    }
}

#
# turn off output buffering.  who needs efficiency, anyway?
# (the real reason is that some messages are printed out of order if output
# buffering is on)
#

$| = 1;

#
# build our version information
#

my $version =
  {
    'name' => "gpt.package",
    'id' => "0.2",
  };

#
# diagnostic messages
#

my $tildemsg = "<slap!>\nDon't use tildes!";

#
# enumerate our package types and their names
#

my $pkgtypenames = {
              'epm' => 'EPM',
              'rpm' => 'RPM',
              'pkg' => 'AT&T Package',
                   };

my ($dir, $mode, $force, $verbose, @exclude, @types, $finaldir);

#
# simulate argument specification of the following directories
#

push(@exclude, "linux-2.4-intel");
push(@exclude, "gpt.list");

#
# drive argument determination
#

GetOptions( 'dir=s' => \$dir,
            'finaldir=s' => \$finaldir,
            'force' => \$force,
            'verbose' => \$verbose,
            'exclude=s' => \@exclude,
            'version' => 
                sub { setmode("version"); },
            'information' => 
                sub { setmode("info"); },
            'man' => 
                sub { setmode("man"); },
            'help|?' =>
                sub { setmode("help"); },
            'type=s' => \@types,
          ) or Pod::Usage::pod2usage(2);

#
# format our exclude and type lists
#

@exclude = buildMultiArg(@exclude);
@types = buildMultiArg(@types);

testAndFormatExclude(\@exclude);

#
# process our different invocation modes
#

if ($mode eq "version")
{
    #
    # if --version is used, we print our current version number
    #

    printf("%s\n", $version->{'id'});
}
elsif ($mode eq "info")
{
    #
    # if --info is used, we print our $version information
    #

    printf("NCSA %s v%s\n", $version->{'name'}, $version->{'id'});
    printf("Copyright 2002 National Center for Supercomputing Applications.\n");
    printf("This program has absolutely no warranty.\n");
}
elsif ($mode eq "help")
{
    #
    # if --help is specified, print the synopsis, options, and/or arguments sections
    #

    Pod::Usage::pod2usage(1);

    #
    # doesn't return
    #
}
elsif ($mode eq "man")
{
    #
    # if --man is specified, exit with value 0 and print the entire pod document
    #

    Pod::Usage::pod2usage('-exitval' => 0, '-verbose' => 2);

    #
    # doesn't return
    #
}
else
{
    #
    # otherwise call main
    #

    main($dir, $finaldir, $force, \@types);
}

exit;

#
# subroutines
#

### setmode( $modearg )
#
# based on the mode passed into us, set our program's $mode accordingly
#

sub setmode
{
    my ($modearg) = @_;

    if ( !defined($mode) )
    {
        $mode = $modearg;
    }
    else
    {
        die("Cannot specify more than one mode per instance!\n");
    }
}

### main( $fromdir, $finaldir, $force, $types )
#
# driver function
#

sub main
{
    my ($fromdir, $finaldir, $force, $types) = @_;
    my (@pkgtypes, $str, $args, $todir, $olddir);

    #
    # given our $types array, determine what package types we should build
    #

    @pkgtypes = determinePkgTypes($types);
    if (scalar(@pkgtypes) == 0)
    {
        die("No package types to build were given!\n");
    }

    #
    # based on a confluence of arguments and environment, determine the directory
    # from which to grab files for our package
    #

    printf("Determining the directory from which to pull the installation... ");
    $fromdir = determineDir($fromdir, $force);
    printf("'$fromdir'.\n");

    printf("Determining the directory in which to put the installation... ");
    $finaldir = determineFinalDir($finaldir, $fromdir);
    printf("'$finaldir'.\n");

    #
    # copy all of the files from our gpt location into a temporary packaging directory
    #

    $todir = setupTempDirectory($fromdir, $finaldir);

    #
    # remember to clean up our base temp directory
    #

    push(@cleanupdirs, $todir->{'base'});

    #
    # build each of the package types
    #

    for my $t (@pkgtypes)
    {
        outputTarget($t);

        #
        # create an epm filelist
        #

        printf("Generating filelist to use for package... ");
        $olddir = cwd();
        chdir($todir->{'top'});
        $str = buildPackageFilelist($t, ".", $finaldir, \@exclude);
        chdir($olddir);
        printf("done.\n");

        #
        # append filelist to $finaldir/gpt.list
        #

        printf("Creating gpt.list in '%s'... ", $todir->{'top'});
        createGPTList($todir->{'top'}, $str, $force);
        printf("done.\n");

        #
        # prime our target directory
        #

        primeDirectory($todir->{'top'});

        #
        # ooo the dirty work
        #

        buildPackage($todir->{'top'}, $t);

        #
        # cleanup after ourselves
        #

        printf("Removing gpt.list from '%s'... ", $todir->{'top'});
        removeGPTList($todir->{'top'});
        printf("done.\n");
    }

    printf("Cleaning up temp directory... ");
    action("rm -rf $todir->{'base'}");
    printf("done.\n");

    return;
}

### determineFinalDir( $finaldir, $fromdir )
#
# this function determines where the final installation will be located on a
# user's machine
#

sub determineFinalDir
{
    my ($finaldir, $fromdir) = @_;

    $finaldir =~ s:\s+::g;

    if ( !defined($finaldir) || length($finaldir) == 0 )
    {
        printf("\n");
        printf("No final directory was specified!\n");
        die("dying horribly");
    }

    return $finaldir;
}

### setupTempDirectory( $fromdir, $finaldir )
#
# given an originating directory, copy all of its files into a unique directory and
# return the new directory name to the calling function
#

sub setupTempDirectory
{
    my ($fromdir, $finaldir) = @_;
    my (@a, $rand, $todir, $lucky, $parent_dirs, @dirs);

    #
    # make sure that our originating directory is formatted correctly
    #

    $fromdir =~ s:/+:/:g;
    $fromdir =~ s:/$::g;

    #
    # do the same for our final directory
    #

    $finaldir =~ s:/+:/:g;
    $finaldir =~ s:/$::g;

    #
    # create a unique directory in /tmp in which we can work
    #

    $todir = genTempDir();

    #
    # reformat our 'fromdir' so that its safe to use relatively
    #

    $parent_dirs = $finaldir;
    $parent_dirs =~ s:/+:/:g;
    $parent_dirs =~ s:^/::g;
    $parent_dirs =~ s:/$::g;

    action("mkdir -p $parent_dirs", $todir->{'base'});

    #
    # make the directories in the temp directory
    #

    action("cp -a $fromdir/. $parent_dirs/.", $todir->{'base'});

    $todir->{'top'} = $todir->{'base'} . "/" . $parent_dirs;

    return $todir;
}

### genTempDir( )
#
# create a random directory for temp use
#

sub genTempDir
{
    my (@a, $rand, $todir, $lucky);
    my ($tmp);

    $todir = {};

    #
    # initialize my valid characters
    #

    @a = (0 .. 9, 'a' .. 'z');

    $lucky = 0;
    while ( ! $lucky )
    {
        $rand = join('', map { $a[int rand @a] } (0 .. 7));
        $todir->{'base'} = "/tmp/gpt-dist-$$-" . $rand;

        if ( ! -e $todir )
        {
            $lucky = 1;
        }
    }

    $tmp = $todir->{'base'};
    action("mkdir $tmp");

    return $todir;
}

### buildPackageFilelist( $type, $dir, $prepend, $exclude )
#
# based on $type, build a filelist that doesn't include those directories and
# files listed in $exclude.
#

sub buildPackageFilelist
{
    my ($type, $dir, $prepend, $exclude) = @_;
    my ($str);

    if ($type eq "rpm")
    {
        $str = createFileList($dir, $prepend, $exclude);
    }
    elsif ($type eq "epm")
    {
        $str = createFileList($dir, $prepend, $exclude);
    }
    elsif ($type eq "pkg")
    {
        $str = createFileList($dir, $prepend, $exclude);
    }
    else
    {
        die("Unknown package type '$type'!\n");
    }

    return $str;
}

### outputTarget( $type )
#
# given a package type, this prints a target message to the user
#

sub outputTarget
{
    my ($type) = @_;
    my $name = $pkgtypenames->{$type};

    if ( ! defined($name) )
    {
        die("Unknown package type '$type'!\n");
    }

    printf("--( Building Target: $name )--\n");
}

### buildPackage( $dir, $type )
#
# based on the type of package we are invoked with, do type-specific build
# steps
#

sub buildPackage
{
    my ($dir, $type) = @_;
    my ($args);

    printf("Making package... ");

    if ($type eq "epm")
    {
        $verbose ? ($args = "-v") : ($args = "");
        action("epm $args -f portable gpt", $dir);

        if ( ! -e "$dir/linux-2.4-intel" )
        {
            die("Cannot find directory containing distribution!\nExiting...\n");
        }

        buildEpmDist($dir);
    }
    elsif ($type eq "rpm")
    {
        $verbose ? ($args = "-v") : ($args = "");
        action("epm $args -f rpm gpt", $dir);

        if ( ! -e "$dir/linux-2.4-intel" )
        {
            die("Cannot find directory containing distribution!\nExiting...\n");
        }

        buildRpmDist($dir);
    }
    elsif ($type eq "pkg")
    {
        $verbose ? ($args = "-v") : ($args = "");
        action("epm $args -f pkg gpt", $dir);

        if ( ! -e "$dir/solaris-2.8-sparc" )
        {
            die("Cannot find directory containing distribution!\nExiting...\n");
        }

        buildPkgDist($dir);
    }
    else
    {
        die("Unknown package type '$type'!\n");
    }

    printf("done.\n");
}

### determinePkgTypes( $usertypes )
#
# given a reference to an array of entries given us by the user, sort out what package
# types we will build in our run.
#

sub determinePkgTypes
{
    my ($input) = @_;
    my (@pkgtypes, %tmptypes, @unknowns, @knowns, @usertypes, @validtypes);

    @validtypes = keys(%$pkgtypenames);

    #
    # set everything in @validtypes to lowercase
    #

    @validtypes = map { lc($_) } @validtypes;

    #
    # if all packages were specified..
    #

    if ( grep(/^all$/, @$input) )
    {
        @pkgtypes = @validtypes;

        return @pkgtypes;
    }

    #
    # otherwise, do mapping to discover knowns and unknowns
    #

    %tmptypes = map { lc($_), 1 } @$input;
    @usertypes = keys(%tmptypes);

    @knowns = map { $_ } grep { my $x = $_; grep(/^$x$/, @validtypes)
                              } @usertypes;

    @unknowns = map { $_ } grep { my $x = $_; !grep(/^$x$/, @validtypes)
                                } @usertypes;

    if (scalar(@unknowns) gt 0)
    {
        printf("Unknown package type(s):\n");
        for my $t (@unknowns)
        {
            printf("\t$t\n");
        }
        die;
    }

    return @knowns;
}

### buildEpmDist( $dir )
#
# used to move and cleanup the files that are a result of packaging
#

sub buildEpmDist
{
    my ($dir) = @_;

    action("rm linux-2.4-intel/*.tar.gz", $dir);
    action("mv linux-2.4-intel gpt-linux-2.4-intel-portable", $dir);
    action("tar cf gpt-linux-2.4-intel-portable.tar gpt-linux-2.4-intel-portable", $dir);
    action("rm -rf gpt-linux-2.4-intel-portable", $dir);
    action("gzip gpt-linux-2.4-intel-portable.tar", $dir);
    action("mv $dir/gpt-linux-2.4-intel-portable.tar.gz ./");
}

### buildPkgDist( $dir )
#
# used to move and cleanup the files that are a result of packaging
#

sub buildPkgDist
{
    my ($dir) = @_;

    action("mv $dir/solaris-2.8-sparc/*.pkg ./");
    action("rm -rf solaris-2.8-sparc", $dir);
}

### buildRpmDist( $dir )
#
# used to move and cleanup the files that are a result of packaging
#

sub buildRpmDist
{
    my ($dir) = @_;

    action("mv $dir/linux-2.4-intel/*.rpm ./");
    action("rm -rf linux-2.4-intel", $dir);
}

sub primeDirectory( $dir )
{
    my ($dir) = @_;

    if ( ! -d $supportdir )
    {
        die ("'$supportdir' does not exist!\n"); 
    }

    if ( ! -d $dir )
    {
        die("'$dir' does not exist!\n");
    }

    action("cp $supportdir/COPYING $dir/COPYING");
    action("cp $supportdir/README $dir/README");
}

### testAndFormatExclude( $exclude )
#
# given an array reference, test it for tildes and format it appropriately
#

sub testAndFormatExclude
{
    my ($exclude) = @_;

    #
    # verify no tildes in our exclude list
    #

    for my $e (@$exclude)
    {
        if ($e =~ /~/)
        {
            die("$tildemsg\n");
        }

        #
        # while we're here, format the entry to remove spurious slashes
        #

        $e =~ s|/+|/|g;
    }
}

### createGPTList( $dir, $str, $force )
#
# read in 'support/epm.header', append $str, and write the result to '$dir/gpt.list'
#

sub createGPTList
{
    my ($dir, $str, $force) = @_;
    my $gptlist = "$dir/gpt.list";
    my ($data);

    $| = 1;

    if ( !$force && ( -e $gptlist ) )
    {
        die("'gpt.list' already exists in $dir! (use '--force' to override)\nExiting...\n");
    }

    if ( ( -e $gptlist) && ( ! -f $gptlist ) )
    {
        die("'gpt.list' isn't a regular file!\nExiting...\n");
    }

    $data = readFile("$supportdir/epm.header");
    $data = $data . "\n" . $str;
    writeFile($gptlist, $data);
}

### removeGPTList( $dir )
#
# remove the gpt.list file
#

sub removeGPTList
{
    my ($dir) = @_;
    my $gptlist = "$dir/gpt.list";

    if ( ! -e $gptlist )
    {
        die("Can't remove 'gpt.list' from $dir because file doesn't exist!\nExiting...\n");
    }

    action("rm $gptlist");
}

### 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;
}

### 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);
    }
}

### writeFile( $filename, $fileinput )
#
# writes $fileinput to $filename
#

sub writeFile
{
    my ($filename, $fileinput) = @_;

    #
    # test for a valid $filename
    #

    if ( !defined($filename) || (length($filename) lt 1) )
    {
        die "Filename is undefined";
    }

    if ( ( -e "$filename" ) && ( ! -w "$filename" ) )
    {
        die "Cannot write to filename '$filename'";
    }

    #
    # write the output to $filename
    #

    open(OUT, ">$filename");
    print OUT $fileinput;
    close(OUT);
}

### readFile( $filename )
#
# reads and returns $filename's contents
#

sub readFile
{
    my ($filename) = @_;
    my ($data);

    open (IN, "$filename") || die "Can't open '$filename': $!";
    $/ = undef;
    $data = <IN>;
    $/ = "\n";
    close(IN);

    return $data;
}

### determineDir( $dir, $force )
#
# determine the directory in which the gpt installation exists
#

sub determineDir
{
    my ($dir, $force) = @_;

    if ( !defined($dir) )
    {
        $dir = $ENV{GPT_LOCATION};

        if ( !defined($dir) || (length($dir) == 0) )
        {
            die("\nPlease either define GPT_LOCATION in your environment or call me with the '--dir' argument!\nExiting...\n");
        }
    }

    #
    # ~s are out to lunch
    #

    if ($dir =~ /~/)
    {
        die("\n$tildemsg\n");
    }

    #
    # verify the directory exists
    #

    if ( ! -e $dir )
    {
        die("'$dir' doesn't exist!\n");
    }

    $dir =~ s|/+|/|g;
    $dir = absolutePath($dir);

    checkGPTInstall($dir, $force);

    return $dir;
}

### checkGPTInstall( $dir, $force )
#
# if $force isn't set, check that the directory that's chosen doesn't appear to be a GPT
# source directory
#

sub checkGPTInstall
{
    my ($dir, $force) = @_;

    if ( !$force )
    {
        if ( ( -e "$dir/packaging_tools" ) ||
             ( -e "$dir/package_management" ) ||
             ( -e "$dir/archive_compress" ) )
        {
            die("\n'$dir' appears to be a GPT source directory! (use '--force' to override)\nExiting...\n");
        }
    }
}

### absolutePath( $dir )
#
# make $dir an absolute path if it isn't one already
#

sub absolutePath
{
    my ($dir) = @_;

    if ($dir !~ /^\//)
    {
        $dir = abs_path($dir);
    }

    return $dir;
}

#
# ooo a pod!
#

__END__

=head1 NAME

gpt.package - Wrap up GPT code in a software package

=head1 SYNOPSIS

gpt.package [options] --type=<pkgtype>

  Help-Related Options:
    --help      brief help message
    --man       full documentation

=head1 OPTIONS

=over 8

=item B<--type=<pkgtype>>

Build package of type pkgtype.  Valid pkgtype values are 'epm', 'rpm', or 'all'.

=item B<--dir=<dir_name>>

Optionally specify the location from which the installation of GPT should be taken.

=item B<--finaldir=<dir_name>>

Optionally specify the location in which the GPT files should appear on a remote system.

=item B<--exclude=<name>>

Exclude <name> from the list of files to capture.

=item B<--force>

Disregard checking for whether the selected directory appears to be a GPT source directory.

=item B<--verbose>

Increase the amount of output sent to the user during the program's operation.

=head2 AUXILIARY MODES

=item B<--version>

=item B<--info>

=item B<--help>

Print a brief help message and exit.

=item B<--man>

Print the manual page and exit.

=back

=head1 DESCRIPTION

B<gpt.package> is a consolidated script for packaging a GPT installation into any one of a
number of packaging formats using the EPM tool.  This script supports options for, among
other things: excluding certain directories from the final package, for altering the final
directory path in which the installation will appear, and building packages of multiple
types within the same invocation.

=head1 EXAMPLES

=head2 Building a RPM Package

To build a RPM package of a GPT installation pointed to by your GPT_LOCATION environment
variable, excluding the man directory, and setting a final directory path of "/usr/gpt":

gpt.package --type=rpm --exclude=man --finaldir=/usr/gpt

=head2 Building Multiple Package Types

To create both RPM and EPM packages from a directory named "gpt" in your current directory,
and to have the final directory path appear as "/usr/local/gpt":

gpt.package --type=epm,rpm --dir=gpt --finaldir=/usr/local/gpt

=head1 AUTHOR

Written by Chase Phillips.

=cut