view release on metacpan or  search on metacpan

VBTK.pm  view on Meta::CPAN

#-------------------------------------------------------------------------------
# Function:     appendToPath
# Description:  Add the paths path names to ENV{PATH} after checking to see if
#               they exist.
# Input Parms:  Array of path names
# Output Parms: New Path
#-------------------------------------------------------------------------------
sub appendToPath
{
    my(@searchPath) = @_;
    
    foreach my $dir (@searchPath)
    {
        if(-d $dir) { $ENV{PATH} .= ":$dir"; }
        else        { &log("Can't find searchpath dir '$dir', ignoring"); }
    }

    $ENV{PATH};
}

#-------------------------------------------------------------------------------
# Function:     prependToPath
# Description:  Add the paths path names to the beginning of ENV{PATH} after 
#               checking to see if they exist.
# Input Parms:  Array of path names
# Output Parms: New Path
#-------------------------------------------------------------------------------
sub prependToPath
{
    my(@searchPath) = @_;
    
    foreach my $dir (@searchPath)
    {
        if(-d $dir) { $ENV{PATH} = "$dir:$ENV{PATH}"; }
        else        { &log("Can't find searchpath dir '$dir', ignoring"); }
    }

    $ENV{PATH};
}

#-------------------------------------------------------------------------------
# Function:     install
# Description:  Use prompts to walk the user through the installation process.
# Input Parms:  None
# Output Parms: None
#-------------------------------------------------------------------------------
sub install
{
    my($resp,$dir,$installDir,$vbcObj,$vbcText,$mode,$result);

    # Check to see if VBHOME is created and writeable.
    if(! -d $::VBHOME)
    {
        print STDOUT "Can't find '$::VBHOME', please create it or set the " .
            "Environment variable \$VBHOME to an alternate location\n";
        exit 1;
    }
    
    # See if we're running as the userid 'vbtk', and warn if not.
    my ($uname) = getpwuid($<);
    if($uname ne 'vbtk')
    {
        print STDOUT "\n" .
            "It is recommended that you run all VB processes under a separate userid,\n" .
            "such as 'vbtk'.  You are currently running with the userid '$uname'.\n";
        $resp = prompt("Do you want to continue under this userid? ","n");
        exit 1 if($resp !~ /^y/i);
    }
    
    # Create appropriate directories under VBHOME, die if error
    foreach $dir ('bin','conf','etc','examples','logs','perf','web')
    {
        if ((! -d "$::VBHOME/$dir")&&(! mkdir "$::VBHOME/$dir"))
        {
            print STDOUT "Can't create dir '$::VBHOME/$dir'";
            exit 1;
        }
    }
    
    # Ask user if this will run the (M)aster VBServer, a (S)lave VBServer,
    # or just (C)lient VB processes?
    print STDOUT "\nWhich VBTK processes will you be running on this host?\n";
    $mode = prompt("(M)aster VBServer, (S)lave VBServer, or (C)lients only?","C");
    
    # If Master, then look for the original VBTK install directory and copy
    # files from bin, examples, etc, and web over from it.  Preconfigure the
    # vbc file in conf.  Ask user for a list of slave servers and clients on
    # which this will be run.  Once configured, give the user instructions
    # to install the perl libraries on each of those hosts and run the
    # install process there.
    if($mode =~ /^m/i)
    {
        print STDOUT "\n" .
            "Since this is to be a Master VBServer, I'll need to copy some files\n" .
            "from the original VBTK install directory.  Please enter it's location.\n";
            
        $installDir = prompt("Install dir location:","");
        
        if((! -d "$installDir")||(! -f "$installDir/Makefile.PL"))
        {
            print STDOUT "\nError: Can't find VBTK install files in '$installDir', try again\n";
            exit 1;
        }
        
        if($installDir eq $::VBHOME)
        {
            print STDOUT "\nError: Install dir can't be the same as \$VBHOME\n";
            exit 1;
        }
        
        # Check for all the appropriate directories
        my @copyDirs = qw(bin etc web examples);
        grep(s/^/$installDir\//,@copyDirs);
        foreach (@copyDirs)
        {
            if(! -d $_)
            {
                print STDOUT "\nError: Can't find '$_'\n";
                exit 1;
            }