Author: turnstep
Date: Sun Jul 20 18:18:09 2008
New Revision: 11547

Modified:
   DBD-Pg/trunk/t/99cleanup.t
   DBD-Pg/trunk/t/dbdpg_test_setup.pl

Log:
Create temp directories for better testing when running as root.
Remove those temp directories during cleanup.
Store uid in README.testdatbase file for better chowning.
Prevent cleanup from doing unnecessary work.


Modified: DBD-Pg/trunk/t/99cleanup.t
==============================================================================
--- DBD-Pg/trunk/t/99cleanup.t  (original)
+++ DBD-Pg/trunk/t/99cleanup.t  Sun Jul 20 18:18:09 2008
@@ -2,6 +2,7 @@
 
 ## Cleanup all database objects we may have created
 ## Shutdown the test database if we created one
+## Remove the entire directory if it was created as a tempdir
 
 use 5.006;
 use strict;
@@ -11,7 +12,7 @@
 require 'dbdpg_test_setup.pl';
 select(($|=1,select(STDERR),$|=1)[1]);
 
-my $dbh = connect_database({nosetup => 1, nocreate => 1});
+my $dbh = connect_database({nosetup => 1, nocreate => 1, norestart => 1});
 
 SKIP: {
        if (! defined $dbh) {

Modified: DBD-Pg/trunk/t/dbdpg_test_setup.pl
==============================================================================
--- DBD-Pg/trunk/t/dbdpg_test_setup.pl  (original)
+++ DBD-Pg/trunk/t/dbdpg_test_setup.pl  Sun Jul 20 18:18:09 2008
@@ -40,10 +40,6 @@
 ## File written so we don't have to retry connections:
 my $helpfile = 'README.testdatabase';
 
-## If we create our own cluster, store it here:
-my $test_database_dir = 'dbdpg_test_database';
-## TODO: Handle Win32 better with slashes and user change
-
 use vars qw/$fh/;
 
 sub connect_database {
@@ -61,14 +57,12 @@
        my $dbh = $arg->{dbh} || '';
        my $alias = qr{(database|db|dbname)};
        my $info;
+       my $olddir = getcwd;
 
        ## We'll try various ways to get to a database to test with
 
        ## First, check to see if we've been here before and left directions
-       my ($testdsn,$testuser,$helpconnect,$su,$testdir,$pg_ctl,$error) = 
get_test_settings();
-
-       ## For debugging purposes, we'll be storing this in README.testdatabase 
as well
-       my $initdb = 'default';
+       my 
($testdsn,$testuser,$helpconnect,$su,$uid,$testdir,$pg_ctl,$initdb,$error) = 
get_test_settings();
 
        ## Did we fail last time? Fail this time too, but quicker!
        if ($testdsn =~ /FAIL!/) {
@@ -96,36 +90,52 @@
                        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) {
-                               warn "Test directory $testdir has been removed, 
will recreate from scratch\n";
+                               $arg->{nocreate} and return $helpconnect, '', 
undef;
+                               warn "Test directory $testdir has been removed, 
will create a new one\n";
                        }
                        else {
-                               if (-e 
"$test_database_dir/data/postmaster.pid") {
+                               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";
                                        my $option = '';
                                        if ($^O !~ /Win32/) {
-                                               if (! -e 
"$test_database_dir/data/socket") {
-                                                       mkdir 
"$test_database_dir/data/socket";
+                                               my $sockdir = 
"$testdir/data/socket";
+                                               if (! -e $sockdir) {
+                                                       mkdir $sockdir;
+                                                       if (! chown $uid, -1, 
$sockdir) {
+                                                               warn "chown of 
$sockdir failed!\n";
+                                                       }
                                                }
                                                $option = q{-o '-k socket'};
                                        }
-                                       my $COM = qq{$pg_ctl $option -l 
$testdir/dbdpg_test.logfile -D $testdir start};
+                                       my $COM = qq{$pg_ctl $option -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}; };
-                                       if ($@ or $info !~ /\w/) {
-                                               $@ = "Could not startup new 
database ($@) ($info)";
-                                               return $helpconnect, $@, undef;
+                                       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;
@@ -157,7 +167,7 @@
 
        } ## end got testdsn and testuser
 
-       ## No previous info (or failed attempt), so start new connection 
attempt from scratch
+       ## No previous info (or failed attempt), so try to conenct and possible 
create out own cluster
 
        $testdsn ||= $ENV{DBI_DSN};
        $testuser ||= $ENV{DBI_USER};
@@ -176,7 +186,7 @@
                        $dbh = DBI->connect($testdsn, $testuser, $ENV{DBI_PASS},
                                                                {RaiseError => 
1, PrintError => 0, AutoCommit => 1});
                };
-               last GETHANDLE if ! $@;
+               last GETHANDLE if ! $@; ## Made it!
 
                ## If the error was because of the user, try a few others
                if ($@ =~ /postgres/) {
@@ -194,7 +204,7 @@
                                $dbh = DBI->connect($testdsn, $testuser, 
$ENV{DBI_PASS},
                                                                        
{RaiseError => 1, PrintError => 0, AutoCommit => 1});
                        };
-                       last GETHANDLE if ! $@;
+                       last GETHANDLE if ! $@; ## Made it!
 
                        ## Final user tweak: set to postgres for Beastie
                        if ($testuser ne 'postgres') {
@@ -204,7 +214,7 @@
                                        $dbh = DBI->connect($testdsn, 
$testuser, $ENV{DBI_PASS},
                                                                                
{RaiseError => 1, PrintError => 0, AutoCommit => 1});
                                };
-                               last GETHANDLE if ! $@;
+                               last GETHANDLE if ! $@; ## Made it!
                        }
                }
 
@@ -222,11 +232,13 @@
                if (!$initdb or ! -e $initdb) {
                        $initdb = 'initdb';
                }
+
+               ## Make sure initdb exists and is working properly
                $info = '';
                eval {
                        $info = qx{$initdb --help 2>&1};
                };
-               last GETHANDLE if $@;
+               last GETHANDLE if $@; ## Fail - initdb bad
                if (!defined $info or ($info !~ /[EMAIL PROTECTED]/ and $info 
!~ /run as root/)) {
                        if (defined $info) {
                                if ($info !~ /\w/) {
@@ -237,12 +249,12 @@
                                }
                        }
                        else {
-                               my $msg = 'Failed to run initdb (executable 
probably not available).';
+                               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;
+                       last GETHANDLE; ## Fail - initdb bad
                }
 
                ## Make sure pg_ctl is available as well before we go further
@@ -253,52 +265,67 @@
                eval {
                        $info = qx{$pg_ctl --help};
                };
-               last GETHANDLE if $@;
+               last GETHANDLE if $@; ## Fail - pg_ctl bad
                if (!defined $info or $info !~ /[EMAIL PROTECTED]/) {
                        $@ = defined $initdb ? "Bad pg_ctl output: $info" : 
'Bad pg_ctl output';
-                       last GETHANDLE;
+                       last GETHANDLE; ## Fail - pg_ctl bad
                }
 
-               ## initdb and pg_ctl seems to be available, let's use it to 
test a new cluster
+               ## 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 
$test_database_dir/data 2>&1};
+                       warn "RUNNING: $initdb --locale=C -E UTF8 -D 
$testdir/data \n";
+                       $info = qx{$initdb --locale=C -E UTF8 -D $testdir/data 
2>&1};
                };
