Replace dynamically built class hierarchies in I/O layer with fixed parent() calls.

doc/xml/release.xml

@@ -54,6 +54,10 @@
                         <p>Improve protocol error handling.  In particular, <quote>stop</quote> errors are no longer reported as <quote>unexpected</quote>.</p>
                     </release-item>
 
+                    <release-item>
+                        <p>Replace dynamically built class hierarchies in I/O layer with fixed <code>parent()</code> calls.</p>
+                    </release-item>
+
                     <release-item>
                         <p>Improve labeling for errors in helper processes.</p>
                     </release-item>

lib/pgBackRest/Backup/Filter/PageChecksum.pm

@@ -2,6 +2,7 @@
 # Backup Page Checksum Filter
 ####################################################################################################################################
 package pgBackRest::Backup::Filter::PageChecksum;
+use parent 'pgBackRest::Common::Io::Filter';
 
 use strict;
 use warnings FATAL => qw(all);
@@ -35,8 +36,6 @@ if (libC())
 ####################################################################################################################################
 # CONSTRUCTOR
 ####################################################################################################################################
-our @ISA = ();                                                      ## no critic (ClassHierarchies::ProhibitExplicitISA)
-
 sub new
 {
     my $class = shift;
@@ -45,7 +44,7 @@ sub new
     my
     (
         $strOperation,
-        $self,
+        $oParent,
         $iSegmentNo,
         $iWalId,
         $iWalOffset,
@@ -53,14 +52,14 @@ sub new
         logDebugParam
         (
             __PACKAGE__ . '->new', \@_,
-            {name => 'self', trace => true},
+            {name => 'oParent', trace => true},
             {name => 'iSegmentNo', trace => true},
             {name => 'iWalId', trace => true},
             {name => 'iWalOffset', trace => true},
         );
 
     # Bless with new class
-    @ISA = $self->isA();                                            ## no critic (ClassHierarchies::ProhibitExplicitISA)
+    my $self = $class->SUPER::new($oParent);
     bless $self, $class;
 
     # Set variables
@@ -90,7 +89,7 @@ sub read
     my $iSize = shift;
 
     # Call the io method
-    my $iActualSize = $self->SUPER::read($rtBuffer, $iSize);
+    my $iActualSize = $self->parent()->read($rtBuffer, $iSize);
 
     # Validate page checksums for the read block
     if ($iActualSize > 0)
@@ -172,7 +171,7 @@ sub close
         undef($self->{hResult});
 
         # Close io
-        return $self->SUPER::close();
+        return $self->parent()->close();
     }
 }
 

lib/pgBackRest/Common/Http/Client.pm

@@ -2,6 +2,7 @@
 # HTTP Client
 ####################################################################################################################################
 package pgBackRest::Common::Http::Client;
+use parent 'pgBackRest::Common::Io::Buffered';
 
 use strict;
 use warnings FATAL => qw(all);
@@ -37,8 +38,6 @@ use constant HTTP_HEADER_TRANSFER_ENCODING                          => 'transfer
 ####################################################################################################################################
 # new
 ####################################################################################################################################
-our @ISA = ();                                                      ## no critic (ClassHierarchies::ProhibitExplicitISA)
-
 sub new
 {
     my $class = shift;
@@ -117,12 +116,9 @@ sub new
                     ERROR_HOST_CONNECT, coalesce(length($!) == 0 ? undef : $!, $SSL_ERROR), length($!) > 0 ? $SSL_ERROR : undef);
             }
 
-            # Create the buffered IO object
+            # Bless with new class
-            $self = new pgBackRest::Common::Io::Buffered(
+            $self = $class->SUPER::new(
                 new pgBackRest::Common::Io::Handle('httpClient', $oSocket, $oSocket), $iProtocolTimeout, $lBufferMax);
-
-            # Bless with the class
-            @ISA = $self->isA();                                    ## no critic (ClassHierarchies::ProhibitExplicitISA)
             bless $self, $class;
 
             # Store socket

lib/pgBackRest/Common/Io/Base.pm

@@ -1,5 +1,5 @@
 ####################################################################################################################################
-# Base IO/Filter Module
+# Base IO Module
 ####################################################################################################################################
 package pgBackRest::Common::Io::Base;
 
@@ -48,9 +48,6 @@ sub new
             {name => 'strId', trace => true},
         );
 
