DBD-KB

 view release on metacpan or  search on metacpan

t/dbdpg_test_setup.pl  view on Meta::CPAN

    ## We may want to force an initdb call
    if ((!$helpconnect and $ENV{DBDPG_TESTINITDB})
            or (exists $ENV{DBDPG_INITDB} and $initdb ne $ENV{DBDPG_INITDB})) {
        $debug and Test::More::diag 'Jumping to INITDB';
        goto INITDB;
    }

    ## Got a working DSN? Give it an attempt
    if ($testdsn and $testuser) {

        $debug and Test::More::diag "Trying with $testuser and $testdsn";

        ## Used by t/01connect.t
        if ($arg->{dbreplace}) {
            $testdsn =~ s/$alias\s*=/$arg->{dbreplace}=/;
        }
        if ($arg->{dbquotes}) {
            $testdsn =~ s/$alias\s*=([\-\w]+)/'db="'.lc $2.'"'/e;
        }

        goto GOTDBH if eval {
            $dbh = DBI->connect($testdsn, $testuser, $ENV{DBI_PASS},
                                {RaiseError => 1, PrintError => 0, AutoCommit => 1});
            1;
        };

        $debug and Test::More::diag "Connection failed: $@";

        if ($@ =~ /invalid connection option/ or $@ =~ /dbbarf/) {
            return $helpconnect, $@, undef;
        }

        if ($arg->{nocreate}) {
            return $helpconnect, '', undef;
        }

        ## If this was created by us, try and restart it
        if (16 == $helpconnect) {

            ## Bypass if the testdir has been removed
            if (! -e $testdir) {
                $arg->{nocreate} and return $helpconnect, '', undef;
                warn "Test directory $testdir has been removed, will create a new one\n";
            }
            else {
                if (-e "$testdir/data/postmaster.pid") {
                    ## Assume it's up, and move on
                }
                else {

                    if ($arg->{norestart}) {
                        return $helpconnect, '', undef;
                    }

                    warn "Restarting test database $testdsn at $testdir\n";
                    if ($^O !~ /Win32/) {
                        my $sockdir = "$testdir/data/socket";
                        if (! -e $sockdir) {
                            mkdir $sockdir;
                            if ($uid) {
                                if (! chown $uid, -1, $sockdir) {
                                    warn "chown of $sockdir failed!\n";
                                }
                            }
                        }
                    }
                    my $COM = qq{$pg_ctl -o '-k $testdir/data/socket' -l $testdir/dbdpg_test.logfile -D $testdir/data start};
                    if ($su) {
                        $COM = qq{su -m $su -c "$COM"};
                        chdir $testdir;
                    }
                    $info = '';
                    eval { $info = qx{$COM}; };
                    my $err = $@;
                    $su and chdir $olddir;
                    if ($err or $info !~ /\w/) {
                        $err = "Could not startup new database ($err) ($info)";
                        return $helpconnect, $err, undef;
                    }
                    ## Wait for it to startup and verify the connection
                    sleep 1;
                }
                my $loop = 1;
              STARTUP: {
                    eval {
                        $dbh = DBI->connect($testdsn, $testuser, '',
                                            {RaiseError => 1, PrintError => 0, AutoCommit => 1});
                    };
                    if ($@ =~ /starting up/ or $@ =~ /PGSQL\.[0-9]+/) {
                        if ($loop++ < 20) {
                            sleep 1;
                            redo STARTUP;
                        }
                    }
                }

                if ($@) {
                    return $helpconnect, $@, $dbh;
                }

                ## We've got a good connection, so do final tweaks and return
                goto GOTDBH;

            } ## end testdir exists

        } ## end error and we created this database

    } ## end got testdsn and testuser

    ## No previous info (or failed attempt), so try to connect and possible create our own cluster

    $testdsn ||= $ENV{DBI_DSN};
    $testuser ||= $ENV{DBI_USER};

    if (! $testdsn) {
        $helpconnect = 1;
        $testdsn = $^O =~ /Win32/ ? 'dbi:Pg:host=localhost' : 'dbi:Pg:dbname=postgres';
    }
    if (! $testuser) {
        $testuser = 'postgres';
    }

