1
0
mirror of https://github.com/pgbackrest/pgbackrest.git synced 2024-12-14 10:13:05 +02:00
pgbackrest/lib/pgBackRest/Common/String.pm
David Steele 1f120f3fce Improve performance of list requests on S3.
Any beginning literal portion of a filter expression is used to generate a search prefix which often helps keep the request small enough to avoid rate limiting.

Suggested by Mihail Shvein.
2017-10-20 14:10:16 -04:00

225 lines
6.5 KiB
Perl

####################################################################################################################################
# COMMON STRING MODULE
####################################################################################################################################
package pgBackRest::Common::String;
use strict;
use warnings FATAL => qw(all);
use Carp qw(confess longmess);
use Exporter qw(import);
our @EXPORT = qw();
use File::Basename qw(dirname);
####################################################################################################################################
# trim
#
# Trim whitespace.
####################################################################################################################################
sub trim
{
my $strBuffer = shift;
if (!defined($strBuffer))
{
return;
}
$strBuffer =~ s/^\s+|\s+$//g;
return $strBuffer;
}
push @EXPORT, qw(trim);
####################################################################################################################################
# coalesce - return first defined parameter
####################################################################################################################################
sub coalesce
{
foreach my $strParam (@_)
{
if (defined($strParam))
{
return $strParam;
}
}
return;
}
push @EXPORT, qw(coalesce);
####################################################################################################################################
# commonPrefix
#
# Determine how much of two strings is the same from the beginning.
####################################################################################################################################
sub commonPrefix
{
my $strString1 = shift;
my $strString2 = shift;
my $iCommonLen = 0;
my $iCompareLen = length($strString1) < length($strString2) ? length($strString1) : length($strString2);
for (my $iIndex = 0; $iIndex < $iCompareLen; $iIndex++)
{
if (substr($strString1, $iIndex, 1) ne substr($strString2, $iIndex, 1))
{
last;
}
$iCommonLen++;
}
return $iCommonLen;
}
push @EXPORT, qw(commonPrefix);
####################################################################################################################################
# boolFormat
#
# Output boolean as true or false.
####################################################################################################################################
sub boolFormat
{
return shift() ? 'true' : 'false';
}
push @EXPORT, qw(boolFormat);
####################################################################################################################################
# fileSizeFormat
#
# Format file sizes in human-readable form.
####################################################################################################################################
sub fileSizeFormat
{
my $lFileSize = shift;
if ($lFileSize < 1024)
{
return $lFileSize . 'B';
}
if ($lFileSize < (1024 * 1024))
{
return (int($lFileSize / 102.4) / 10) . 'KB';
}
if ($lFileSize < (1024 * 1024 * 1024))
{
return (int($lFileSize / 1024 / 102.4) / 10) . 'MB';
}
return (int($lFileSize / 1024 / 1024 / 102.4) / 10) . 'GB';
}
push @EXPORT, qw(fileSizeFormat);
####################################################################################################################################
# timestampFormat
#
# Get standard timestamp format (or formatted as specified).
####################################################################################################################################
sub timestampFormat
{
my $strFormat = shift;
my $lTime = shift;
if (!defined($strFormat))
{
$strFormat = '%4d-%02d-%02d %02d:%02d:%02d';
}
if (!defined($lTime))
{
$lTime = time();
}
my ($iSecond, $iMinute, $iHour, $iMonthDay, $iMonth, $iYear, $iWeekDay, $iYearDay, $bIsDst) = localtime($lTime);
if ($strFormat eq "%4d")
{
return sprintf($strFormat, $iYear + 1900)
}
else
{
return sprintf($strFormat, $iYear + 1900, $iMonth + 1, $iMonthDay, $iHour, $iMinute, $iSecond);
}
}
push @EXPORT, qw(timestampFormat);
####################################################################################################################################
# timestampFileFormat
####################################################################################################################################
sub timestampFileFormat
{
my $strFormat = shift;
my $lTime = shift;
return timestampFormat(defined($strFormat) ? $strFormat : '%4d%02d%02d-%02d%02d%02d', $lTime);
}
push @EXPORT, qw(timestampFileFormat);
####################################################################################################################################
# stringSplit
####################################################################################################################################
sub stringSplit
{
my $strString = shift;
my $strChar = shift;
my $iLength = shift;
if (length($strString) <= $iLength)
{
return $strString, undef;
}
my $iPos = index($strString, $strChar);
if ($iPos == -1)
{
return $strString, undef;
}
my $iNewPos = $iPos;
while ($iNewPos != -1 && $iNewPos + 1 < $iLength)
{
$iPos = $iNewPos;
$iNewPos = index($strString, $strChar, $iPos + 1);
}
return substr($strString, 0, $iPos + 1), substr($strString, $iPos + 1);
}
push @EXPORT, qw(stringSplit);
####################################################################################################################################
# regexPrefix - return the constant first part of the regex if it has a beginning anchor
#
# This works by scanning the string until the first special regex character is found so escaped characters will not be included.
####################################################################################################################################
sub regexPrefix
{
my $strExpression = shift;
my $strPrefix;
# Only generate prefix if expression is defined and has a beginning anchor
if (defined($strExpression) && $strExpression =~ /^\^/)
{
($strPrefix) = substr($strExpression, 1) =~ /^[^\.\^\$\*\+\-\?\(\)\[\]\{\}\\\|\ ]+/g;
}
return $strPrefix;
}
push @EXPORT, qw(regexPrefix);
1;