-    # Initialize the ISA stack
-    $self->{stryIsA} = [COMMON_IO_BASE];
-
     # Return from function and log return values if any
     return logDebugReturn
     (
@@ -72,18 +69,6 @@ sub error
     logErrorResult($iCode, $strMessage, $strDetail);
 }
 
-####################################################################################################################################
-# isA - get the list of parent classes and add the current class
-####################################################################################################################################
-sub isA
-{
-    my $self = shift;
-
-    unshift(@{$self->{stryIsA}}, $self->className());
-
-    return @{$self->{stryIsA}};
-}
-
 ####################################################################################################################################
 # result - retrieve a result from io or a filter
 ####################################################################################################################################
@@ -100,6 +85,14 @@ sub result
     return $self->{rhResult}{$strModule};
 }
 
+####################################################################################################################################
+# resultAll - get all results
+####################################################################################################################################
+sub resultAll
+{
+    shift->{rhResult};
+}
+
 ####################################################################################################################################
 # resultSet - set a result from io or a filter
 ####################################################################################################################################

lib/pgBackRest/Common/Io/Buffered.pm

@@ -2,6 +2,7 @@
 # Buffered Handle IO
 ####################################################################################################################################
 package pgBackRest::Common::Io::Buffered;
+use parent 'pgBackRest::Common::Io::Filter';
 
 use strict;
 use warnings FATAL => qw(all);
@@ -15,6 +16,7 @@ use Time::HiRes qw(gettimeofday);
 
 use pgBackRest::Common::Exception;
 use pgBackRest::Common::Io::Base;
+use pgBackRest::Common::Io::Handle;
 use pgBackRest::Common::Log;
 use pgBackRest::Common::Wait;
 
@@ -27,8 +29,6 @@ use constant COMMON_IO_BUFFERED                                     => __PACKAGE
 ####################################################################################################################################
 # CONSTRUCTOR
 ####################################################################################################################################
