view release on metacpan or  search on metacpan

t/dbdpg_test_setup.pl  view on Meta::CPAN

                $@ = $msg;
            }
            last GETHANDLE; ## Fail - initdb bad
        }
        elsif ($info =~ /([0-9]+)(?:devel|beta|rc|alpha)/) { ## Can be 10devel
            $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';
        }
        $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"};