view release on metacpan or  search on metacpan

t/dbdpg_test_setup.pl  view on Meta::CPAN

				}
				else {
					$@ = "Bad initdb output: $info";
				}
			}
			else {
				my $msg = 'Failed to run initdb (executable probably not available)';
				exists $ENV{PGINITDB} and $msg .= " ENV was: $ENV{PGINITDB}";
				$msg .= " Final call was: $initdb";
				$@ = $msg;
			}
			last GETHANDLE; ## Fail - initdb bad
		}

		## 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 !~ /\@postgresql\.org/ 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 for testing\n";
		$info = '';
		eval {
			$info = qx{$initdb --locale=C -E UTF8 -D $testdir/data 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 = '';

			## Figure out a valid directory - returns empty if nothing available
			$testdir = find_tempdir();
			if (!$testdir) {
				return $helpconnect, 'Unable to create a temp directory', undef;
			}

			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 "$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;
		}

		## Now we need to find an open port to use
		$testport = 5442;
		## If we've got netstat available, we'll trust that
		$info = '';
		eval {
			$info = qx{netstat -na 2>&1};
		};
		if ($@) {