-our @ISA = ();                                                      ## no critic (ClassHierarchies::ProhibitExplicitISA)
-
 sub new
 {
     my $class = shift;
@@ -37,20 +37,20 @@ sub new
     my
     (
         $strOperation,
-        $self,
+        $oParent,
         $iTimeout,
         $lBufferMax,
     ) =
         logDebugParam
         (
             __PACKAGE__ . '->new', \@_,
-            {name => 'self', trace => true},
+            {name => 'oParent', trace => true},
             {name => 'iTimeout', default => 0, trace => true},
             {name => 'lBufferMax', default => COMMON_IO_BUFFER_MAX, trace => true},
         );
 
     # Bless with new class
-    @ISA = $self->isA();                                            ## no critic (ClassHierarchies::ProhibitExplicitISA)
+    my $self = $class->SUPER::new($oParent);
     bless $self, $class;
 
     # Set write handle so select object is created
@@ -110,7 +110,7 @@ sub read
         if ($self->{oReadSelect}->can_read($fRemaining))
         {
             # Read data into the buffer
-            my $iReadSize = $self->SUPER::read($tBufferRef, $iRemainingSize);
+            my $iReadSize = $self->parent()->read($tBufferRef, $iRemainingSize);
 
             # Check for EOF
             if ($iReadSize == 0)
@@ -177,7 +177,7 @@ sub readLine
 
             if ($self->{oReadSelect}->can_read($fRemaining))
             {
-                $iBufferRead = $self->SUPER::read(
+                $iBufferRead = $self->parent()->read(
                     \$self->{tBuffer},
                     $self->{lBufferSize} >= $self->bufferMax() ? $self->bufferMax() : $self->bufferMax() - $self->{lBufferSize});
 
@@ -240,7 +240,7 @@ sub writeLine
     my $strBuffer = shift;
 
     $strBuffer .= "\n";
-    return $self->SUPER::write(\$strBuffer);
+    return $self->parent()->write(\$strBuffer);
 }
 
 ####################################################################################################################################
@@ -257,7 +257,7 @@ sub handleReadSet
     my $self = shift;
     my $fhRead = shift;
 
-    $self->SUPER::handleReadSet($fhRead);
+    $self->parent()->handleReadSet($fhRead);
 
     $self->{oReadSelect} = IO::Select->new();
     $self->{oReadSelect}->add($self->handleRead());

lib/pgBackRest/Common/Io/Filter.pm

@@ -0,0 +1,76 @@
+####################################################################################################################################
+# Base Filter Module
+####################################################################################################################################
+package pgBackRest::Common::Io::Filter;
+
+use strict;
+use warnings FATAL => qw(all);
+use Carp qw(confess);
+use English '-no_match_vars';
+
+use Exporter qw(import);
+    our @EXPORT = qw();
+use Scalar::Util qw(blessed);
+
+use pgBackRest::Common::Log;
+
+####################################################################################################################################
+# new
+####################################################################################################################################
+sub new
+{
+    my $class = shift;
+
+    # Create the class hash
+    my $self = {};
+    bless $self, $class;
+
+    # Assign function parameters, defaults, and log debug info
+    (
+        my $strOperation,
+        $self->{oParent},
+    ) =
+        logDebugParam
+        (
+            __PACKAGE__ . '->new', \@_,
+            {name => 'oParent', trace => true},
+        );
+
+    # Return from function and log return values if any
+    return logDebugReturn
+    (
+        $strOperation,
+        {name => 'self', value => $self}
+    );
+}
+
+####################################################################################################################################
+# Pass through for unimplemented methods
+####################################################################################################################################
+sub bufferMax {shift->{oParent}->bufferMax()};
+sub className {shift->{oParent}->className()};
+sub close {shift->{oParent}->close()};
+sub eof {shift->{oParent}->eof()};
+sub error {shift->{oParent}->error(@_)};
+sub id {shift->{oParent}->id()};
+sub handleRead {shift->{oParent}->handleRead()};
+sub handleReadSet {shift->{oParent}->handleReadSet(@_)};
+sub handleWrite {shift->{oParent}->handleWrite()};
+sub handleWriteSet {shift->{oParent}->handleWriteSet(@_)};
+sub name {shift->{oParent}->name()};
+sub read {shift->{oParent}->read(@_)};
+sub readLine {shift->{oParent}->readLine(@_)};
+sub result {shift->{oParent}->result(@_)};
+sub resultAll {shift->{oParent}->resultAll()};
+sub resultSet {shift->{oParent}->resultSet(@_)};
+sub size {shift->{oParent}->size()};
+sub timeout {shift->{oParent}->timeout()};
+sub write {shift->{oParent}->write(@_)};
+sub writeLine {shift->{oParent}->writeLine(@_)};
+
+####################################################################################################################################
+# Getters
+####################################################################################################################################
+sub parent {shift->{oParent}}
+
+1;

lib/pgBackRest/Common/Io/Process.pm

@@ -2,6 +2,7 @@
 # Process Excecution, Management, and IO
 ####################################################################################################################################
 package pgBackRest::Common::Io::Process;
+use parent 'pgBackRest::Common::Io::Filter';
 
 use strict;
 use warnings FATAL => qw(all);
@@ -33,8 +34,6 @@ use constant IO_ERROR_TIMEOUT                                                =>
 ####################################################################################################################################
 # new - use open3 to run the command and get the io handles
 ####################################################################################################################################
-our @ISA = ();                                                      ## no critic (ClassHierarchies::ProhibitExplicitISA)
-
 sub new
 {
     my $class = shift;
@@ -43,18 +42,18 @@ sub new
     my
     (
         $strOperation,
-        $self,
+        $oParent,
         $strCommand,
     ) =
         logDebugParam
         (
             __PACKAGE__ . '->new', \@_,
-            {name => 'self', trace => true},
+            {name => 'oParent', trace => true},
             {name => 'strCommand', trace => true},
         );
 
     # Bless with new class
-    @ISA = $self->isA();                                            ## no critic (ClassHierarchies::ProhibitExplicitISA)
+    my $self = $class->SUPER::new($oParent);
     bless $self, $class;
 
     # Use open3 to run the command
@@ -133,7 +132,7 @@ sub error
 
         if (defined($iCode))
         {
-            $self->SUPER::error($iCode, $strMessage, $strDetail);
+            $self->parent()->error($iCode, $strMessage, $strDetail);
         }
     }
     else
@@ -164,7 +163,7 @@ sub writeLine
     # abort if the remote process has already closed)
     $self->error();
 
-    return $self->SUPER::writeLine($strBuffer);
+    return $self->parent()->writeLine($strBuffer);
 }
 
 ####################################################################################################################################
@@ -179,7 +178,7 @@ sub close
         $self->error(undef, undef, undef, true);
 
         # Class parent close
-        $self->SUPER::close();
+        $self->parent()->close();
     }
 
     return true;

lib/pgBackRest/Protocol/Storage/File.pm

@@ -140,7 +140,7 @@ sub close
         # On minion write the results
         else
         {
-            $self->{oProtocol}->outputWrite($self->{oFileIo}->{rhResult});
+            $self->{oProtocol}->outputWrite($self->{oFileIo}->resultAll());
         }
 
         # Delete protocol to prevent close from running again

lib/pgBackRest/Storage/Filter/Gzip.pm

@@ -2,6 +2,7 @@
 # GZIP Filter
 ####################################################################################################################################
 package pgBackRest::Storage::Filter::Gzip;
+use parent 'pgBackRest::Common::Io::Filter';
 
 use strict;
 use warnings FATAL => qw(all);
@@ -26,8 +27,6 @@ use constant STORAGE_FILTER_GZIP                                    => __PACKAGE
 ####################################################################################################################################
 # CONSTRUCTOR
 ####################################################################################################################################
-our @ISA = ();                                                      ## no critic (ClassHierarchies::ProhibitExplicitISA)
-
 sub new
 {
     my $class = shift;
@@ -36,7 +35,7 @@ sub new
     my
     (
         $strOperation,
-        $self,
+        $oParent,
         $bWantGzip,
         $strCompressType,
         $iLevel,
@@ -45,7 +44,7 @@ sub new
         logDebugParam
         (
             __PACKAGE__ . '->new', \@_,
-            {name => 'self', trace => true},
+            {name => 'oParent', trace => true},
             {name => 'bWantGzip', optional => true, default => true, trace => true},
             {name => 'strCompressType', optional => true, default => STORAGE_COMPRESS, trace => true},
             {name => 'iLevel', optional => true, default => 6, trace => true},
@@ -53,7 +52,7 @@ sub new
         );
 
     # Bless with new class
-    @ISA = $self->isA();                                            ## no critic (ClassHierarchies::ProhibitExplicitISA)
+    my $self = $class->SUPER::new($oParent);
     bless $self, $class;
 
     # Set variables
@@ -108,7 +107,8 @@ sub errorCheck
     {
         logErrorResult(
             $self->{bWrite} ? ERROR_FILE_WRITE : ERROR_FILE_READ,
-            'unable to ' . ($self->{strCompressType} eq STORAGE_COMPRESS ? 'deflate' : 'inflate') . " '$self->{strName}'",
+            'unable to ' . ($self->{strCompressType} eq STORAGE_COMPRESS ? 'deflate' : 'inflate') . " '" .
+                $self->parent()->name() . "'",
             $self->{oZLib}->msg());
     }
 
@@ -135,7 +135,7 @@ sub read
         do
         {
             my $tUncompressedBuffer;
-            $lUncompressedSize = $self->SUPER::read(\$tUncompressedBuffer, $iSize);
+            $lUncompressedSize = $self->parent()->read(\$tUncompressedBuffer, $iSize);
 
             if ($lUncompressedSize > 0)
             {
@@ -162,7 +162,7 @@ sub read
             {
                 if (!defined($self->{tCompressedBuffer}) || length($self->{tCompressedBuffer}) == 0)
                 {
-                    $self->SUPER::read(\$self->{tCompressedBuffer}, $self->{lCompressBufferMax});
+                    $self->parent()->read(\$self->{tCompressedBuffer}, $self->{lCompressBufferMax});
                 }
 
                 my $iZLibStatus = $self->{oZLib}->inflate($self->{tCompressedBuffer}, $self->{tUncompressedBuffer});
@@ -208,7 +208,7 @@ sub write
         # Only write when buffer is full
         if (defined($self->{tCompressedBuffer}) && length($self->{tCompressedBuffer}) > $self->{lCompressBufferMax})
         {
-            $self->SUPER::write(\$self->{tCompressedBuffer});
+            $self->parent()->write(\$self->{tCompressedBuffer});
             $self->{tCompressedBuffer} = undef;
         }
     }
@@ -221,7 +221,7 @@ sub write
             my $tUncompressedBuffer;
 
             my $iZLibStatus = $self->{oZLib}->inflate($tCompressedBuffer, $tUncompressedBuffer);
-            $self->SUPER::write(\$tUncompressedBuffer);
+            $self->parent()->write(\$tUncompressedBuffer);
 
             last if $iZLibStatus == Z_STREAM_END;
 
@@ -251,14 +251,14 @@ sub close
                 $self->errorCheck($self->{oZLib}->flush($self->{tCompressedBuffer}));
 
                 # Write last compressed bytes
-                $self->SUPER::write(\$self->{tCompressedBuffer});
+                $self->parent()->write(\$self->{tCompressedBuffer});
             }
         }
 
         undef($self->{oZLib});
 
         # Close io
-        return $self->SUPER::close();
+        return $self->parent()->close();
     }
 }
 

lib/pgBackRest/Storage/Filter/Sha.pm

@@ -2,6 +2,7 @@
 # SHA Filter
 ####################################################################################################################################
 package pgBackRest::Storage::Filter::Sha;
+use parent 'pgBackRest::Common::Io::Filter';
 
 use strict;
 use warnings FATAL => qw(all);
@@ -23,8 +24,6 @@ use constant STORAGE_FILTER_SHA                                     => __PACKAGE
 ####################################################################################################################################
 # CONSTRUCTOR
 ####################################################################################################################################
-our @ISA = ();                                                      ## no critic (ClassHierarchies::ProhibitExplicitISA)
-
 sub new
 {
     my $class = shift;
@@ -33,18 +32,18 @@ sub new
     my
     (
         $strOperation,
-        $self,
+        $oParent,
         $strAlgorithm,
     ) =
         logDebugParam
         (
             __PACKAGE__ . '->new', \@_,
-            {name => 'self', trace => true},
+            {name => 'oParent', trace => true},
             {name => 'strAlgorithm', optional => true, default => 'sha1', trace => true},
         );
 
     # Bless with new class
-    @ISA = $self->isA();                                            ## no critic (ClassHierarchies::ProhibitExplicitISA)
+    my $self = $class->SUPER::new($oParent);
     bless $self, $class;
 
     # Set variables
@@ -72,7 +71,7 @@ sub read
 
     # Call the io method
     my $tShaBuffer;
-    my $iActualSize = $self->SUPER::read(\$tShaBuffer, $iSize);
+    my $iActualSize = $self->parent()->read(\$tShaBuffer, $iSize);
 
     # Calculate sha for the returned buffer
     if ($iActualSize > 0)
@@ -97,7 +96,7 @@ sub write
     $self->{oSha}->add($$rtBuffer);
 
     # Call the io method
-    return $self->SUPER::write($rtBuffer);
+    return $self->parent()->write($rtBuffer);
 }
 
 ####################################################################################################################################
@@ -116,8 +115,10 @@ sub close
         delete($self->{oSha});
 
         # Close io
-        return $self->SUPER::close();
+        return $self->parent->close();
     }
