view release on metacpan or  search on metacpan

Makefile.PL  view on Meta::CPAN

    Carp::carp( "Multiple copies of Driver.xst found in: @xst") if @xst > 1;
    return $xst[0];
}

################################################################################
# sub test_files - checks if at least one of the files in the list exists
# Paramters:
#  0: directory
#  1: reference to file list
# Return value: true value if at least on file exists, 0 otherwise
################################################################################
sub test_files
{
    my($dir, $files) = @_;
    local $_;
    -f "$dir/$_" && return $_ for @$files;
    0;
}

################################################################################
# sub dir_choice - prompts for a directory
# Parameters:
#  0: prompt string
#  1: reference to directory list
#  2: reference to file list
# Return value: directory name
################################################################################
sub dir_choice
{
    my($prompt, $dirs, $files) = @_;
    my %dirs;
    my $i;
    my $ret;

    test_files($_, $files) && ($dirs{++$i} = $_) for @$dirs;
    for (1..3)
    {
        foreach my $d (sort keys %dirs) {
            my $choice = prompt("$prompt :", $dirs{$d});
            return $choice if test_files($choice, $files);
        }
    }
    print "Cannot proceed. Aborting..\n";
}

################################################################################
# sub make_test_conf - configure for test (save to ./t/test.conf)
# Parameters: <none>
# Return value: <none>
################################################################################
sub make_test_conf
{
    my $test_conf = './t/test.conf';
    my ($dsn, $user, $pass, $path, $db, $host);

    # read cached config if available
    if (-r $test_conf)
    {
        print "\nReading cached test configuration...";
        open F, $test_conf or die "Can't open $test_conf: $!";
        local @ARGV = ($test_conf);
        ($dsn, $user, $pass) = map {chomp;$_} <>;
        ($db) = $dsn =~ /(?:db|database)=([^;]+);/;
        ($host) = $dsn =~ /(?:host|hostname)=([^;]+);/;
        $path = ($host ? "$host:" : '') . $db;
        close F;
    }

    # ask for database path
    DBPATH: {
        for (1..3) {
            last if $path = prompt("\nFull path to your test database: ", $path);
        }
        die "Must specify a test database" unless $path;

        ($db, $host) = reverse split /:/, $path;

        # no longer necessary
        #PFW - isql on windows doesn't seem to work without the localhost in the db path
        #my $hostpath = $path;
        #if ($path =~ /^localhost:(.+)/) {
        #    $hostpath = $1;
        #}

        # if DB doesn't exist ask for creation
        if ((!$host || $host =~ /localhost/) && !-f $db or
            $host && $host !~ /localhost/)
        {
            print <<"EOM";
$path does not exist.
Trying to create the test database..
Please enter a username with CREATE DATABASE permission.
EOM
            $user = prompt("Username :", $user);
            $pass = prompt("Password :", $pass);
            create_test_db($path, $user, $pass);
            last DBPATH;
        }
        else
        {
            print <<"EOM";
$db exists.
Trying to use an existing database..
Please enter a username to connect.
EOM
            $user = prompt("Username :", $user);
            $pass = prompt("Password :", $pass);

            # check dialect
            my $dialect;
            my $gstat = $IB_Bin_path . "/" . test_files($IB_Bin_path, [qw(gstat gstat.exe)]);
            local *GSTAT;
            open GSTAT, "$gstat -user $user -password $pass -h $path |" or die "Can't execute $gstat: $!";
            while (<GSTAT>) { ($dialect) = $_ =~ /dialect\s+(\d)/i and last }

            unless (defined $dialect) {
                print <<"EOM";

Dialect of $path is UNKNOWN.
This test requires a database of dialect 3. You may specify a non-existent database to create a new one.
EOM