t/dbdpg_test_setup.pl  view on Meta::CPAN

        else {
            die "No version from initdb?! ($info)\n";
        }

        ## Make sure pg_ctl is available as well before we go further
        if (! -e $pg_ctl) {
            $pg_ctl = 'pg_ctl';
        }
        $info = '';
        eval {
            $info = qx{$pg_ctl --help 2>&1};
        };
        last GETHANDLE if $@; ## Fail - pg_ctl bad
        if (!defined $info or ($info !~ /\@(?:[a-z.-]*?postgresql\.org|enterprisedb\.com)/ and $info !~ /run as root/)) {
            $@ = defined $initdb ? "Bad pg_ctl output: $info" : 'Bad pg_ctl output';
            last GETHANDLE; ## Fail - pg_ctl bad
        }

        ## initdb and pg_ctl seems to be available, let's use them to fire up a cluster
        warn "Please wait, creating new database (version $version) for testing\n";
        $info = '';
        eval {
            my $com = "$initdb --locale=C -E UTF8 -D $testdir/data";
            $debug and warn" Attempting: $com\n";
            $info = qx{$com 2>&1};
        };
        last GETHANDLE if $@; ## Fail - initdb bad

        ## initdb and pg_ctl cannot be run as root, so let's handle that
        if ($info =~ /run as root/ or $info =~ /unprivilegierte/) {

            my $founduser = 0;
            $su = $testuser = '';

            $testdir = exists $ENV{DBDPG_TEMPDIR} ?
                File::Temp::tempdir("$ENV{DBDPG_TEMPDIR}/dbdpg_testdatabase_XXXXXX", TMPDIR => 1, CLEANUP => 0) :
                File::Temp::tempdir('dbdpg_testdatabase_XXXXXX', TMPDIR => 1, CLEANUP => 0);

            my $readme = "$testdir/README";
            if (open $fh, '>', $readme) {
                print {$fh} "This is a test directory for DBD::Pg and may be removed\n";
                print {$fh} "You may want to ensure the postmaster has been stopped first.\n";
                print {$fh} "Check the data/postmaster.pid file\n";
                close $fh or die qq{Could not close "$readme": $!\n};
            }

            ## Likely candidates for running this
            my @userlist = (qw/postgres postgresql pgsql _postgres/);

            ## Start with whoever owns this file, unless it's us
            my $username = getpwuid ((stat($0))[4]);
            unshift @userlist, $username if defined $username and $username ne getpwent;

            my %doneuser;
            for (@userlist) {
                $testuser = $_;
                next if $doneuser{$testuser}++;
                $uid = (getpwnam $testuser)[2];
                next if !defined $uid;

                next unless chown $uid, -1, $testdir;
                next unless chown $uid, -1, $readme;
                $su = $testuser;
                $founduser++;
                $info = '';
                $olddir = getcwd;
                eval {
                    chdir $testdir;
                    $info = qx{su -m $testuser -c "/bin/sh -c '$initdb --locale=C -E UTF8 -D $testdir/data 2>&1'"};
                };
                my $err = $@;
                chdir $olddir;
                last if !$err;
            }
            if (!$founduser) {
                $@ = 'Unable to find a user to run initdb as';
                last GETHANDLE; ## Fail - no user
            }
            if (! -e "$testdir/data") {
                $@ = 'Could not create a test database via initdb';
                last GETHANDLE; ## Fail - no datadir created
            }
            ## At this point, both $su and $testuser are set
        }

        if ($info =~ /FATAL/) {
            $@ = "initdb gave a FATAL error: $info";
            last GETHANDLE; ## Fail - FATAL
        }

        if ($info =~ /but is not empty/) {
            ## Assume this is already good to go
        }
        elsif ($info !~ /pg_ctl/) {
            $@ = "initdb did not give a pg_ctl string: $info";
            last GETHANDLE; ## Fail - bad output
        }

        ## Which user do we connect as?
        if (!$su and $info =~ /owned by user "(.+?)"/) {
            $testuser = $1;
        }

        ## Attempt to boost the system oids above an int for certain testing
        (my $resetxlog = $initdb) =~ s/initdb/pg_resetxlog/;
        if ($version >= 10) {
            $resetxlog =~ s/pg_resetxlog/pg_resetwal/;
        }
        eval {
            if ($su) {
                $info = qx{su -m "$testuser" -c "$resetxlog --help"};
            }
            else {
                $info = qx{$resetxlog --help};
            }
        };
        if (! $@ and $info =~ /XID/) {
            if (! -e "$testdir/data/postmaster.pid") {
                eval {
                    if ($su) {
                        $info = qx{ su -m "$testuser" -c "$resetxlog -o 2222333344 $testdir/data" };
                    }

t/dbdpg_test_setup.pl  view on Meta::CPAN

            open my $cfh, '<', $conf or die qq{Could not open "$conf": $!\n};
            while (<$cfh>) {
                if (/^\s*port\s*=\s*([0-9]+)/) {
                    $testport = $1;
                    $debug and Test::More::diag qq{Found port $testport inside conf file\n};
                }
            }
            close $cfh or die qq{Could not close "$conf": $!\n};
            ## Assume it's up, and move on
        }
        else {
            ## Change to this new port and fire it up
            if (! open $cfh, '>>', $conf) {
                $@ = qq{Could not open "$conf": $!};
                $debug and Test::More::diag qq{Failed to open "$conf"};
                last GETHANDLE; ## Fail - no conf file
            }
            $debug and Test::More::diag qq{Writing to "$conf"};
            print {$cfh} "\n\n## DBD::Pg testing parameters\n";
            print {$cfh} "port=$testport\n";
            print {$cfh} "max_connections=11\n";
            print {$cfh} "log_statement = 'all'\n";
            print {$cfh} "log_min_duration_statement = 0\n";
            print {$cfh} "log_line_prefix = '%m [%p] '\n";
            print {$cfh} "log_filename = 'postgres%Y-%m-%d.log'\n";
            print {$cfh} "log_rotation_size = 0\n";
            if (8.1 == $version) {
                print {$cfh} "redirect_stderr = on\n";
            }

            if ($version >= 8.3) {
                print {$cfh} "logging_collector = on\n";
            }

            if ($version >= 9.4) {
                print {$cfh} "wal_level = logical\n";
                print {$cfh} "max_replication_slots = 1\n";
                print {$cfh} "max_wal_senders = 1\n";

                open my $hba, '>>', "$testdir/data/pg_hba.conf"
                    or die qq{Could not open "$testdir/data/pg_hba.conf": $!\n};

                print {$hba} "local\treplication\tall\ttrust\n";
                print {$hba} "host\treplication\tall\t127.0.0.1/32\ttrust\n";
                print {$hba} "host\treplication\tall\t::1/128\ttrust\n";

                close $hba or die qq{Could not close "$testdir/data/pg_hba.conf": $!\n};
            }

            print {$cfh} "listen_addresses='127.0.0.1'\n" if $^O =~ /Win32/;
            print {$cfh} "\n";
            close $cfh or die qq{Could not close "$conf": $!\n};

            ## Attempt to start up the test server
            $info = '';
            if ($^O !~ /Win32/) {
                my $sockdir = "$testdir/data/socket";
                if (! -e $sockdir) {
                    mkdir $sockdir;
                    if ($su) {
                        if (! chown $uid, -1, $sockdir) {
                            warn "chown of $sockdir failed!\n";
                        }
                    }
                }
            }
            my $COM = qq{$pg_ctl -o '-k $testdir/data/socket' -l $testdir/dbdpg_test.logfile -D $testdir/data start};
            $olddir = getcwd;
            if ($su) {
                chdir $testdir;
                $COM = qq{su -m $su -c "$COM"};
            }
            $debug and Test::More::diag qq{Running: $COM};
            eval {
                $info = qx{$COM};
            };
            my $err = $@;
            $su and chdir $olddir;
            if ($err or $info !~ /\.\.\./) {
                $@ = "Could not startup new database ($COM) ($err) ($info)";
                last GETHANDLE; ## Fail - startup failed
            }
            sleep 1;
        }

        ## Attempt to connect to this server
        $testdsn = "dbi:Pg:dbname=postgres;port=$testport";
        if ($^O =~ /Win32/) {
            $testdsn .= ';host=localhost';
        }
        else {
            $testdsn .= ";host=$testdir/data/socket";
        }

        $debug and Test::More::diag qq{Test DSN: $testdsn};
        my $loop = 1;
      STARTUP: {
            eval {
                $dbh = DBI->connect($testdsn, $testuser, '',
                                    {RaiseError => 1, PrintError => 0, AutoCommit => 1});
            };
            ## Regardless of the error, try again.
            ## We used to check the message, but LANG problems may complicate that.
            if ($@) {

                $debug and Test::More::diag qq{Connection error: $@\n};

                if ($@ =~ /database "postgres" does not exist/) {
                    ## Old server, so let's create a postgres database manually
                    sleep 2;
                    (my $tempdsn = $testdsn) =~ s/postgres/template1/;
                    eval {
                        $dbh = DBI->connect($tempdsn, $testuser, '',
                                            {RaiseError => 1, PrintError => 0, AutoCommit => 1});
                    };
                    if ($@) {
                        die "Could not connect: $@\n";
                    }
                    $dbh->do('CREATE DATABASE postgres');
                    $dbh->disconnect();
                }