+
+    return false;
 }
 
 1;

lib/pgBackRest/Storage/Posix/FileRead.pm

@@ -100,5 +100,6 @@ sub close
 # Getters
 ####################################################################################################################################
 sub handle {shift->{fhFile}}
+sub name {shift->{strName}}
 
 1;

lib/pgBackRest/Storage/Posix/FileWrite.pm

@@ -188,7 +188,8 @@ sub close
 ####################################################################################################################################
 # Getters
 ####################################################################################################################################
-sub opened {shift->{bOpened}}
 sub handle {shift->{fhFile}}
+sub opened {shift->{bOpened}}
+sub name {shift->{strName}}
 
 1;

lib/pgBackRest/Storage/S3/FileRead.pm

@@ -2,7 +2,7 @@
 # S3 File Read
 ####################################################################################################################################
 package pgBackRest::Storage::S3::FileRead;
-use parent 'pgBackRest::Common::Io::Base';
+use parent 'pgBackRest::Common::Http::Client';
 
 use strict;
 use warnings FATAL => qw(all);
@@ -22,8 +22,6 @@ use pgBackRest::Storage::S3::Request;
 ####################################################################################################################################
 # CONSTRUCTOR
 ####################################################################################################################################
-our @ISA = ();                                                      ## no critic (ClassHierarchies::ProhibitExplicitISA)
-
 sub new
 {
     my $class = shift;
@@ -51,7 +49,6 @@ sub new
     # Bless with new class if file exists
     if (defined($self))
     {
-        @ISA = $self->isA();                                        ## no critic (ClassHierarchies::ProhibitExplicitISA)
         bless $self, $class;
     }
 
@@ -63,4 +60,9 @@ sub new
     );
 }
 