-               last GETHANDLE if $@;
+               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/) {
-                       if (! -e $test_database_dir) {
-                               mkdir $test_database_dir;
+
+                       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 = "$test_database_dir/README";
+
+                       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 port in the 
postgresql.conf file\n";
                                close $fh or die qq{Could not close "$readme": 
$!\n};
                        }
-                       my $founduser = 0;
-                       $su = $testuser = '';
+
+                       ## Likely candidates for running this
+                       my @userlist = (qw/postgres postgresql pgsql 
_postgres/);
 
                        ## Start with whoever owns this file, unless it's us
-                       my @userlist = (qw/postgres postgresql pgsql/);
                        my $username = getpwuid ((stat($0))[4]);
                        unshift @userlist, $username if defined $username and 
$username ne getpwent;
+
                        my %doneuser;
                        for my $user (@userlist) {
                                next if $doneuser{$user}++;
-                               my $uid = (getpwnam $user)[2];
+                               $uid = (getpwnam $user)[2];
                                next if !defined $uid;
-                               next unless chown $uid, -1, $test_database_dir;
+
+                               next unless chown $uid, -1, $testdir;
+                               next unless chown $uid, -1, $readme;
                                $su = $user;
                                $founduser++;
                                $info = '';
+                               my $olddir = getcwd;
                                eval {
-                                       $info = qx{su -m $user -c "$initdb 
--locale=C -E UTF8 -D $test_database_dir/data" 2>&1};
+                                       chdir $testdir;
+                                       $info = qx{su -m $user -c "$initdb 
--locale=C -E UTF8 -D $testdir/data 2>&1"};
                                };
-                               if (!$@ and $info =~ /owned by user "$user"/) {
+                               my $err = $@;
+                               chdir $olddir;
+                               if (!$err and $info =~ /owned by user "$user"/) 
{
                                        $testuser = $user;
                                        last;
                                }
@@ -311,8 +338,8 @@
                                $@ = "Failed to run initdb as user $su: $@";
                                last GETHANDLE;
                        }
-                       if (! -e "$test_database_dir/data") {
-                               $@ = 'Could not create a test database';
+                       if (! -e "$testdir/data") {
+                               $@ = 'Could not create a test database via 
initdb';
                                last GETHANDLE;
                        }
                        ## At this point, both $su and $testuser are set
@@ -357,13 +384,13 @@
                                redo;
                        }
                        if ($testport >= $maxport) {
-                               $@ = "No free ports found for testing: tried 
5442 to $maxport\n";
+                               $@ = "No free ports found for testing: tried 
5440 to $maxport\n";
                                last GETHANDLE;
                        }
                }
                $@ = '';
                ## Change to this new port and fire it up
-               my $conf = "$test_database_dir/data/postgresql.conf";
+               my $conf = "$testdir/data/postgresql.conf";
                my $cfh;
                if (! open $cfh, '>>', $conf) {
                        $@ = qq{Could not open "$conf": $!};
@@ -375,27 +402,37 @@
                close $cfh or die qq{Could not close "$conf": $!\n};
 
                ## Attempt to start up the test server
-               if (-e "$test_database_dir/data/postmaster.pid") {
+               if (-e "$testdir/data/postmaster.pid") {
                        ## Assume it's up, and move on
                }
                else {
                        $info = '';
                        my $option = '';
                        if ($^O !~ /Win32/) {
-                               if (! -e "$test_database_dir/data/socket") {
-                                       mkdir "$test_database_dir/data/socket";
+                               my $sockdir = "$testdir/data/socket";
+                               if (! -e $sockdir) {
+                                       mkdir $sockdir;
+                                       if ($su) {
+                                               if (! chown $uid, -1, $sockdir) 
{
+                                                       warn "chown of $sockdir 
failed!\n";
+                                               }
+                                       }
                                }
                                $option = q{-o '-k socket'};
                        }
-                       my $COM = qq{$pg_ctl $option -l 
$test_database_dir/dbdpg_test.logfile -D $test_database_dir/data start};
+                       my $COM = qq{$pg_ctl $option -l 
$testdir/dbdpg_test.logfile -D $testdir/data start};
+                       my $olddir = getcwd;
                        if ($su) {
+                               chdir $testdir;
                                $COM = qq{su -m $su -c "$COM"};
                        }
                        eval {
                                $info = qx{$COM};
                        };
-                       if ($@ or $info !~ /\w/) {
-                               $@ = "Could not startup new database ($COM) 
($@) ($info)";
+                       my $err = $@;
+                       $su and chdir $olddir;
+                       if ($err or $info !~ /\w/) {
+                               $@ = "Could not startup new database ($COM) 
($err) ($info)";
                                last GETHANDLE;
                        }
                        sleep 1;
@@ -407,9 +444,7 @@
                        $testdsn .= ';host=localhost';
                }
                else {
-                       my $dir = getcwd;
-                       my $socketdir = "$dir/$test_database_dir/data/socket";
-                       $testdsn .= ";host=$socketdir";
+                       $testdsn .= ";host=$testdir/data/socket";
                }
                my $loop = 1;
          STARTUP: {
@@ -446,8 +481,9 @@
                else {
                        print $fh "## DSN: $testdsn\n";
                        print $fh "## User: $testuser\n";
-                       print $fh "## Testdir: $test_database_dir/data\n" if 16 
== $helpconnect;
+                       print $fh "## Testdir: $testdir\n" if 16 == 
$helpconnect;
                        print $fh "## Testowner: $su\n" if $su;
+                       print $fh "## Testowneruid: $uid\n" if $uid;
                }
                close $fh or die qq{Could not close "$helpfile": $!\n};
        }
@@ -514,6 +550,24 @@
 } ## end of connect_database
 
 
+sub find_tempdir {
+
+       if (eval { require File::Temp; 1; }) {
+               return File::Temp::tempdir('dbdpg_testdatabase_XXXXXX', TMPDIR 
=> 1, CLEANUP => 0);
+       }
+
+       ## Who doesn't have File::Temp?! :)
+       my $found = 0;
+       for my $num (1..100) {
+               my $tempdir = "/tmp/dbdpg_testdatabase_ABCDEF$num";
+               next if -e $tempdir;
+               mkdir $tempdir or return '';
+               return $tempdir;
+       }
+
+} ## end of find_tempdir
+
+
 sub get_test_settings {
 
        ## Returns test databae information from the testfile if it exists
@@ -525,22 +579,29 @@
                ($pg_ctl = $ENV{PGINITDB}) =~ s/initdb/pg_ctl/;
        }
        my ($testdsn, $testuser, $testdir, $error) = ('','','','?');
-       my ($helpconnect, $su) = (0,'');
+       my ($helpconnect, $su, $uid, $initdb) = (0,'','','default');
        if (-e $helpfile) {
                open $fh, '<', $helpfile or die qq{Could not open "$helpfile": 
$!\n};
                while (<$fh>) {
-                       /DSN: (.+)/          and $testdsn = $1;
-                       /User: (\w+)/        and $testuser = $1;
-                       /Helpconnect: (\d+)/ and $helpconnect = $1;
-                       /Testowner: (\w+)/   and $su = $1;
-                       /Testdir: (.+)/      and $testdir = $1;
-                       /pg_ctl: (.+)/       and $pg_ctl = $1;
-                       /ERROR: (.+)/        and $error = $1;
+                       /DSN: (.+)/           and $testdsn = $1;
+                       /User: (\w+)/         and $testuser = $1;
+                       /Helpconnect: (\d+)/  and $helpconnect = $1;
+                       /Testowner: (\w+)/    and $su = $1;
+                       /Testowneruid: (\d+)/ and $uid = $1;
+                       /Testdir: (.+)/       and $testdir = $1;
+                       /pg_ctl: (.+)/        and $pg_ctl = $1;
+                       /initdb: (.+)/        and $initdb = $1;
+                       /ERROR: (.+)/         and $error = $1;
                }
                close $fh or die qq{Could not close "$helpfile": $!\n};
        }
 
-       return $testdsn, $testuser, $helpconnect, $su, $testdir, $pg_ctl, 
$error;
+       if (!$testdir) {
+               my $dir = getcwd();
+               $testdir = "$dir/dbdpg_test_database";
+       }
+
+       return $testdsn, $testuser, $helpconnect, $su, $uid, $testdir, $pg_ctl, 
$initdb, $error;
 }
 
 
@@ -605,20 +666,26 @@
 
 sub shutdown_test_database {
 
-       my ($testdsn,$testuser,$helpconnect,$su,$testdir,$pg_ctl) = 
get_test_settings();
+       my ($testdsn,$testuser,$helpconnect,$su,$uid,$testdir,$pg_ctl,$initdb) 
= get_test_settings();
 
-       if (-e $test_database_dir and -e 
"$test_database_dir/data/postmaster.pid") {
-               warn "Shutting down the test database\n";
-               my $COM = qq{$pg_ctl -D $test_database_dir/data --silent -m 
fast stop};
+       if (-e $testdir and -e "$testdir/data/postmaster.pid") {
+               my $COM = qq{$pg_ctl -D $testdir/data --silent -m fast stop};
+               my $olddir = getcwd;
                if ($su) {
                        $COM = qq{su $su -m -c "$COM"};
+                       chdir $testdir;
                }
                eval {
                        qx{$COM};
                };
-               return $@;
+               $su and chdir $olddir;
        }
 
+       ## Remove the test directory entirely
+       return if ! eval { require File::Path; 1; };
+       warn "Removing test database directory\n";
+       File::Path::rmtree($testdir);
+
 }
 
 1;

Reply via email to