diff --git a/CHANGELOG.md b/CHANGELOG.md
index 375ac32b6..2170f9e31 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -9,6 +9,8 @@ __No Release Date Set__
* Rename `--no-start-stop` option to `--no-online`.
+* Static source analysis using Perl-Critic, currently passes on gentle.
+
## v0.90: 9.5 Support, Various Enhancements, and Minor Bug Fixes
__Released February 7, 2016__
diff --git a/doc/lib/BackRestDoc/Common/DocConfig.pm b/doc/lib/BackRestDoc/Common/DocConfig.pm
index d622a6d90..0d11f5b99 100644
--- a/doc/lib/BackRestDoc/Common/DocConfig.pm
+++ b/doc/lib/BackRestDoc/Common/DocConfig.pm
@@ -246,69 +246,6 @@ sub helpDataWrite
{name => 'oManifest'}
);
- # Internal function used to format text by quoting it and splitting lines so it looks good in the module.
- sub formatText
- {
- my $oManifest = shift;
- my $oDocRender = shift;
- my $oText = shift;
- my $iIndent = shift;
- my $iLength = shift;
-
- # Split the string into lines for processing
- my @stryText = split("\n", trim($oManifest->variableReplace($oDocRender->processText($oText))));
- my $strText;
- my $iIndex = 0;
-
- foreach my $strLine (@stryText)
- {
- # Add a linefeed if this is not the first line
- if (defined($strText))
- {
- $strText .= " .\n";
- }
-
- # Escape perl special characters
- $strLine =~ s/\@/\\@/g;
- $strLine =~ s/\$/\\\$/g;
- $strLine =~ s/\"/\\"/g;
-
- my $strPart;
- my $bFirst = true;
-
- # Split the line for output if it's too long
- do
- {
- ($strPart, $strLine) = stringSplit($strLine, ' ', defined($strPart) ? $iLength - 4 : $iLength);
-
- $strText .= ' ' x $iIndent;
-
- if (!$bFirst)
- {
- $strText .= " ";
- }
-
- $strText .= "\"${strPart}";
-
- if (defined($strLine))
- {
- $strText .= "\" .\n";
- }
- else
- {
- $strText .= ($iIndex + 1 < @stryText ? '\n' : '') . '"';
- }
-
- $bFirst = false;
- }
- while (defined($strLine));
-
- $iIndex++;
- }
-
- return $strText;
- }
-
# Iterate options
my $oConfigHash = $self->{oConfigHash};
my $strOptionData;
@@ -331,9 +268,9 @@ sub helpDataWrite
(defined($$oOptionHash{&CONFIG_HELP_SECTION}) ? ' ' . &CONFIG_HELP_SECTION .
' => \'' . $$oOptionHash{&CONFIG_HELP_SECTION} . "',\n" : '') .
' ' . &CONFIG_HELP_SUMMARY . " =>\n" .
- formatText($oManifest, $self->{oDocRender}, $$oOptionHash{&CONFIG_HELP_SUMMARY}, 16, 112) . ",\n" .
+ helpDataWriteFormatText($oManifest, $self->{oDocRender}, $$oOptionHash{&CONFIG_HELP_SUMMARY}, 16, 112) . ",\n" .
' ' . &CONFIG_HELP_DESCRIPTION . " =>\n" .
- formatText($oManifest, $self->{oDocRender}, $$oOptionHash{&CONFIG_HELP_DESCRIPTION}, 16, 112) . "\n" .
+ helpDataWriteFormatText($oManifest, $self->{oDocRender}, $$oOptionHash{&CONFIG_HELP_DESCRIPTION}, 16, 112) . "\n" .
" }";
}
@@ -356,9 +293,9 @@ sub helpDataWrite
" '${strCommand}' =>\n" .
" {\n" .
' ' . &CONFIG_HELP_SUMMARY . " =>\n" .
- formatText($oManifest, $self->{oDocRender}, $$oCommandHash{&CONFIG_HELP_SUMMARY}, 16, 112) . ",\n" .
+ helpDataWriteFormatText($oManifest, $self->{oDocRender}, $$oCommandHash{&CONFIG_HELP_SUMMARY}, 16, 112) . ",\n" .
' ' . &CONFIG_HELP_DESCRIPTION . " =>\n" .
- formatText($oManifest, $self->{oDocRender}, $$oCommandHash{&CONFIG_HELP_DESCRIPTION}, 16, 112) . ",\n" .
+ helpDataWriteFormatText($oManifest, $self->{oDocRender}, $$oCommandHash{&CONFIG_HELP_DESCRIPTION}, 16, 112) . ",\n" .
"\n";
# Iterate options
@@ -395,9 +332,11 @@ sub helpDataWrite
" '${strOption}' =>\n" .
" {\n" .
' ' . &CONFIG_HELP_SUMMARY . " =>\n" .
- formatText($oManifest, $self->{oDocRender}, $$oOptionHash{&CONFIG_HELP_SUMMARY}, 24, 104) . ",\n" .
+ helpDataWriteFormatText($oManifest, $self->{oDocRender},
+ $$oOptionHash{&CONFIG_HELP_SUMMARY}, 24, 104) . ",\n" .
' ' . &CONFIG_HELP_DESCRIPTION . " =>\n" .
- formatText($oManifest, $self->{oDocRender}, $$oOptionHash{&CONFIG_HELP_DESCRIPTION}, 24, 104) . "\n" .
+ helpDataWriteFormatText($oManifest, $self->{oDocRender},
+ $$oOptionHash{&CONFIG_HELP_DESCRIPTION}, 24, 104) . "\n" .
" }";
$bExtraLinefeed = true;
@@ -480,6 +419,69 @@ sub helpDataWrite
logDebugReturn($strOperation);
}
+# Helper function for helpDataWrite() used to format text by quoting it and splitting lines so it looks good in the module.
+sub helpDataWriteFormatText
+{
+ my $oManifest = shift;
+ my $oDocRender = shift;
+ my $oText = shift;
+ my $iIndent = shift;
+ my $iLength = shift;
+
+ # Split the string into lines for processing
+ my @stryText = split("\n", trim($oManifest->variableReplace($oDocRender->processText($oText))));
+ my $strText;
+ my $iIndex = 0;
+
+ foreach my $strLine (@stryText)
+ {
+ # Add a linefeed if this is not the first line
+ if (defined($strText))
+ {
+ $strText .= " .\n";
+ }
+
+ # Escape perl special characters
+ $strLine =~ s/\@/\\@/g;
+ $strLine =~ s/\$/\\\$/g;
+ $strLine =~ s/\"/\\"/g;
+
+ my $strPart;
+ my $bFirst = true;
+
+ # Split the line for output if it's too long
+ do
+ {
+ ($strPart, $strLine) = stringSplit($strLine, ' ', defined($strPart) ? $iLength - 4 : $iLength);
+
+ $strText .= ' ' x $iIndent;
+
+ if (!$bFirst)
+ {
+ $strText .= " ";
+ }
+
+ $strText .= "\"${strPart}";
+
+ if (defined($strLine))
+ {
+ $strText .= "\" .\n";
+ }
+ else
+ {
+ $strText .= ($iIndex + 1 < @stryText ? '\n' : '') . '"';
+ }
+
+ $bFirst = false;
+ }
+ while (defined($strLine));
+
+ $iIndex++;
+ }
+
+ return $strText;
+}
+
####################################################################################################################################
# helpConfigDocGet
#
@@ -552,76 +554,6 @@ sub helpCommandDocGet
# Assign function parameters, defaults, and log debug info
my $strOperation = logDebugParam(OP_DOC_CONFIG_HELP_CONFIG_DOC_GET);
- # Internal option find function
- #
- # The option may be stored with the command or in the option list depending on whether it's generic or command-specific
- sub optionFind
- {
- my $oConfigHelpData = shift;
- my $oOptionRule = shift;
- my $strCommand = shift;
- my $strOption = shift;
-
- my $strSection = CONFIG_HELP_COMMAND;
- my $oOption = $$oConfigHelpData{&CONFIG_HELP_COMMAND}{$strCommand}{&CONFIG_HELP_OPTION}{$strOption};
-
- if ($$oOption{&CONFIG_HELP_SOURCE} eq CONFIG_HELP_SOURCE_DEFAULT)
- {
- $strSection = CONFIG_SECTION_GENERAL;
- }
- elsif ($$oOption{&CONFIG_HELP_SOURCE} eq CONFIG_HELP_SOURCE_SECTION)
- {
- $oOption = $$oConfigHelpData{&CONFIG_HELP_OPTION}{$strOption};
-
- if (defined($$oOption{&CONFIG_HELP_SECTION}))
- {
- $strSection = $$oOption{&CONFIG_HELP_SECTION};
-
- if ($strSection eq CONFIG_SECTION_COMMAND)
- {
- $strSection = CONFIG_SECTION_GENERAL;
- }
- }
- else
- {
- $strSection = CONFIG_SECTION_GENERAL;
- }
-
- if (($strSection ne CONFIG_SECTION_GENERAL && $strSection ne CONFIG_SECTION_LOG &&
- $strSection ne CONFIG_SECTION_STANZA && $strSection ne CONFIG_SECTION_EXPIRE) ||
- $strSection eq $strCommand)
- {
- $strSection = CONFIG_HELP_COMMAND;
- }
- }
-
- # if (defined(optionDefault($strOption, $strCommand)))
- # {
- # if ($$oOptionRule{$strOption}{&OPTION_RULE_TYPE} eq &OPTION_TYPE_BOOLEAN)
- # {
- # $$oOption{&CONFIG_HELP_DEFAULT} = optionDefault($strOption, $strCommand) ? 'y' : 'n';
- # }
- # else
- # {
- # $$oOption{&CONFIG_HELP_DEFAULT} = optionDefault($strOption, $strCommand);
- # }
- # }
- #
- # if (optionTest($strOption) && optionSource($strOption) ne CONFIG_HELP_SOURCE_DEFAULT)
- # {
- # if ($$oOptionRule{$strOption}{&OPTION_RULE_TYPE} eq &OPTION_TYPE_BOOLEAN)
- # {
- # $$oOption{&CONFIG_HELP_CURRENT} = optionGet($strOption) ? 'y' : 'n';
- # }
- # else
- # {
- # $$oOption{&CONFIG_HELP_CURRENT} = optionGet($strOption);
- # }
- # }
-
- return $oOption, $strSection;
- }
-
# Working variables
my $oConfigHash = $self->{oConfigHash};
my $oOperationDoc = $self->{oDoc}->nodeGet('operation');
@@ -658,7 +590,7 @@ sub helpCommandDocGet
foreach my $strOption (sort(keys(%{$$oCommandHash{&CONFIG_HELP_OPTION}})))
{
- my ($oOption, $strCategory) = optionFind($oConfigHash, $oOptionRule, $strCommand, $strOption);
+ my ($oOption, $strCategory) = helpCommandDocGetOptionFind($oConfigHash, $oOptionRule, $strCommand, $strOption);
$$oCategory{$strCategory}{$strOption} = $oOption;
}
@@ -689,6 +621,51 @@ sub helpCommandDocGet
);
}
+# Helper function for helpCommandDocGet() to find options. The option may be stored with the command or in the option list depending
+# on whether it's generic or command-specific
+sub helpCommandDocGetOptionFind
+{
+ my $oConfigHelpData = shift;
+ my $oOptionRule = shift;
+ my $strCommand = shift;
+ my $strOption = shift;
+
+ my $strSection = CONFIG_HELP_COMMAND;
+ my $oOption = $$oConfigHelpData{&CONFIG_HELP_COMMAND}{$strCommand}{&CONFIG_HELP_OPTION}{$strOption};
+
+ if ($$oOption{&CONFIG_HELP_SOURCE} eq CONFIG_HELP_SOURCE_DEFAULT)
+ {
+ $strSection = CONFIG_SECTION_GENERAL;
+ }
+ elsif ($$oOption{&CONFIG_HELP_SOURCE} eq CONFIG_HELP_SOURCE_SECTION)
+ {
+ $oOption = $$oConfigHelpData{&CONFIG_HELP_OPTION}{$strOption};
+
+ if (defined($$oOption{&CONFIG_HELP_SECTION}))
+ {
+ $strSection = $$oOption{&CONFIG_HELP_SECTION};
+
+ if ($strSection eq CONFIG_SECTION_COMMAND)
+ {
+ $strSection = CONFIG_SECTION_GENERAL;
+ }
+ }
+ else
+ {
+ $strSection = CONFIG_SECTION_GENERAL;
+ }
+
+ if (($strSection ne CONFIG_SECTION_GENERAL && $strSection ne CONFIG_SECTION_LOG &&
+ $strSection ne CONFIG_SECTION_STANZA && $strSection ne CONFIG_SECTION_EXPIRE) ||
+ $strSection eq $strCommand)
+ {
+ $strSection = CONFIG_HELP_COMMAND;
+ }
+ }
+
+ return $oOption, $strSection;
+}
+
####################################################################################################################################
# helpOptionGet
#
diff --git a/doc/lib/BackRestDoc/Common/DocManifest.pm b/doc/lib/BackRestDoc/Common/DocManifest.pm
index f9edbaaea..7f6484e88 100644
--- a/doc/lib/BackRestDoc/Common/DocManifest.pm
+++ b/doc/lib/BackRestDoc/Common/DocManifest.pm
@@ -313,7 +313,7 @@ sub variableReplace
if (!defined($strBuffer))
{
- return undef;
+ return;
}
foreach my $strName (sort(keys(%{$self->{oVariable}})))
diff --git a/doc/xml/change-log.xml b/doc/xml/change-log.xml
index ebe661371..992c94fee 100644
--- a/doc/xml/change-log.xml
+++ b/doc/xml/change-log.xml
@@ -17,6 +17,9 @@
Rename --no-start-stop option to --no-online.
+
+ Static source analysis using Perl-Critic, currently passes on gentle.
+
diff --git a/lib/BackRest/Common/Ini.pm b/lib/BackRest/Common/Ini.pm
index 85fc1268f..aa22a5109 100644
--- a/lib/BackRest/Common/Ini.pm
+++ b/lib/BackRest/Common/Ini.pm
@@ -575,14 +575,14 @@ sub keys
{
if ($self->test($strSection, $strKey))
{
- return sort(keys(%{$self->get($strSection, $strKey)}));
+ return (sort(keys(%{$self->get($strSection, $strKey)})));
}
my @stryEmptyArray;
return @stryEmptyArray;
}
- return sort(keys(%{$self->{oContent}}));
+ return (sort(keys(%{$self->{oContent}})));
}
####################################################################################################################################
diff --git a/lib/BackRest/Common/Lock.pm b/lib/BackRest/Common/Lock.pm
index a4904939a..841a70e68 100644
--- a/lib/BackRest/Common/Lock.pm
+++ b/lib/BackRest/Common/Lock.pm
@@ -75,7 +75,7 @@ sub lockPathCreate
# Create the lock path if it does not exist. Use 770 so that members of the group can run read-only processes.
if (! -e lockPathName($strRepoPath))
{
- mkdir (lockPathName($strRepoPath), 0770)
+ mkdir (lockPathName($strRepoPath), oct(770))
or confess &log(ERROR, 'unable to create lock path ' . lockPathName($strRepoPath), ERROR_PATH_CREATE);
}
}
@@ -128,7 +128,7 @@ sub lockAcquire
# Attempt to open the lock file
$strCurrentLockFile = lockFileName($strLockType, optionGet(OPTION_STANZA, false), $strRepoPath, $bRemote, $iProcessIdx);
- sysopen($hCurrentLockHandle, $strCurrentLockFile, O_WRONLY | O_CREAT, 0640)
+ sysopen($hCurrentLockHandle, $strCurrentLockFile, O_WRONLY | O_CREAT, oct(640))
or confess &log(ERROR, "unable to open lock file ${strCurrentLockFile}", ERROR_FILE_OPEN);
# Attempt to lock the lock file
@@ -253,7 +253,7 @@ sub lockStop
}
# Create the stop file
- sysopen(my $hStopHandle, $strStopFile, O_WRONLY | O_CREAT, 0640)
+ sysopen(my $hStopHandle, $strStopFile, O_WRONLY | O_CREAT, oct(640))
or confess &log(ERROR, "unable to open stop file ${strStopFile}", ERROR_FILE_OPEN);
close($hStopHandle);
diff --git a/lib/BackRest/Common/String.pm b/lib/BackRest/Common/String.pm
index f2400d557..784d04353 100644
--- a/lib/BackRest/Common/String.pm
+++ b/lib/BackRest/Common/String.pm
@@ -64,7 +64,7 @@ sub trim
if (!defined($strBuffer))
{
- return undef;
+ return;
}
$strBuffer =~ s/^\s+|\s+$//g;
diff --git a/lib/BackRest/Common/Wait.pm b/lib/BackRest/Common/Wait.pm
index 8068dd3ce..03438a479 100644
--- a/lib/BackRest/Common/Wait.pm
+++ b/lib/BackRest/Common/Wait.pm
@@ -60,7 +60,7 @@ sub waitInit
# If wait seconds is not defined or 0 then return undef
if (!defined($fWaitTime) || $fWaitTime == 0)
{
- return undef;
+ return;
}
# Wait seconds can be a minimum of .1
diff --git a/lib/BackRest/Config/Config.pm b/lib/BackRest/Config/Config.pm
index 51a32191c..0d4bc6895 100644
--- a/lib/BackRest/Config/Config.pm
+++ b/lib/BackRest/Config/Config.pm
@@ -2004,7 +2004,7 @@ sub optionCommandRule
$oOptionRule{$strOption}{&OPTION_RULE_COMMAND}{$strCommand} : undef;
}
- return undef;
+ return;
}
####################################################################################################################################
@@ -2411,39 +2411,6 @@ sub commandWrite
# $strExeString .= ' --no-config';
# }
- # Function to correctly format options for command-line usage
- sub optionFormat
- {
- my $strOption = shift;
- my $bMulti = shift;
- my $oValue = shift;
-
- # Loops though all keys in the hash
- my $strOptionFormat = '';
- my $strParam;
-
- foreach my $strKey (sort(keys(%$oValue)))
- {
- # Get the value - if the original value was a hash then the key must be prefixed
- my $strValue = ($bMulti ? "${strKey}=" : '') . $$oValue{$strKey};
-
- # Handle the no- prefix for boolean values
- if ($oOptionRule{$strOption}{&OPTION_RULE_TYPE} eq OPTION_TYPE_BOOLEAN)
- {
- $strParam = '--' . ($strValue ? '' : 'no-') . $strOption;
- }
- else
- {
- $strParam = "--${strOption}=${strValue}";
- }
-
- # Add quotes if the value has spaces in it
- $strOptionFormat .= ' ' . (index($strValue, " ") != -1 ? "\"${strParam}\"" : $strParam);
- }
-
- return $strOptionFormat;
- }
-
# Iterate the options to figure out which ones are not default and need to be written out to the new command string
foreach my $strOption (sort(keys(%oOptionRule)))
{
@@ -2455,7 +2422,7 @@ sub commandWrite
{
if (defined($$oOptionOverride{$strOption}{value}))
{
- $strExeString .= optionFormat($strOption, false, {value => $$oOptionOverride{$strOption}{value}});
+ $strExeString .= commandWriteOptionFormat($strOption, false, {value => $$oOptionOverride{$strOption}{value}});
}
}
# else look for non-default options in the current configuration
@@ -2479,7 +2446,7 @@ sub commandWrite
$oValue = {value => $oOption{$strOption}{value}};
}
- $strExeString .= optionFormat($strOption, $bMulti, $oValue);
+ $strExeString .= commandWriteOptionFormat($strOption, $bMulti, $oValue);
}
}
@@ -2493,6 +2460,39 @@ sub commandWrite
push @EXPORT, qw(commandWrite);
+# Helper function for commandWrite() to correctly format options for command-line usage
+sub commandWriteOptionFormat
+{
+ my $strOption = shift;
+ my $bMulti = shift;
+ my $oValue = shift;
+
+ # Loops though all keys in the hash
+ my $strOptionFormat = '';
+ my $strParam;
+
+ foreach my $strKey (sort(keys(%$oValue)))
+ {
+ # Get the value - if the original value was a hash then the key must be prefixed
+ my $strValue = ($bMulti ? "${strKey}=" : '') . $$oValue{$strKey};
+
+ # Handle the no- prefix for boolean values
+ if ($oOptionRule{$strOption}{&OPTION_RULE_TYPE} eq OPTION_TYPE_BOOLEAN)
+ {
+ $strParam = '--' . ($strValue ? '' : 'no-') . $strOption;
+ }
+ else
+ {
+ $strParam = "--${strOption}=${strValue}";
+ }
+
+ # Add quotes if the value has spaces in it
+ $strOptionFormat .= ' ' . (index($strValue, " ") != -1 ? "\"${strParam}\"" : $strParam);
+ }
+
+ return $strOptionFormat;
+}
+
####################################################################################################################################
# commandHashGet
#
diff --git a/lib/BackRest/Config/ConfigHelp.pm b/lib/BackRest/Config/ConfigHelp.pm
index 4e8869f1b..261fa710a 100644
--- a/lib/BackRest/Config/ConfigHelp.pm
+++ b/lib/BackRest/Config/ConfigHelp.pm
@@ -115,120 +115,6 @@ sub configHelp
}
}
- # Internal text format function to make output look good on a console
- sub formatText
- {
- my $strTextIn = shift;
- my $iIndent = shift;
- my $bIndentFirst = shift;
- my $iLength = shift;
-
- my @stryText = split("\n", trim($strTextIn));
- my $strText;
- my $iIndex = 0;
-
- foreach my $strLine (@stryText)
- {
- if (defined($strText))
- {
- $strText .= "\n";
- }
-
- my $strPart;
- my $bFirst = true;
-
- do
- {
- ($strPart, $strLine) = stringSplit($strLine, ' ', $iLength - $iIndent);
-
- if (!$bFirst || $bIndentFirst)
- {
- if (!$bFirst)
- {
- $strText .= "\n";
- }
-
- $strText .= ' ' x $iIndent;
- }
-
- $strText .= trim($strPart);
-
- $bFirst = false;
- }
- while (defined($strLine));
-
- $iIndex++;
- }
-
- return $strText;
- }
-
- # Internal option find function
- #
- # The option may be stored with the command or in the option list depending on whether it's generic or command-specific
- sub optionFind
- {
- my $oConfigHelpData = shift;
- my $oOptionRule = shift;
- my $strCommand = shift;
- my $strOption = shift;
-
- my $strSection = CONFIG_HELP_COMMAND;
- my $oOption = $$oConfigHelpData{&CONFIG_HELP_COMMAND}{$strCommand}{&CONFIG_HELP_OPTION}{$strOption};
-
- if (ref(\$oOption) eq 'SCALAR')
- {
- $oOption = $$oConfigHelpData{&CONFIG_HELP_OPTION}{$strOption};
-
- if (defined($$oOption{&CONFIG_HELP_SECTION}))
- {
- $strSection = $$oOption{&CONFIG_HELP_SECTION};
-
- if ($strSection eq CONFIG_SECTION_COMMAND)
- {
- $strSection = CONFIG_SECTION_GENERAL;
- }
- }
- else
- {
- $strSection = CONFIG_SECTION_GENERAL;
- }
-
- if (($strSection ne CONFIG_SECTION_GENERAL && $strSection ne CONFIG_SECTION_LOG &&
- $strSection ne CONFIG_SECTION_STANZA && $strSection ne CONFIG_SECTION_EXPIRE) ||
- $strSection eq $strCommand)
- {
- $strSection = CONFIG_HELP_COMMAND;
- }
- }
-
- if (defined(optionDefault($strOption, $strCommand)))
- {
- if ($$oOptionRule{$strOption}{&OPTION_RULE_TYPE} eq &OPTION_TYPE_BOOLEAN)
- {
- $$oOption{&CONFIG_HELP_DEFAULT} = optionDefault($strOption, $strCommand) ? 'y' : 'n';
- }
- else
- {
- $$oOption{&CONFIG_HELP_DEFAULT} = optionDefault($strOption, $strCommand);
- }
- }
-
- if (optionTest($strOption) && optionSource($strOption) ne CONFIG_HELP_SOURCE_DEFAULT)
- {
- if ($$oOptionRule{$strOption}{&OPTION_RULE_TYPE} eq &OPTION_TYPE_BOOLEAN)
- {
- $$oOption{&CONFIG_HELP_CURRENT} = optionGet($strOption) ? 'y' : 'n';
- }
- else
- {
- $$oOption{&CONFIG_HELP_CURRENT} = optionGet($strOption);
- }
- }
-
- return $oOption, $strSection;
- }
-
# Build the help
my $strMore;
@@ -262,7 +148,8 @@ sub configHelp
$strHelp .= " ${strCommand}" . (' ' x ($iCommandLength - length($strCommand)));
$strHelp .=
- ' ' . formatText($$oCommand{&CONFIG_HELP_SUMMARY}, 4 + $iCommandLength + 2, false, $iScreenWidth + 1) .
+ ' ' .
+ configHelpFormatText($$oCommand{&CONFIG_HELP_SUMMARY}, 4 + $iCommandLength + 2, false, $iScreenWidth + 1) .
"\n";
}
@@ -274,7 +161,7 @@ sub configHelp
my $oCommand = $$oConfigHelpData{&CONFIG_HELP_COMMAND}{$strCommand};
$strHelp =
- formatText($$oCommand{&CONFIG_HELP_SUMMARY} . "\n\n" .
+ configHelpFormatText($$oCommand{&CONFIG_HELP_SUMMARY} . "\n\n" .
$$oCommand{&CONFIG_HELP_DESCRIPTION}, 0, true, $iScreenWidth + 1);
# Find longest option length and unique list of sections
@@ -290,7 +177,7 @@ sub configHelp
$iOptionLength = length($strOption);
}
- my ($oOption, $strSection) = optionFind($oConfigHelpData, $oOptionRule, $strCommand, $strOption);
+ my ($oOption, $strSection) = configHelpOptionFind($oConfigHelpData, $oOptionRule, $strCommand, $strOption);
$$oSection{$strSection}{$strOption} = $oOption;
}
@@ -336,9 +223,9 @@ sub configHelp
# Output help
$strHelp .= " --${strOption}" . (' ' x ($iOptionLength - length($strOption)));
- $strHelp .= ' ' . formatText(lcfirst(substr($$oOption{&CONFIG_HELP_SUMMARY}, 0,
- length($$oOption{&CONFIG_HELP_SUMMARY}) - 1)) .
- $strDefault, $iIndent, false, $iScreenWidth + 1);
+ $strHelp .= ' ' . configHelpFormatText(lcfirst(substr($$oOption{&CONFIG_HELP_SUMMARY}, 0,
+ length($$oOption{&CONFIG_HELP_SUMMARY}) - 1)) .
+ $strDefault, $iIndent, false, $iScreenWidth + 1);
}
}
@@ -349,7 +236,7 @@ sub configHelp
# Else option help
else
{
- my ($oOption) = optionFind($oConfigHelpData, $oOptionRule, $strCommand, $strOption);
+ my ($oOption) = configHelpOptionFind($oConfigHelpData, $oOptionRule, $strCommand, $strOption);
# Set current and default values
my $strDefault = '';
@@ -378,8 +265,8 @@ sub configHelp
# Output help
$strHelp =
- formatText($$oOption{&CONFIG_HELP_SUMMARY} . "\n\n" . $$oOption{&CONFIG_HELP_DESCRIPTION} .
- $strDefault, 0, true, $iScreenWidth + 1);
+ configHelpFormatText($$oOption{&CONFIG_HELP_SUMMARY} . "\n\n" . $$oOption{&CONFIG_HELP_DESCRIPTION} .
+ $strDefault, 0, true, $iScreenWidth + 1);
}
}
@@ -390,4 +277,117 @@ sub configHelp
push @EXPORT, qw(configHelp);
+# Helper function for configHelp() to make output look good on a console
+sub configHelpFormatText
+{
+ my $strTextIn = shift;
+ my $iIndent = shift;
+ my $bIndentFirst = shift;
+ my $iLength = shift;
+
+ my @stryText = split("\n", trim($strTextIn));
+ my $strText;
+ my $iIndex = 0;
+
+ foreach my $strLine (@stryText)
+ {
+ if (defined($strText))
+ {
+ $strText .= "\n";
+ }
+
+ my $strPart;
+ my $bFirst = true;
+
+ do
+ {
+ ($strPart, $strLine) = stringSplit($strLine, ' ', $iLength - $iIndent);
+
+ if (!$bFirst || $bIndentFirst)
+ {
+ if (!$bFirst)
+ {
+ $strText .= "\n";
+ }
+
+ $strText .= ' ' x $iIndent;
+ }
+
+ $strText .= trim($strPart);
+
+ $bFirst = false;
+ }
+ while (defined($strLine));
+
+ $iIndex++;
+ }
+
+ return $strText;
+}
+
+# Helper function for configHelp() to find options. The option may be stored with the command or in the option list depending on
+# whether it's generic or command-specific
+sub configHelpOptionFind
+{
+ my $oConfigHelpData = shift;
+ my $oOptionRule = shift;
+ my $strCommand = shift;
+ my $strOption = shift;
+
+ my $strSection = CONFIG_HELP_COMMAND;
+ my $oOption = $$oConfigHelpData{&CONFIG_HELP_COMMAND}{$strCommand}{&CONFIG_HELP_OPTION}{$strOption};
+
+ if (ref(\$oOption) eq 'SCALAR')
+ {
+ $oOption = $$oConfigHelpData{&CONFIG_HELP_OPTION}{$strOption};
+
+ if (defined($$oOption{&CONFIG_HELP_SECTION}))
+ {
+ $strSection = $$oOption{&CONFIG_HELP_SECTION};
+
+ if ($strSection eq CONFIG_SECTION_COMMAND)
+ {
+ $strSection = CONFIG_SECTION_GENERAL;
+ }
+ }
+ else
+ {
+ $strSection = CONFIG_SECTION_GENERAL;
+ }
+
+ if (($strSection ne CONFIG_SECTION_GENERAL && $strSection ne CONFIG_SECTION_LOG &&
+ $strSection ne CONFIG_SECTION_STANZA && $strSection ne CONFIG_SECTION_EXPIRE) ||
+ $strSection eq $strCommand)
+ {
+ $strSection = CONFIG_HELP_COMMAND;
+ }
+ }
+
+ if (defined(optionDefault($strOption, $strCommand)))
+ {
+ if ($$oOptionRule{$strOption}{&OPTION_RULE_TYPE} eq &OPTION_TYPE_BOOLEAN)
+ {
+ $$oOption{&CONFIG_HELP_DEFAULT} = optionDefault($strOption, $strCommand) ? 'y' : 'n';
+ }
+ else
+ {
+ $$oOption{&CONFIG_HELP_DEFAULT} = optionDefault($strOption, $strCommand);
+ }
+ }
+
+ if (optionTest($strOption) && optionSource($strOption) ne CONFIG_HELP_SOURCE_DEFAULT)
+ {
+ if ($$oOptionRule{$strOption}{&OPTION_RULE_TYPE} eq &OPTION_TYPE_BOOLEAN)
+ {
+ $$oOption{&CONFIG_HELP_CURRENT} = optionGet($strOption) ? 'y' : 'n';
+ }
+ else
+ {
+ $$oOption{&CONFIG_HELP_CURRENT} = optionGet($strOption);
+ }
+ }
+
+ return $oOption, $strSection;
+}
+
1;
diff --git a/lib/BackRest/Expire.pm b/lib/BackRest/Expire.pm
index 9e0fc6db1..6b56bf5fd 100644
--- a/lib/BackRest/Expire.pm
+++ b/lib/BackRest/Expire.pm
@@ -147,7 +147,6 @@ sub process
OP_EXPIRE_PROCESS
);
- my $strPath;
my @stryPath;
my $oFile = $self->{oFile};
@@ -178,7 +177,7 @@ sub process
{
my @stryRemoveList;
- foreach $strPath ($oBackupInfo->list('^' . $stryPath[$iFullIdx] . '.*'))
+ foreach my $strPath ($oBackupInfo->list('^' . $stryPath[$iFullIdx] . '.*'))
{
$oBackupInfo->delete($strPath);
@@ -212,7 +211,7 @@ sub process
# Get a list of all differential and incremental backups
my @stryRemoveList;
- foreach $strPath ($oBackupInfo->list(backupRegExpGet(false, true, true)))
+ foreach my $strPath ($oBackupInfo->list(backupRegExpGet(false, true, true)))
{
logDebugMisc($strOperation, "checking ${strPath} for differential expiration");
@@ -349,7 +348,7 @@ sub process
}
# Get all major archive paths (timeline and first 64 bits of LSN)
- foreach $strPath ($oFile->list(PATH_BACKUP_ARCHIVE, $strArchiveId, "^[0-F]{16}\$"))
+ foreach my $strPath ($oFile->list(PATH_BACKUP_ARCHIVE, $strArchiveId, "^[0-F]{16}\$"))
{
logDebugMisc($strOperation, "found major WAL path: ${strPath}");
$bRemove = true;
diff --git a/lib/BackRest/FileCommon.pm b/lib/BackRest/FileCommon.pm
index 4a4525320..b5cf9f2bc 100644
--- a/lib/BackRest/FileCommon.pm
+++ b/lib/BackRest/FileCommon.pm
@@ -139,7 +139,7 @@ sub fileStringWrite
);
# Open the file for writing
- sysopen(my $hFile, $strFileName, O_WRONLY | O_CREAT | O_TRUNC, 0640)
+ sysopen(my $hFile, $strFileName, O_WRONLY | O_CREAT | O_TRUNC, oct(640))
or confess &log(ERROR, "unable to open ${strFileName}");
# Write the string
diff --git a/lib/BackRest/Protocol/IO.pm b/lib/BackRest/Protocol/IO.pm
index 1237c0064..cfcd5375e 100644
--- a/lib/BackRest/Protocol/IO.pm
+++ b/lib/BackRest/Protocol/IO.pm
@@ -258,7 +258,7 @@ sub lineRead
# If reading from error stream then just return undef
else
{
- return undef;
+ return;
}
}
}
@@ -292,7 +292,7 @@ sub lineRead
confess &log(ERROR, "unable to read line after $self->{iProtocolTimeout} seconds", ERROR_PROTOCOL_TIMEOUT);
}
- return undef;
+ return;
}
}
diff --git a/test/Vagrantfile b/test/Vagrantfile
index d3d454960..e12da36f9 100644
--- a/test/Vagrantfile
+++ b/test/Vagrantfile
@@ -14,7 +14,7 @@ Vagrant.configure(2) do |config|
config.vm.provision "shell", inline: <<-SHELL
# Install Perl modules
sudo apt-get update
- apt-get install -y libdbi-perl libdbd-pg-perl libxml-checker-perl ghostscript
+ apt-get install -y libdbi-perl libdbd-pg-perl libxml-checker-perl ghostscript libperl-critic-perl
# Install texlive
mkdir /root/texlive
diff --git a/test/lib/BackRestTest/BackupCommonTest.pm b/test/lib/BackRestTest/BackupCommonTest.pm
index 020712014..6c126dabc 100644
--- a/test/lib/BackRestTest/BackupCommonTest.pm
+++ b/test/lib/BackRestTest/BackupCommonTest.pm
@@ -1042,7 +1042,7 @@ sub BackRestTestBackup_BackupEnd
if ($oExecuteBackup->{iExpectedExitStatus} != 0 && $oExecuteBackup->{iExpectedExitStatus} != -1)
{
- return undef;
+ return;
}
${$oExpectedManifestRef}{&MANIFEST_SECTION_BACKUP}{&MANIFEST_KEY_TYPE} = $strBackupType;
diff --git a/test/lib/BackRestTest/BackupTest.pm b/test/lib/BackRestTest/BackupTest.pm
index a1e4c45c1..862f7ae14 100755
--- a/test/lib/BackRestTest/BackupTest.pm
+++ b/test/lib/BackRestTest/BackupTest.pm
@@ -37,6 +37,93 @@ use BackRestTest::Common::ExecuteTest;
use BackRestTest::CommonTest;
use BackRestTest::ExpireCommonTest;
+####################################################################################################################################
+# Archive helper functions
+####################################################################################################################################
+# Generate an archive log for testing
+sub archiveGenerate
+{
+ my $oFile = shift;
+ my $strXlogPath = shift;
+ my $iSourceNo = shift;
+ my $iArchiveNo = shift;
+ my $bPartial = shift;
+
+ my $strArchiveFile = uc(sprintf('0000000100000001%08x', $iArchiveNo)) .
+ (defined($bPartial) && $bPartial ? '.partial' : '');
+ my $strArchiveTestFile = BackRestTestCommon_DataPathGet() . "/test.archive${iSourceNo}.bin";
+
+ my $strSourceFile = "${strXlogPath}/${strArchiveFile}";
+
+ $oFile->copy(PATH_DB_ABSOLUTE, $strArchiveTestFile, # Source file
+ PATH_DB_ABSOLUTE, $strSourceFile, # Destination file
+ false, # Source is not compressed
+ false, # Destination is not compressed
+ undef, undef, undef, # Unused params
+ true); # Create path if it does not exist
+
+ return $strArchiveFile, $strSourceFile;
+}
+
+# Check that an archive log is present
+sub archiveCheck
+{
+ my $oFile = shift;
+ my $strArchiveFile = shift;
+ my $strArchiveChecksum = shift;
+ my $bCompress = shift;
+
+ # Build the archive name to check for at the destination
+ my $strArchiveCheck = "9.3-1/${strArchiveFile}-${strArchiveChecksum}";
+
+ if ($bCompress)
+ {
+ $strArchiveCheck .= '.gz';
+ }
+
+ my $oWait = waitInit(5);
+ my $bFound = false;
+
+ do
+ {
+ $bFound = $oFile->exists(PATH_BACKUP_ARCHIVE, $strArchiveCheck);
+ }
+ while (!$bFound && waitMore($oWait));
+
+ if (!$bFound)
+ {
+ confess 'unable to find ' . $strArchiveCheck;
+ }
+}
+
+# Push a log to the archive
+sub archivePush
+{
+ my $oLogTest = shift;
+ my $oFile = shift;
+ my $strXlogPath = shift;
+ my $strArchiveTestFile = shift;
+ my $iArchiveNo = shift;
+ my $iExpectedError = shift;
+
+ my $strSourceFile = "${strXlogPath}/" . uc(sprintf('0000000100000001%08x', $iArchiveNo));
+
+ $oFile->copy(PATH_DB_ABSOLUTE, $strArchiveTestFile, # Source file
+ PATH_DB_ABSOLUTE, $strSourceFile, # Destination file
+ false, # Source is not compressed
+ false, # Destination is not compressed
+ undef, undef, undef, # Unused params
+ true); # Create path if it does not exist
+
+ my $strCommand = BackRestTestCommon_CommandMainGet() . ' --config=' . BackRestTestCommon_DbPathGet() .
+ '/pg_backrest.conf --archive-max-mb=24 --no-fork --stanza=db archive-push' .
+ (defined($iExpectedError) && $iExpectedError == ERROR_HOST_CONNECT ?
+ " --backup-host=bogus" : '');
+
+ executeTest($strCommand . " ${strSourceFile}",
+ {iExpectedExitStatus => $iExpectedError, oLogTest => $oLogTest});
+}
+
####################################################################################################################################
# BackRestTestBackup_Test
####################################################################################################################################
@@ -174,60 +261,6 @@ sub BackRestTestBackup_Test
my $strCommand = BackRestTestCommon_CommandMainGet() . ' --config=' . BackRestTestCommon_DbPathGet() .
'/pg_backrest.conf --no-fork --stanza=db archive-push';
- sub archiveGenerate
- {
- my $oFile = shift;
- my $strXlogPath = shift;
- my $iSourceNo = shift;
- my $iArchiveNo = shift;
- my $bPartial = shift;
-
- my $strArchiveFile = uc(sprintf('0000000100000001%08x', $iArchiveNo)) .
- (defined($bPartial) && $bPartial ? '.partial' : '');
- my $strArchiveTestFile = BackRestTestCommon_DataPathGet() . "/test.archive${iSourceNo}.bin";
-
- my $strSourceFile = "${strXlogPath}/${strArchiveFile}";
-
- $oFile->copy(PATH_DB_ABSOLUTE, $strArchiveTestFile, # Source file
- PATH_DB_ABSOLUTE, $strSourceFile, # Destination file
- false, # Source is not compressed
- false, # Destination is not compressed
- undef, undef, undef, # Unused params
- true); # Create path if it does not exist
-
- return $strArchiveFile, $strSourceFile;
- }
-
- sub archiveCheck
- {
- my $oFile = shift;
- my $strArchiveFile = shift;
- my $strArchiveChecksum = shift;
- my $bCompress = shift;
-
- # Build the archive name to check for at the destination
- my $strArchiveCheck = "9.3-1/${strArchiveFile}-${strArchiveChecksum}";
-
- if ($bCompress)
- {
- $strArchiveCheck .= '.gz';
- }
-
- my $oWait = waitInit(5);
- my $bFound = false;
-
- do
- {
- $bFound = $oFile->exists(PATH_BACKUP_ARCHIVE, $strArchiveCheck);
- }
- while (!$bFound && waitMore($oWait));
-
- if (!$bFound)
- {
- confess 'unable to find ' . $strArchiveCheck;
- }
- }
-
# Loop through backups
for (my $iBackup = 1; $iBackup <= 3; $iBackup++)
{
@@ -458,34 +491,6 @@ sub BackRestTestBackup_Test
BackRestTestCommon_ConfigCreate(BACKUP,
($bRemote ? DB : undef));
- # Helper function to push archive logs
- sub archivePush
- {
- my $oLogTest = shift;
- my $oFile = shift;
- my $strXlogPath = shift;
- my $strArchiveTestFile = shift;
- my $iArchiveNo = shift;
- my $iExpectedError = shift;
-
- my $strSourceFile = "${strXlogPath}/" . uc(sprintf('0000000100000001%08x', $iArchiveNo));
-
- $oFile->copy(PATH_DB_ABSOLUTE, $strArchiveTestFile, # Source file
- PATH_DB_ABSOLUTE, $strSourceFile, # Destination file
- false, # Source is not compressed
- false, # Destination is not compressed
- undef, undef, undef, # Unused params
- true); # Create path if it does not exist
-
- my $strCommand = BackRestTestCommon_CommandMainGet() . ' --config=' . BackRestTestCommon_DbPathGet() .
- '/pg_backrest.conf --archive-max-mb=24 --no-fork --stanza=db archive-push' .
- (defined($iExpectedError) && $iExpectedError == ERROR_HOST_CONNECT ?
- " --backup-host=bogus" : '');
-
- executeTest($strCommand . " ${strSourceFile}",
- {iExpectedExitStatus => $iExpectedError, oLogTest => $oLogTest});
- }
-
# Push a WAL segment
archivePush($oLogTest, $oFile, $strXlogPath, $strArchiveTestFile, 1);
diff --git a/test/lib/BackRestTest/Common/ExecuteTest.pm b/test/lib/BackRestTest/Common/ExecuteTest.pm
index 2d418a1cb..3efc0f850 100644
--- a/test/lib/BackRestTest/Common/ExecuteTest.pm
+++ b/test/lib/BackRestTest/Common/ExecuteTest.pm
@@ -187,7 +187,7 @@ sub endRetry
if (!$bWait)
{
- return undef;
+ return;
}
if (!$bFound)
diff --git a/test/lib/BackRestTest/CommonTest.pm b/test/lib/BackRestTest/CommonTest.pm
index 2c4c7dc1b..4a6a4365a 100755
--- a/test/lib/BackRestTest/CommonTest.pm
+++ b/test/lib/BackRestTest/CommonTest.pm
@@ -436,14 +436,6 @@ sub BackRestTestCommon_Setup
$bNoCleanup = $bNoCleanupParam;
$bLogForce = $bLogForceParam;
- # Check the exe for warnings
- my $strWarning = trim(executeTest("perl -cW ${strCommonCommandRemote} 2>&1"));
-
- if ($strWarning ne "${strCommonCommandRemote} syntax OK")
- {
- confess &log(ERROR, "${strCommonCommandRemote} failed syntax check:\n${strWarning}");
- }
-
# Get the Postgres version
my $strVersionRegExp = '(devel|((alpha|beta|rc)[0-9]+))$';
my $strOutLog = executeTest($strPgSqlBin . '/postgres --version');
diff --git a/test/lint/perlcritic.policy b/test/lint/perlcritic.policy
new file mode 100644
index 000000000..af3879c1c
--- /dev/null
+++ b/test/lint/perlcritic.policy
@@ -0,0 +1,204 @@
+# Main Perl Critic Policy Applied to Entire Code Base
+#-----------------------------------------------------------------------------------------------------------------------------------
+
+# Important policies that should always be checked
+#-----------------------------------------------------------------------------------------------------------------------------------
+[TestingAndDebugging::RequireUseStrict]
+severity = 5
+
+[TestingAndDebugging::RequireUseWarnings]
+severity = 5
+
+# Permanent Exceptions
+#-----------------------------------------------------------------------------------------------------------------------------------
+
+# Requires all local variables to be all lower/upper case -- can't see how this is a good thing.
+[-NamingConventions::Capitalization]
+
+# Requires @_ to be immediately unpacked but won't work with param logging scheme.
+[-Subroutines::RequireArgUnpacking]
+
+# Requires all exports to be configurable by caller. This is fine for independent libraries but
+# overly burdensome for modules integrated as part of an application. Maybe apply to certain modules
+# that are also used by doc and test programs?
+[-Modules::ProhibitAutomaticExportation]
+
+# Requires built-in functions to not have parens, but in this project it is preferred to wrap all
+# function calls in parens for consistency.
+[-CodeLayout::ProhibitParensWithBuiltins]
+
+# Requires module version vars. Probably not practical for built-in modules.
+[-Modules::RequireVersionVar]
+
+# Requires extended formatting for all regexps. Seems overly burdensome, or at least something to look
+# at a lot further down the road.
+[-RegularExpressions::RequireExtendedFormatting]
+
+# Requires Unicode safe expressions. May be worth looking at sometime.
+[-RegularExpressions::ProhibitEnumeratedClasses]
+
+# S2 - Requires List::MoreUtils instead of boolean grep. Not worth it to load another module.
+[-BuiltinFunctions::ProhibitBooleanGrep]
+
+# Provisional Exceptions for Test & Documentation Code
+#-----------------------------------------------------------------------------------------------------------------------------------
+
+# S5 - Required to make eval in DocManifest.pm work. Would prefer a line exception for this but can't get it working yet.
+[-BuiltinFunctions::ProhibitStringyEval]
+
+# S2 - Requires complete POD sections but these are being removed anyway in favor of Config.pm.
+[-Documentation::RequirePodSections]
+[-Documentation::RequirePodAtEnd]
+
+# S3 - Requires regexps to be below a certain length. Seems burdensome.
+[-RegularExpressions::ProhibitComplexRegexes]
+
+# To Be Fixed or Evaluated
+#
+# Natural ordering here indicates the order in which they should be addressed.
+#-----------------------------------------------------------------------------------------------------------------------------------
+
+# S4 - Requires array offset from end to use negative syntax.
+[-Variables::RequireNegativeIndices]
+
+# S3 - Requires all variables to be used.
+[-Variables::ProhibitUnusedVariables]
+
+# S2 - Requires all long numbers to have thousand separators.
+[-ValuesAndExpressions::RequireNumberSeparators]
+
+# S4 - Requires simple assignments in declarations. (TEST ONLY)
+[-Variables::ProhibitAugmentedAssignmentInDeclaration]
+
+# S3 - Requires safe checking of evals.
+[-ErrorHandling::RequireCheckingReturnValueOfEval]
+
+# S4 - Requires parans when logical and bitwise booleans are mixed.
+[-ValuesAndExpressions::ProhibitMixedBooleanOperators]
+
+# S4 - Requires that sub names not overlap with built-ins - a bummer for object members.
+[-Subroutines::ProhibitBuiltinHomonyms]
+
+# S4 - Requires block form of grep for readability.
+[-BuiltinFunctions::RequireBlockGrep]
+
+# S4 - Requires modification of certain vars (e.g. $SIG) to have local scope.
+[-Variables::RequireLocalizedPunctuationVars]
+
+# S4 - Requires close() to be called soon after open but seems arbitrary.
+[-InputOutput::RequireBriefOpen]
+
+# S1 - Requires reverse keyword for reverse sorts instead of block.
+[-BuiltinFunctions::ProhibitReverseSortBlock]
+
+# S3 - Requires use of Carp instead of die or warn.
+[-ErrorHandling::RequireCarping]
+
+# S3 - Requires use of local vars in packages.
+[-Variables::ProhibitPackageVars]
+
+# S3 - Require conditional use statements to use dynamic load logic
+[-Modules::ProhibitConditionalUseStatements]
+
+# S3 - Requires that certain operators not be mixed.
+[-ValuesAndExpressions::ProhibitMismatchedOperators]
+
+# S2 - Requires use of if instead of unless.
+[-ControlStructures::ProhibitUnlessBlocks]
+
+# S1 - Requires true literals to use single quotes.
+[-ValuesAndExpressions::ProhibitInterpolationOfLiterals]
+
+# S2 - Requires split expressions to be regexp for clarity.
+[-BuiltinFunctions::ProhibitStringySplit]
+
+# S4 - Requires use of Readonly instead of const. Has performance and syntax advantages.
+[-ValuesAndExpressions::ProhibitConstantPragma]
+
+# S2 - Requires all numbers to be defined as constants
+[-ValuesAndExpressions::ProhibitMagicNumbers]
+
+# S4 - Requires all subs to have a return, even if there is not value to return.
+[-Subroutines::RequireFinalReturn]
+
+# S4 - Requires new to be called as Object->new().
+[-Objects::ProhibitIndirectSyntax]
+
+# S2 - Requires that & not be used in functions calls. Currently this is used a lot for &log() calls.
+[-Subroutines::ProhibitAmpersandSigils]
+
+# S2 - Requires use of eq instead of regexp when possible.
+[-RegularExpressions::ProhibitFixedStringMatches]
+
+# S2 - Requires that sigils be separated by braces, eg %$var becomes %{$var}.
+[-References::ProhibitDoubleSigils]
+
+# S2 - Requires use English instead a puctuation vars such as $!.
+[-Variables::ProhibitPunctuationVars]
+
+# S3 - Requires nested if/else have limited depth and recommends using given/when instead.
+[-ControlStructures::ProhibitCascadingIfElse]
+
+# S2 - Requires empty strings to be represented with qw{}.
+[-ValuesAndExpressions::ProhibitEmptyQuotes]
+
+# S2 - Requires non letter and number strings to be represented with something like qw{/}.
+[-ValuesAndExpressions::ProhibitNoisyQuotes]
+
+# S2 - Requires expanded matching for . in regular expressions.
+[-RegularExpressions::RequireDotMatchAnything]
+
+# S2 - Requires sed-style boundary matching. May not be appropriate for reg exps in this project, though.
+[-RegularExpressions::RequireLineBoundaryMatching]
+
+# S1 - Requires use of Perl::Tidy.
+[-CodeLayout::RequireTidyCode]
+
+# S2 - Requires use of Perl syntax for simple loops, e.g. for (0..$max).
+[-ControlStructures::ProhibitCStyleForLoops]
+
+# S2 - Require standard if structures rather than postfix for readability.
+[-ControlStructures::ProhibitPostfixControls]
+
+# S3 - Requires code have a McCabe score of no more than 20 but is configurable.
+[-Subroutines::ProhibitExcessComplexity]
+[-Modules::ProhibitExcessMainComplexity]
+
+# S3 - Requires low level of code nesting (may require a lot of refactoring).
+[-ControlStructures::ProhibitDeepNests]
+
+# S3 - Requires subs to have <= 6 args but is configurable.
+[-Subroutines::ProhibitManyArgs]
+
+# S3 - Requires arbitrary unambigious names but is configurable.
+[-NamingConventions::ProhibitAmbiguousNames]
+
+# S3 - Requires that var names never be resused in a sub, not sure about this one.
+[-Variables::ProhibitReusedNames]
+
+# S3 - Requires non-capturing groups in regexp, primarily a performance optimization.
+[-RegularExpressions::ProhibitUnusedCapture]
+
+# S1 - Requires trailing commas on all lists.
+[-CodeLayout::RequireTrailingCommas]
+
+# S2 - Requires chained calls be less than four.
+[-ValuesAndExpressions::ProhibitLongChainsOfMethodCalls]
+
+# S2 - Requires check for success of close() function.
+[-InputOutput::RequireCheckedClose]
+
+# S1 - Requires use Fatal or autodie with syscalls.
+[-InputOutput::RequireCheckedSyscalls]
+
+# S1 - Requires less abiguity for metacharacters in strings.
+[-ValuesAndExpressions::RequireInterpolationOfMetachars]
+
+# S4 - Requires character classes to reduce escapes in regexps.
+[-RegularExpressions::ProhibitEscapedMetacharacters]
+
+# S1 - Require character classes rather than single character alternation.
+[-RegularExpressions::ProhibitSingleCharAlternation]
+
+# S2 - Require qw{} syntax for quoted string lists
+[-CodeLayout::ProhibitQuotedWordLists]
diff --git a/test/test.pl b/test/test.pl
index 9fd08aa70..72aa96c39 100755
--- a/test/test.pl
+++ b/test/test.pl
@@ -61,6 +61,7 @@ test.pl [options]
--infinite repeat selected tests forever
--db-version version of postgres to test (or all)
--log-force force overwrite of current test log files
+ --no-lint Disable static source code analysis
Configuration Options:
--exe pgBackRest executable
@@ -103,6 +104,7 @@ my $bInfinite = false;
my $strDbVersion = 'all';
my $bLogForce = false;
my $bVmBuild = false;
+my $bNoLint = false;
my $strCommandLine = join(' ', @ARGV);
@@ -125,7 +127,8 @@ GetOptions ('q|quiet' => \$bQuiet,
'no-cleanup' => \$bNoCleanup,
'infinite' => \$bInfinite,
'db-version=s' => \$strDbVersion,
- 'log-force' => \$bLogForce)
+ 'log-force' => \$bLogForce,
+ 'no-lint' => \$bNoLint)
or pod2usage(2);
# Display version and exit if requested
@@ -334,6 +337,31 @@ eval
{
if (!$bDryRun)
{
+ # Run Perl critic
+ if (!$bNoLint)
+ {
+ my $strBasePath = dirname(dirname(abs_path($0)));
+
+ &log(INFO, "Performing static code analysis using perl -cW");
+
+ # Check the exe for warnings
+ my $strWarning = trim(executeTest("perl -cW ${strBasePath}/bin/pg_backrest 2>&1"));
+
+ if ($strWarning ne "${strBasePath}/bin/pg_backrest syntax OK")
+ {
+ confess &log(ERROR, "${strBasePath}/bin/pg_backrest failed syntax check:\n${strWarning}");
+ }
+
+ &log(INFO, "Performing static code analysis using perlcritic");
+
+ executeTest('perlcritic --quiet --verbose=8 --brutal --top=10' .
+ ' --verbose "[%p] %f: %m at line %l, column %c. %e. (Severity: %s)\n"' .
+ " \"--profile=${strBasePath}/test/lint/perlcritic.policy\"" .
+ " ${strBasePath}/bin/pg_backrest ${strBasePath}/lib/*" .
+ " ${strBasePath}/test/test.pl ${strBasePath}/test/lib/*" .
+ " ${strBasePath}/doc/doc.pl ${strBasePath}/doc/lib/*");
+ }
+
logFileSet(cwd() . "/test");
}