+####################################################################################################################################
+# Getters
+####################################################################################################################################
+sub name {shift->{strName}}
+
 1;

lib/pgBackRest/Storage/S3/FileWrite.pm

@@ -190,5 +190,6 @@ sub close
 # Getters
 ####################################################################################################################################
 sub opened {defined(shift->{strUploadId})}
+sub name {shift->{strName}}
 
 1;

test/lib/pgBackRestTest/Common/DefineTest.pm

@@ -164,7 +164,7 @@ my $oTestDef =
                 },
                 {
                     &TESTDEF_NAME => 'io-handle',
-                    &TESTDEF_TOTAL => 7,
+                    &TESTDEF_TOTAL => 6,
 
                     &TESTDEF_COVERAGE =>
                     {

test/lib/pgBackRestTest/Module/Archive/ArchivePushTest.pm

@@ -86,7 +86,7 @@ sub initOption
 
     $self->optionTestSet(CFGOPT_DB_TIMEOUT, 5);
     $self->optionTestSet(CFGOPT_PROTOCOL_TIMEOUT, 6);
-    $self->optionTestSet(CFGOPT_ARCHIVE_TIMEOUT, 3);
+    $self->optionTestSet(CFGOPT_ARCHIVE_TIMEOUT, 5);
 }
 
 ####################################################################################################################################

test/lib/pgBackRestTest/Module/Common/CommonIoHandleTest.pm

@@ -172,17 +172,6 @@ sub run
         $self->testResult(sub {$oIoHandle->{rhResult}}, '{Module::1 => 1, Module::2 => {value => 2}}', '    check all results');
     }
 
