db/pgbackrest
1
0
Fork 0
mirror of https://github.com/pgbackrest/pgbackrest.git synced 2024-12-14 10:13:05 +02:00
Code Issues Releases Activity

Closed #173: Add static source code analysis

Browse Source 
Perl Critic added and passes on gentle.  A policy file has been created with some permanent exceptions and a list of policies to be fixed in approximately the order they should be fixed in.
This commit is contained in:
David Steele 2016-02-23 09:25:22 -05:00
parent d35ab82a83
commit 048571e23f
20 changed files with 618 additions and 408 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CHANGELOG.md
View File

@ -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__

305
doc/lib/BackRestDoc/Common/DocConfig.pm
View File

@ -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,10 +554,76 @@ 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
# Working variables
my $oConfigHash = $self->{oConfigHash};
my $oOperationDoc = $self->{oDoc}->nodeGet('operation');
my $oOptionRule = optionRuleGet();
my $oDoc = new BackRestDoc::Common::Doc();
$oDoc->paramSet('title', $oOperationDoc->paramGet('title'));
# Output the introduction
my $oIntroSectionDoc = $oDoc->nodeAdd('section', undef, {id => 'introduction'});
$oIntroSectionDoc->nodeAdd('title')->textSet('Introduction');
$oIntroSectionDoc->textSet($oOperationDoc->textGet());
foreach my $strCommand (sort(keys($$oConfigHash{&CONFIG_HELP_COMMAND})))
{
my $oCommandHash = $$oConfigHash{&CONFIG_HELP_COMMAND}{$strCommand};
my $oSectionElement = $oDoc->nodeAdd('section', undef, {id => "command-${strCommand}"});
my $oCommandDoc = $oOperationDoc->nodeGet('command-list')->nodeGetById('command', $strCommand);
$oSectionElement->
nodeAdd('title')->textSet(
{name => 'text',
children=> [$oCommandDoc->paramGet('name') . ' Command (', {name => 'id', value => $strCommand}, ')']});
$oSectionElement->textSet($$oCommandHash{&CONFIG_HELP_DESCRIPTION});
# use Data::Dumper;
# confess Dumper($oDoc->{oDoc});
if (defined($$oCommandHash{&CONFIG_HELP_OPTION}))
{
my $oCategory = {};
foreach my $strOption (sort(keys(%{$$oCommandHash{&CONFIG_HELP_OPTION}})))
{
my ($oOption, $strCategory) = helpCommandDocGetOptionFind($oConfigHash, $oOptionRule, $strCommand, $strOption);
$$oCategory{$strCategory}{$strOption} = $oOption;
}
# Iterate sections
foreach my $strCategory (sort(keys(%{$oCategory})))
{
my $oOptionListElement = $oSectionElement->nodeAdd('section', undef, {id => "category-${strCategory}"});
$oOptionListElement->
nodeAdd('title')->textSet(ucfirst($strCategory) . ' Options');
# Iterate options
foreach my $strOption (sort(keys(%{$$oCategory{$strCategory}})))
{
$self->helpOptionGet($strCommand, $strOption, $oOptionListElement,
$$oCommandHash{&CONFIG_HELP_OPTION}{$strOption});
}
}
}
}
# Return from function and log return values if any
return logDebugReturn
(
$strOperation,
{name => 'oDoc', value => $oDoc}
);
}
# 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;
@ -595,100 +663,9 @@ sub helpCommandDocGet
}
}
# 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');
my $oOptionRule = optionRuleGet();
my $oDoc = new BackRestDoc::Common::Doc();
$oDoc->paramSet('title', $oOperationDoc->paramGet('title'));
# Output the introduction
my $oIntroSectionDoc = $oDoc->nodeAdd('section', undef, {id => 'introduction'});
$oIntroSectionDoc->nodeAdd('title')->textSet('Introduction');
$oIntroSectionDoc->textSet($oOperationDoc->textGet());
foreach my $strCommand (sort(keys($$oConfigHash{&CONFIG_HELP_COMMAND})))
{
my $oCommandHash = $$oConfigHash{&CONFIG_HELP_COMMAND}{$strCommand};
my $oSectionElement = $oDoc->nodeAdd('section', undef, {id => "command-${strCommand}"});
my $oCommandDoc = $oOperationDoc->nodeGet('command-list')->nodeGetById('command', $strCommand);
$oSectionElement->
nodeAdd('title')->textSet(
{name => 'text',
children=> [$oCommandDoc->paramGet('name') . ' Command (', {name => 'id', value => $strCommand}, ')']});
$oSectionElement->textSet($$oCommandHash{&CONFIG_HELP_DESCRIPTION});
# use Data::Dumper;
# confess Dumper($oDoc->{oDoc});
if (defined($$oCommandHash{&CONFIG_HELP_OPTION}))
{
my $oCategory = {};
foreach my $strOption (sort(keys(%{$$oCommandHash{&CONFIG_HELP_OPTION}})))
{
my ($oOption, $strCategory) = optionFind($oConfigHash, $oOptionRule, $strCommand, $strOption);
$$oCategory{$strCategory}{$strOption} = $oOption;
}
# Iterate sections
foreach my $strCategory (sort(keys(%{$oCategory})))
{
my $oOptionListElement = $oSectionElement->nodeAdd('section', undef, {id => "category-${strCategory}"});
$oOptionListElement->
nodeAdd('title')->textSet(ucfirst($strCategory) . ' Options');
# Iterate options
foreach my $strOption (sort(keys(%{$$oCategory{$strCategory}})))
{
$self->helpOptionGet($strCommand, $strOption, $oOptionListElement,
$$oCommandHash{&CONFIG_HELP_OPTION}{$strOption});
}
}
}
}
# Return from function and log return values if any
return logDebugReturn
(
$strOperation,
{name => 'oDoc', value => $oDoc}
);
}
####################################################################################################################################
# helpOptionGet
#

