view release on metacpan or  search on metacpan

t/dbdpg_test_setup.pl  view on Meta::CPAN

            $version = $1;
        }
        elsif ($info =~ /([0-9]+\.[0-9]+)/) {
            $version = $1;
        }
        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';
        }
        if ($^O =~ /Win32/) {
            my $fullpath = qx{where $pg_ctl};
            chomp $fullpath;
            $fullpath =~ /pg_ctl/ or die "Could not determine full path for pg_ctl on Win32!\n";
            $pg_ctl = $fullpath;
        }

        my $pgctlcom = build_command('PGCTL --help 2>&1', [$pg_ctl]);
        $info = '';
        eval { $info = qx{$pgctlcom}; };
        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
        Test::More::diag "Please wait, creating new Postgres cluster (version $version) for testing\n";
        $info = '';
        my $locale = $ENV{DBDPG_TEST_LOCALE} || 'C';
        my $initdbcom = build_command('INITDB --locale=LOCALE -E utf8 -D DATADIR 2>&1',
                                      [$initdb, $locale, "$testdir/data"]);
        eval { $info = qx{$initdbcom}; };
        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", 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 $file_owner_uid = (stat($0))[4];
            my $username = defined $file_owner_uid ? getpwuid($file_owner_uid) : undef;
            unshift @userlist, $username if defined $username and $file_owner_uid != $<;

            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++;
                $olddir = getcwd;
                my $sucom = build_command(q{su TESTUSER -m -c "/bin/sh -c 'INITDB --locale=C -E utf8 -D DATADIR 2>&1'"},
                                          [$testuser, $initdb, "$testdir/data"], 'backslash_spaces');
                chdir $testdir;
                $info = '';
                eval { $info = qx{$sucom}; };
                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/;
        }
        my $resetcom = $su ?
            build_command('su TESTUSER -m -c "RESETXLOG --help"',