From 80c5e4e02ee43e76f28ceadb9f9d7cf85df3015b Mon Sep 17 00:00:00 2001 From: Craig Ringer Date: Tue, 1 Mar 2016 21:44:11 +0800 Subject: [PATCH 7/7] TAP: Perltidy PostgresNode.pm Recent PostgresNode changes were committed without using the project's perltidyrc. Tidy it now. --- src/test/perl/PostgresNode.pm | 204 ++++++++++++++++++++++++------------------ src/test/perl/README | 3 + src/test/perl/SimpleTee.pm | 13 +-- 3 files changed, 130 insertions(+), 90 deletions(-) diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm index 4eaa3ed..a965e71 100644 --- a/src/test/perl/PostgresNode.pm +++ b/src/test/perl/PostgresNode.pm @@ -1,3 +1,4 @@ + =pod =head1 NAME @@ -119,18 +120,15 @@ of finding port numbers, registering instances for cleanup, etc. sub new { - my $class = shift; - my $name = shift; - my $pghost = shift; - my $pgport = shift; + my ($class, $name, $pghost, $pgport) = @_; my $testname = basename($0); $testname =~ s/\.[^.]+$//; - my $self = { - _port => $pgport, - _host => $pghost, - _basedir => TestLib::tempdir($name), - _name => $name, - _logfile => "$TestLib::log_path/${testname}_${name}.log" }; + my $self = { + _port => $pgport, + _host => $pghost, + _basedir => TestLib::tempdir($name), + _name => $name, + _logfile => "$TestLib::log_path/${testname}_${name}.log" }; bless $self, $class; $self->dump_info; @@ -380,7 +378,7 @@ sub init $params{hba_permit_replication} = 1 unless defined $params{hba_permit_replication}; $params{allows_streaming} = 0 unless defined $params{allows_streaming}; - $params{has_archiving} = 0 unless defined $params{has_archiving}; + $params{has_archiving} = 0 unless defined $params{has_archiving}; mkdir $self->backup_dir; mkdir $self->archive_dir; @@ -418,7 +416,7 @@ sub init close $conf; $self->set_replication_conf if $params{hba_permit_replication}; - $self->enable_archiving if $params{has_archiving}; + $self->enable_archiving if $params{has_archiving}; } =pod @@ -510,26 +508,31 @@ sub _backup_fs my $port = $self->port; my $name = $self->name; - print "# Taking filesystem level backup $backup_name from node \"$name\"\n"; + print + "# Taking filesystem level backup $backup_name from node \"$name\"\n"; - if ($hot) { - my $stdout = $self->psql_check('postgres', "SELECT * FROM pg_start_backup('$backup_name');"); + if ($hot) + { + my $stdout = $self->psql_check('postgres', + "SELECT * FROM pg_start_backup('$backup_name');"); print "# pg_start_backup: $stdout\n"; } - RecursiveCopy::copypath($self->data_dir, $backup_path, - filterfn => sub { - my $src = shift; - return $src !~ /\/pg_log\// && $src !~ /\/postmaster.pid$/; - } - ); + RecursiveCopy::copypath( + $self->data_dir, + $backup_path, + filterfn => sub { + my $src = shift; + return $src !~ /\/pg_log\// && $src !~ /\/postmaster.pid$/; + }); if ($hot) { # We ignore pg_stop_backup's return value. We also assume archiving # is enabled; otherwise the caller will have to copy the remaining # segments. - my $stdout = $self->psql_check('postgres', 'SELECT * FROM pg_stop_backup();'); + my $stdout = + $self->psql_check('postgres', 'SELECT * FROM pg_stop_backup();'); print "# pg_stop_backup: $stdout\n"; } @@ -575,7 +578,7 @@ sub init_from_backup $params{has_streaming} = 0 unless defined $params{has_streaming}; $params{hba_permit_replication} = 1 - unless defined $params{hba_permit_replication}; + unless defined $params{hba_permit_replication}; $params{has_restoring} = 0 unless defined $params{has_restoring}; print @@ -597,7 +600,7 @@ sub init_from_backup qq( port = $port )); - $self->set_replication_conf if $params{hba_permit_replication}; + $self->set_replication_conf if $params{hba_permit_replication}; $self->enable_streaming($root_node) if $params{has_streaming}; $self->enable_restoring($root_node) if $params{has_restoring}; } @@ -690,19 +693,19 @@ sub promote my $logfile = $self->logfile; my $name = $self->name; print "### Promoting node \"$name\"\n"; - TestLib::system_log('pg_ctl', '-D', $pgdata, '-l', $logfile, - 'promote'); + TestLib::system_log('pg_ctl', '-D', $pgdata, '-l', $logfile, 'promote'); } # Internal routine to enable streaming replication on a standby node. sub enable_streaming { - my ($self, $root_node) = @_; + my ($self, $root_node) = @_; my $root_connstr = $root_node->connstr; - my $name = $self->name; + my $name = $self->name; print "### Enabling streaming replication for node \"$name\"\n"; - $self->append_conf('recovery.conf', qq( + $self->append_conf( + 'recovery.conf', qq( primary_conninfo='$root_connstr application_name=$name' standby_mode=on )); @@ -711,7 +714,7 @@ standby_mode=on # Internal routine to enable archive recovery command on a standby node sub enable_restoring { - my ($self, $root_node) = @_; + my ($self, $root_node) = @_; my $path = $root_node->archive_dir; my $name = $self->name; @@ -724,11 +727,13 @@ sub enable_restoring # first. Paths also need to be double-quoted to prevent failures where # the path contains spaces. $path =~ s{\\}{\\\\}g if ($TestLib::windows_os); - my $copy_command = $TestLib::windows_os ? - qq{copy "$path\\\\%f" "%p"} : - qq{cp $path/%f %p}; + my $copy_command = + $TestLib::windows_os + ? qq{copy "$path\\\\%f" "%p"} + : qq{cp $path/%f %p}; - $self->append_conf('recovery.conf', qq( + $self->append_conf( + 'recovery.conf', qq( restore_command = '$copy_command' standby_mode = on )); @@ -750,12 +755,14 @@ sub enable_archiving # first. Paths also need to be double-quoted to prevent failures where # the path contains spaces. $path =~ s{\\}{\\\\}g if ($TestLib::windows_os); - my $copy_command = $TestLib::windows_os ? - qq{copy "%p" "$path\\\\%f"} : - qq{cp %p $path/%f}; + my $copy_command = + $TestLib::windows_os + ? qq{copy "%p" "$path\\\\%f"} + : qq{cp %p $path/%f}; # Enable archive_mode and archive_command on node - $self->append_conf('postgresql.conf', qq( + $self->append_conf( + 'postgresql.conf', qq( archive_mode = on archive_command = '$copy_command' )); @@ -886,8 +893,12 @@ sub psql print("### Running SQL command on node \"$name\": $sql\n"); # Run the command, ignoring errors - $self->psql_expert($dbname, $sql, stdout => \$stdout, stderr => \$stderr, - die_on_error => 0, on_error_stop => 0); + $self->psql_expert( + $dbname, $sql, + stdout => \$stdout, + stderr => \$stderr, + die_on_error => 0, + on_error_stop => 0); if ($stderr ne "") { @@ -914,10 +925,13 @@ sub psql_check my ($stdout, $stderr); - my $ret = $self->psql_expert($dbname, $sql, - %params, - stdout => \$stdout, stderr => \$stderr, - on_error_die => 1, on_error_stop => 1); + my $ret = $self->psql_expert( + $dbname, $sql, + %params, + stdout => \$stdout, + stderr => \$stderr, + on_error_die => 1, + on_error_stop => 1); # psql can emit stderr from NOTICEs etc if ($stderr ne "") @@ -994,20 +1008,23 @@ sub psql_expert { my ($self, $dbname, $sql, %params) = @_; - my $stdout = $params{stdout}; - my $stderr = $params{stderr}; - my $timeout = undef; + my $stdout = $params{stdout}; + my $stderr = $params{stderr}; + my $timeout = undef; my $timeout_exception = 'psql timed out'; - my @psql_params = ('psql', '-XAtq', '-d', $self->connstr($dbname), '-f', '-'); + my @psql_params = + ('psql', '-XAtq', '-d', $self->connstr($dbname), '-f', '-'); $params{on_error_stop} = 1 unless defined $params{on_error_stop}; - $params{on_error_die} = 0 unless defined $params{on_error_die}; + $params{on_error_die} = 0 unless defined $params{on_error_die}; push @psql_params, '-v', 'ON_ERROR_STOP=1' if $params{on_error_stop}; - push @psql_params, @{$params{extra_params}} if defined $params{extra_params}; + push @psql_params, @{ $params{extra_params} } + if defined $params{extra_params}; - $timeout = IPC::Run::timeout( $params{timeout}, exception => $timeout_exception) - if (defined($params{timeout})); + $timeout = + IPC::Run::timeout($params{timeout}, exception => $timeout_exception) + if (defined($params{timeout})); # IPC::Run would otherwise append to existing contents: $$stdout = "" if ref($stdout); @@ -1015,37 +1032,48 @@ sub psql_expert my $ret; - # Perl's exception handling is ... interesting. Especially since we have to - # support 5.8.8. So we hide that from the caller, returning true/false for - # timeout instead. See - # http://search.cpan.org/~ether/Try-Tiny-0.24/lib/Try/Tiny.pm for - # background. - my $error = do { + # Perl's exception handling is ... interesting. Especially since we have to + # support 5.8.8. So we hide that from the caller, returning true/false for + # timeout instead. See + # http://search.cpan.org/~ether/Try-Tiny-0.24/lib/Try/Tiny.pm for + # background. + my $error = do + { local $@; eval { - IPC::Run::run \@psql_params, '<', \$sql, '>', $stdout, '2>', $stderr, $timeout; + IPC::Run::run \@psql_params, '<', \$sql, '>', $stdout, '2>', + $stderr, $timeout; $ret = $?; }; my $exc_save = $@; - if ($exc_save) { - # IPC::Run::run threw an exception. re-throw unless it's a - # timeout, which we'll handle by testing is_expired - if (blessed($exc_save) || $exc_save ne $timeout_exception) { - print "Exception from IPC::Run::run when invoking psql: '$exc_save'\n"; - die $exc_save; - } else { - $ret = undef; - - die "Got timeout exception '$exc_save' but timer not expired?!" + if ($exc_save) + { + # IPC::Run::run threw an exception. re-throw unless it's a + # timeout, which we'll handle by testing is_expired + if (blessed($exc_save) || $exc_save ne $timeout_exception) + { + print +"Exception from IPC::Run::run when invoking psql: '$exc_save'\n"; + die $exc_save; + } + else + { + $ret = undef; + + die + "Got timeout exception '$exc_save' but timer not expired?!" unless $timeout->is_expired; - if (defined($params{timed_out})) - { - ${$params{timed_out}} = 1; - } else { - die "psql timed out while running '@psql_params', stderr '$$stderr'"; - } - } + if (defined($params{timed_out})) + { + ${ $params{timed_out} } = 1; + } + else + { + die +"psql timed out while running '@psql_params', stderr '$$stderr'"; + } + } } }; @@ -1060,20 +1088,26 @@ sub psql_expert # # We always die on signal. If someone wants to capture signals # to psql we can return it with another reference out parameter. - die "psql exited with signal " . ($ret & 127) . ": '$$stderr' while running '@psql_params'" + die "psql exited with signal " + . ($ret & 127) + . ": '$$stderr' while running '@psql_params'" if $ret & 127; die "psql exited with core dump: '$$stderr' while running '@psql_params'" if $ret & 128; $ret = $ret >> 8; - if ($ret && $params{on_error_die}) { - die "psql command line syntax error or internal error: '$$stderr' while running '@psql_params'" - if $ret == 1; - die "psql connection error: '$$stderr' while running '@psql_params'" - if $ret == 2; - die "error when running passed SQL: '$$stderr' while running '@psql_params'" - if $ret == 3; - die "unexpected error code $ret from psql: '$$stderr' while running '@psql_params'"; + if ($ret && $params{on_error_die}) + { + die +"psql command line syntax error or internal error: '$$stderr' while running '@psql_params'" + if $ret == 1; + die "psql connection error: '$$stderr' while running '@psql_params'" + if $ret == 2; + die +"error when running passed SQL: '$$stderr' while running '@psql_params'" + if $ret == 3; + die +"unexpected error code $ret from psql: '$$stderr' while running '@psql_params'"; } return $ret; diff --git a/src/test/perl/README b/src/test/perl/README index 7b6de5f..9eae159 100644 --- a/src/test/perl/README +++ b/src/test/perl/README @@ -11,6 +11,9 @@ isolation tester specs in src/test/isolation, if possible. If not, check to see if your new tests make sense under an existing tree in src/test, like src/test/ssl, or should be added to one of the suites for an existing utility. +Note that all tests and test tools should have perltidy run on them before +patches are submitted, using perltidy --profile=src/tools/pgindent/perltidyrc + Writing tests ------------- diff --git a/src/test/perl/SimpleTee.pm b/src/test/perl/SimpleTee.pm index 5da82d0..ea2f2ee 100644 --- a/src/test/perl/SimpleTee.pm +++ b/src/test/perl/SimpleTee.pm @@ -10,17 +10,20 @@ package SimpleTee; use strict; -sub TIEHANDLE { +sub TIEHANDLE +{ my $self = shift; bless \@_, $self; } -sub PRINT { +sub PRINT +{ my $self = shift; - my $ok = 1; - for my $fh (@$self) { + my $ok = 1; + for my $fh (@$self) + { print $fh @_ or $ok = 0; - $fh->flush or $ok = 0; + $fh->flush or $ok = 0; } return $ok; } -- 2.1.0