2
doc/lib/BackRestDoc/Common/DocManifest.pm
View File

@ -313,7 +313,7 @@ sub variableReplace
if (!defined($strBuffer))
{
return undef;
return;
}
foreach my $strName (sort(keys(%{$self->{oVariable}})))

3
doc/xml/change-log.xml
View File

@ -17,6 +17,9 @@
<release-feature>
<text>Rename <setting>--no-start-stop</setting> option to <setting>--no-online</setting>.</text>
</release-feature>
<release-feature>
<text>Static source analysis using Perl-Critic, currently passes on gentle.</text>
</release-feature>
</release-feature-bullet-list>
</changelog-release>

4
lib/BackRest/Common/Ini.pm
View File

@ -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}})));
}
####################################################################################################################################

6
lib/BackRest/Common/Lock.pm
View File

@ -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);

2
lib/BackRest/Common/String.pm
View File

@ -64,7 +64,7 @@ sub trim
if (!defined($strBuffer))
{
return undef;
return;
}
$strBuffer =~ s/^\s+|\s+$//g;

2
lib/BackRest/Common/Wait.pm
View File

@ -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

104
lib/BackRest/Config/Config.pm
View File

@ -2004,7 +2004,7 @@ sub optionCommandRule
$oOptionRule{$strOption}{&OPTION_RULE_COMMAND}{$strCommand} : undef;
}
return undef;
return;
}
####################################################################################################################################
@ -2411,8 +2411,57 @@ sub commandWrite
# $strExeString .= ' --no-config';
# }
# Function to correctly format options for command-line usage
sub optionFormat
# 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)))
{
# Skip the config option if it's already included
# next if ($bIncludeConfig && $strOption eq OPTION_CONFIG);
# Process any option overrides first
if (defined($$oOptionOverride{$strOption}))
{
if (defined($$oOptionOverride{$strOption}{value}))
{
$strExeString .= commandWriteOptionFormat($strOption, false, {value => $$oOptionOverride{$strOption}{value}});
}
}
# else look for non-default options in the current configuration
elsif ((!defined($oOptionRule{$strOption}{&OPTION_RULE_COMMAND}) ||
defined($oOptionRule{$strOption}{&OPTION_RULE_COMMAND}{$strNewCommand})) &&
defined($oOption{$strOption}{value}) &&
($bIncludeConfig ? $oOption{$strOption}{source} ne SOURCE_DEFAULT : $oOption{$strOption}{source} eq SOURCE_PARAM))
{
my $oValue;
my $bMulti = false;
# If this is a hash then it will break up into multple command-line options
if (ref($oOption{$strOption}{value}) eq 'HASH')
{
$oValue = $oOption{$strOption}{value};
$bMulti = true;
}
# Else a single value but store it in a hash anyway to make processing below simpler
else
{
$oValue = {value => $oOption{$strOption}{value}};
}
$strExeString .= commandWriteOptionFormat($strOption, $bMulti, $oValue);
}
}
if ($bIncludeCommand)
{
$strExeString .= " ${strNewCommand}";
}
return $strExeString;
}
push @EXPORT, qw(commandWrite);
# Helper function for commandWrite() to correctly format options for command-line usage
sub commandWriteOptionFormat
{
my $strOption = shift;
my $bMulti = shift;
@ -2444,55 +2493,6 @@ sub commandWrite
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)))
{
# Skip the config option if it's already included
# next if ($bIncludeConfig && $strOption eq OPTION_CONFIG);
# Process any option overrides first
if (defined($$oOptionOverride{$strOption}))
{
if (defined($$oOptionOverride{$strOption}{value}))
{
$strExeString .= optionFormat($strOption, false, {value => $$oOptionOverride{$strOption}{value}});
}
}
# else look for non-default options in the current configuration
elsif ((!defined($oOptionRule{$strOption}{&OPTION_RULE_COMMAND}) ||
defined($oOptionRule{$strOption}{&OPTION_RULE_COMMAND}{$strNewCommand})) &&
defined($oOption{$strOption}{value}) &&
($bIncludeConfig ? $oOption{$strOption}{source} ne SOURCE_DEFAULT : $oOption{$strOption}{source} eq SOURCE_PARAM))
{
my $oValue;
my $bMulti = false;
# If this is a hash then it will break up into multple command-line options
if (ref($oOption{$strOption}{value}) eq 'HASH')
{
$oValue = $oOption{$strOption}{value};
$bMulti = true;
}
# Else a single value but store it in a hash anyway to make processing below simpler
else
{
$oValue = {value => $oOption{$strOption}{value}};
}
$strExeString .= optionFormat($strOption, $bMulti, $oValue);
}
}
if ($bIncludeCommand)
{
$strExeString .= " ${strNewCommand}";
}
return $strExeString;
}
push @EXPORT, qw(commandWrite);
####################################################################################################################################
# commandHashGet
#

