From 048571e23fc9e5b0756c0f19590fe4b74706a01e Mon Sep 17 00:00:00 2001 From: David Steele Date: Tue, 23 Feb 2016 09:25:22 -0500 Subject: [PATCH] Closed #173: Add static source code analysis 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. --- CHANGELOG.md | 2 + doc/lib/BackRestDoc/Common/DocConfig.pm | 257 +++++++++----------- doc/lib/BackRestDoc/Common/DocManifest.pm | 2 +- doc/xml/change-log.xml | 3 + lib/BackRest/Common/Ini.pm | 4 +- lib/BackRest/Common/Lock.pm | 6 +- lib/BackRest/Common/String.pm | 2 +- lib/BackRest/Common/Wait.pm | 2 +- lib/BackRest/Config/Config.pm | 72 +++--- lib/BackRest/Config/ConfigHelp.pm | 246 +++++++++---------- lib/BackRest/Expire.pm | 7 +- lib/BackRest/FileCommon.pm | 2 +- lib/BackRest/Protocol/IO.pm | 4 +- test/Vagrantfile | 2 +- test/lib/BackRestTest/BackupCommonTest.pm | 2 +- test/lib/BackRestTest/BackupTest.pm | 169 ++++++------- test/lib/BackRestTest/Common/ExecuteTest.pm | 2 +- test/lib/BackRestTest/CommonTest.pm | 8 - test/lint/perlcritic.policy | 204 ++++++++++++++++ test/test.pl | 30 ++- 20 files changed, 618 insertions(+), 408 deletions(-) create mode 100644 test/lint/perlcritic.policy 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"); }