Wacky workaround for psql -h bug.

diff --git a/Makefile.PL b/Makefile.PL
index f7cc3af0e39732af213d5d3339181419daf1c3c2..3190c482d4733350eb5792dc386e4ae8c79f0aac 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -53,7 +53,7 @@ my %opts =
         NO_META        => 1,
      NORECURS       => 1,
      MAN1PODS       => {},
-        clean          => { FILES => 'test_database_check_postgres/' },
+        clean          => { FILES => 'test_database_check_postgres/', '/tmp/cptesting_socket' },
 );
 
 {

diff --git a/t/02_checkpoint.t b/t/02_checkpoint.t
index a83c05196b26f34dbc7abc74446a5ebcb38baae6..de342ba692d1970452f50440f3017b648857560a 100644 (file)
--- a/t/02_checkpoint.t
+++ b/t/02_checkpoint.t
@@ -38,7 +38,7 @@ like ($cp->run('-c 10'), qr{^ERROR: Must supply a --datadir}, $t);
 $t=qq{$S fails when called with an invalid datadir option and PGDATA is not set};
 like ($cp->run('-c 10 --datadir=foobar'), qr{^ERROR: Invalid data_directory}, $t);
 
-my $host = $cp->get_host();
+my $host = $cp->get_dbhost();
 $t=qq{$S fails when called against a non datadir datadir};
 like ($cp->run(qq{-c 10 --datadir="$host"}), qr{^ERROR:.+could not read the given data directory}, $t);
 

diff --git a/t/CP_Testing.pm b/t/CP_Testing.pm
index 3cc2ed1bdd3d60044cf015e742b70f79e45e86fe..2793cdbef61626526ada5b40ce96c8cbbb435cd6 100644 (file)
--- a/t/CP_Testing.pm
+++ b/t/CP_Testing.pm
@@ -204,6 +204,18 @@ sub test_database_handle {
        my $dbhost = $self->{dbhost} = "$here/$dbdir/data space/socket";
        $dbhost =~ s/^ /\\ /;
        $dbhost =~ s/([^\\]) /$1\\ /g;
+
+       ## Workaround for bug where psql -h /some/long/path fails
+       if (length($dbhost) > 90) {
+               my $newname = '/tmp/cptesting_socket';
+               if (! -e $newname) {
+                       warn "Creating new symlink socket at $newname\n";
+                       (my $oldname = $dbhost) =~ s/\\//g;
+                       symlink $oldname => $newname;
+               }
+               $dbhost = $self->{shorthost} = $newname;
+       }
+
        $self->{dbname} ||= 'postgres';
        my $dsn = qq{dbi:Pg:host=$dbhost;dbname=$self->{dbname}};
        my $dbuser = $self->{testuser};
@@ -220,6 +232,9 @@ sub test_database_handle {
                        $tempdbh->disconnect();
                        $dbh = DBI->connect(@superdsn);
                }
+               else {
+                       die "Could not connect: $@\n";
+               }
        }
        $dbh->ping() or die qq{Failed to ping!\n};
 
@@ -300,7 +315,7 @@ sub run {
 
        my $double = $action =~ s/DB2// ? 1 : 0;
 
-       my $dbhost = $self->{dbhost}   || die 'No dbhost?';
+       my $dbhost = $self->{shorthost} || $self->{dbhost}   || die 'No dbhost?';
        my $dbuser = $self->{testuser} || die 'No testuser?';
        my $dbname = $self->{dbname}   || die 'No dbname?';
        my $com = qq{perl check_postgres.pl --action=$action --dbhost="$dbhost" --dbuser=$dbuser};
@@ -336,11 +351,21 @@ sub get_user {
        return $self->{testuser};
 }
 
-sub get_host {
+sub get_dbhost {
        my $self = shift;
        return $self->{dbhost};
 }
 
+sub get_host {
+       my $self = shift;
+       return $self->{shorthost} || $self->{dbhost};
+}
+
+sub get_shorthost {
+       my $self = shift;
+       return $self->{shorthost};
+}
+
 sub get_dbname {
        my $self = shift;
        return $self->{dbname};