334
lib/BackRest/Config/ConfigHelp.pm
View File

@ -115,8 +115,170 @@ sub configHelp
}
}
# Internal text format function to make output look good on a console
sub formatText
# Build the help
my $strMore;
if (!defined($strHelp))
{
my $iScreenWidth = 80;
# General help
if (!defined($strCommand))
{
$strHelp =
"Usage:\n" .
" " . BACKREST_EXE . " [options] [command]\n\n" .
"Commands:\n";
# Find longest command length
my $iCommandLength = 0;
foreach my $strCommand (sort(keys(%{$$oConfigHelpData{&CONFIG_HELP_COMMAND}})))
{
if (length($strCommand) > $iCommandLength)
{
$iCommandLength = length($strCommand);
}
}
# Output commands
foreach my $strCommand (sort(keys(%{$$oConfigHelpData{&CONFIG_HELP_COMMAND}})))
{
my $oCommand = $$oConfigHelpData{&CONFIG_HELP_COMMAND}{$strCommand};
$strHelp .= " ${strCommand}" . (' ' x ($iCommandLength - length($strCommand)));
$strHelp .=
' ' .
configHelpFormatText($$oCommand{&CONFIG_HELP_SUMMARY}, 4 + $iCommandLength + 2, false, $iScreenWidth + 1) .
"\n";
}
$strMore = '[command]';
}
# Else command help
elsif (!defined($strOption))
{
my $oCommand = $$oConfigHelpData{&CONFIG_HELP_COMMAND}{$strCommand};
$strHelp =
configHelpFormatText($$oCommand{&CONFIG_HELP_SUMMARY} . "\n\n" .
$$oCommand{&CONFIG_HELP_DESCRIPTION}, 0, true, $iScreenWidth + 1);
# Find longest option length and unique list of sections
my $iOptionLength = 0;
my $oSection = {};
if (defined($$oCommand{&CONFIG_HELP_OPTION}))
{
foreach my $strOption (sort(keys(%{$$oCommand{&CONFIG_HELP_OPTION}})))
{
if (length($strOption) > $iOptionLength)
{
$iOptionLength = length($strOption);
}
my ($oOption, $strSection) = configHelpOptionFind($oConfigHelpData, $oOptionRule, $strCommand, $strOption);
$$oSection{$strSection}{$strOption} = $oOption;
}
# Iterate sections
foreach my $strSection (sort(keys(%{$oSection})))
{
$strHelp .=
"\n\n" . ucfirst($strSection) . " Options:\n";
# Iterate options
foreach my $strOption (sort(keys(%{$$oSection{$strSection}})))
{
$strHelp .= "\n";
my $iIndent = 4 + $iOptionLength + 2;
my $oOption = $$oSection{$strSection}{$strOption};
# Set current and default values
my $strDefault = '';
if ($$oOption{&CONFIG_HELP_CURRENT} || $$oOption{&CONFIG_HELP_DEFAULT})
{
$strDefault = undef;
if ($$oOption{&CONFIG_HELP_CURRENT})
{
$strDefault .= 'current=' . $$oOption{&CONFIG_HELP_CURRENT};
}
if ($$oOption{&CONFIG_HELP_DEFAULT})
{
if (defined($strDefault))
{
$strDefault .= ', ';
}
$strDefault .= 'default=' . $$oOption{&CONFIG_HELP_DEFAULT};
}
$strDefault = " [${strDefault}]";
}
# Output help
$strHelp .= " --${strOption}" . (' ' x ($iOptionLength - length($strOption)));
$strHelp .= ' ' . configHelpFormatText(lcfirst(substr($$oOption{&CONFIG_HELP_SUMMARY}, 0,
length($$oOption{&CONFIG_HELP_SUMMARY}) - 1)) .
$strDefault, $iIndent, false, $iScreenWidth + 1);
}
}
$strMore = "${strCommand} [option]";
$strHelp .= "\n";
}
}
# Else option help
else
{
my ($oOption) = configHelpOptionFind($oConfigHelpData, $oOptionRule, $strCommand, $strOption);
# Set current and default values
my $strDefault = '';
if ($$oOption{&CONFIG_HELP_CURRENT} || $$oOption{&CONFIG_HELP_DEFAULT})
{
$strDefault = undef;
if ($$oOption{&CONFIG_HELP_CURRENT})
{
$strDefault = 'current: ' . $$oOption{&CONFIG_HELP_CURRENT};
}
if ($$oOption{&CONFIG_HELP_DEFAULT})
{
if (defined($strDefault))
{
$strDefault .= "\n";
}
$strDefault .= 'default: ' . $$oOption{&CONFIG_HELP_DEFAULT};
}
$strDefault = "\n\n${strDefault}";
}
# Output help
$strHelp =
configHelpFormatText($$oOption{&CONFIG_HELP_SUMMARY} . "\n\n" . $$oOption{&CONFIG_HELP_DESCRIPTION} .
$strDefault, 0, true, $iScreenWidth + 1);
}
}
# Output help
syswrite(*STDOUT, "${strVersion} -" . (defined($strTitle) ? " ${strTitle}" : '') . " help\n\n${strHelp}\n" .
(defined($strMore) ? 'Use \'' . BACKREST_EXE . " help ${strMore}' for more information.\n" : ''));
}
push @EXPORT, qw(configHelp);
# Helper function for configHelp() to make output look good on a console
sub configHelpFormatText
{
my $strTextIn = shift;
my $iIndent = shift;
@ -163,10 +325,9 @@ sub configHelp
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
# 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;
@ -229,165 +390,4 @@ sub configHelp
return $oOption, $strSection;
}
# Build the help
my $strMore;
if (!defined($strHelp))
{
my $iScreenWidth = 80;
# General help
if (!defined($strCommand))
{
$strHelp =
"Usage:\n" .
" " . BACKREST_EXE . " [options] [command]\n\n" .
"Commands:\n";
# Find longest command length
my $iCommandLength = 0;
foreach my $strCommand (sort(keys(%{$$oConfigHelpData{&CONFIG_HELP_COMMAND}})))
{
if (length($strCommand) > $iCommandLength)
{
$iCommandLength = length($strCommand);
}
}
# Output commands
foreach my $strCommand (sort(keys(%{$$oConfigHelpData{&CONFIG_HELP_COMMAND}})))
{
my $oCommand = $$oConfigHelpData{&CONFIG_HELP_COMMAND}{$strCommand};
$strHelp .= " ${strCommand}" . (' ' x ($iCommandLength - length($strCommand)));
$strHelp .=
' ' . formatText($$oCommand{&CONFIG_HELP_SUMMARY}, 4 + $iCommandLength + 2, false, $iScreenWidth + 1) .
"\n";
}
$strMore = '[command]';
}
# Else command help
elsif (!defined($strOption))
{
my $oCommand = $$oConfigHelpData{&CONFIG_HELP_COMMAND}{$strCommand};
$strHelp =
formatText($$oCommand{&CONFIG_HELP_SUMMARY} . "\n\n" .
$$oCommand{&CONFIG_HELP_DESCRIPTION}, 0, true, $iScreenWidth + 1);
# Find longest option length and unique list of sections
my $iOptionLength = 0;
my $oSection = {};
if (defined($$oCommand{&CONFIG_HELP_OPTION}))
{
foreach my $strOption (sort(keys(%{$$oCommand{&CONFIG_HELP_OPTION}})))
{
if (length($strOption) > $iOptionLength)
{
$iOptionLength = length($strOption);
}
my ($oOption, $strSection) = optionFind($oConfigHelpData, $oOptionRule, $strCommand, $strOption);
$$oSection{$strSection}{$strOption} = $oOption;
}
# Iterate sections
foreach my $strSection (sort(keys(%{$oSection})))
{
$strHelp .=
"\n\n" . ucfirst($strSection) . " Options:\n";
# Iterate options
foreach my $strOption (sort(keys(%{$$oSection{$strSection}})))
{
$strHelp .= "\n";
my $iIndent = 4 + $iOptionLength + 2;
my $oOption = $$oSection{$strSection}{$strOption};
# Set current and default values
my $strDefault = '';
if ($$oOption{&CONFIG_HELP_CURRENT} || $$oOption{&CONFIG_HELP_DEFAULT})
{
$strDefault = undef;
if ($$oOption{&CONFIG_HELP_CURRENT})
{
$strDefault .= 'current=' . $$oOption{&CONFIG_HELP_CURRENT};
}
if ($$oOption{&CONFIG_HELP_DEFAULT})
{
if (defined($strDefault))
{
$strDefault .= ', ';
}
$strDefault .= 'default=' . $$oOption{&CONFIG_HELP_DEFAULT};
}
$strDefault = " [${strDefault}]";
}
# 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);
}
}
$strMore = "${strCommand} [option]";
$strHelp .= "\n";
}
}
# Else option help
else
{
my ($oOption) = optionFind($oConfigHelpData, $oOptionRule, $strCommand, $strOption);
# Set current and default values
my $strDefault = '';
if ($$oOption{&CONFIG_HELP_CURRENT} || $$oOption{&CONFIG_HELP_DEFAULT})
{
$strDefault = undef;
if ($$oOption{&CONFIG_HELP_CURRENT})
{
$strDefault = 'current: ' . $$oOption{&CONFIG_HELP_CURRENT};
}
if ($$oOption{&CONFIG_HELP_DEFAULT})
{
if (defined($strDefault))
{
$strDefault .= "\n";
}
$strDefault .= 'default: ' . $$oOption{&CONFIG_HELP_DEFAULT};
}
$strDefault = "\n\n${strDefault}";
}
# Output help
$strHelp =
formatText($$oOption{&CONFIG_HELP_SUMMARY} . "\n\n" . $$oOption{&CONFIG_HELP_DESCRIPTION} .
$strDefault, 0, true, $iScreenWidth + 1);
}
}
# Output help
syswrite(*STDOUT, "${strVersion} -" . (defined($strTitle) ? " ${strTitle}" : '') . " help\n\n${strHelp}\n" .
(defined($strMore) ? 'Use \'' . BACKREST_EXE . " help ${strMore}' for more information.\n" : ''));
}
push @EXPORT, qw(configHelp);
1;

7
lib/BackRest/Expire.pm
View File

@ -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;

2
lib/BackRest/FileCommon.pm
View File

@ -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

4
lib/BackRest/Protocol/IO.pm
View File

@ -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;
}
}

2
test/Vagrantfile vendored
View File

@ -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

2
test/lib/BackRestTest/BackupCommonTest.pm
View File

@ -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;

169
test/lib/BackRestTest/BackupTest.pm
View File

@ -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);

2
test/lib/BackRestTest/Common/ExecuteTest.pm
View File

@ -187,7 +187,7 @@ sub endRetry
if (!$bWait)
{
return undef;
return;
}
if (!$bFound)

8
test/lib/BackRestTest/CommonTest.pm
View File

@ -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');

204
test/lint/perlcritic.policy Normal file
View File

@ -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]

30
test/test.pl
View File

@ -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");
}