-    ################################################################################################################################
-    if ($self->begin('isA()'))
-    {
-        #---------------------------------------------------------------------------------------------------------------------------
-        my $oIoHandle = $self->testResult(
-            sub {new pgBackRest::Common::Io::Handle('test', undef, undef)}, '[object]', 'new - no handles');
-
-        $self->testResult(
-            sub {$oIoHandle->isA()}, '(' . COMMON_IO_HANDLE . ', ' . COMMON_IO_BASE . ')', '    check isA');
-    }
-
     ################################################################################################################################
     if ($self->begin('className()'))
     {

test/lib/pgBackRestTest/Module/Storage/StorageFilterShaTest.pm

@@ -72,6 +72,7 @@ sub run
         $self->testResult(sub {$oShaIo->read(\$tBuffer, 1)}, 0, '    read 0 bytes');
 
         $self->testResult(sub {$oShaIo->close()}, true, '    close');
+        $self->testResult(sub {$oShaIo->close()}, false, '    close again to make sure nothing bad happens');
         $self->testResult($oShaIo->result(STORAGE_FILTER_SHA), '1c7e00fd09b9dd11fc2966590b3e3274645dd031', '    check hash');
         $self->testResult(sha1_hex($tBuffer), '1c7e00fd09b9dd11fc2966590b3e3274645dd031', '    check content');
     }

test/lib/pgBackRestTest/Module/Storage/StorageS3Test.pm

@@ -185,6 +185,7 @@ sub run
 
         #---------------------------------------------------------------------------------------------------------------------------
         my $oFileWrite = $self->testResult(sub {$oS3->openWrite("/path/to/${strFile}")}, '[object]', 'open write');
+        $self->testResult(sub {$oFileWrite->name()}, "/path/to/${strFile}", '    check filename');
         $self->testResult(sub {$oFileWrite->close()}, true, '    close without writing');
 
         #---------------------------------------------------------------------------------------------------------------------------