mirror of
https://github.com/pgbackrest/pgbackrest.git
synced 2024-12-12 10:04:14 +02:00
9836578520
No new Perl code is being developed, so these tools are just taking up time and making migrations to newer platforms harder. There are only a few Perl tests remaining with full coverage so the coverage tool does not warn of loss of coverage in most cases. Remove both tools and associated libraries.
65 lines
1.8 KiB
Perl
65 lines
1.8 KiB
Perl
####################################################################################################################################
|
|
# C to Perl Interface
|
|
####################################################################################################################################
|
|
package pgBackRest::LibC;
|
|
use base 'Exporter';
|
|
|
|
use 5.010001;
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
|
|
use pgBackRest::LibCAuto;
|
|
|
|
# Dynamically create constants
|
|
my $rhConstant = pgBackRest::LibCAuto::libcAutoConstant();
|
|
|
|
foreach my $strConstant (keys(%{$rhConstant}))
|
|
{
|
|
eval "use constant ${strConstant} => '" . $rhConstant->{$strConstant} . "'";
|
|
}
|
|
|
|
# Export functions and constants
|
|
our %EXPORT_TAGS = %{pgBackRest::LibCAuto::libcAutoExportTag()};
|
|
our @EXPORT_OK;
|
|
|
|
foreach my $strSection (keys(%EXPORT_TAGS))
|
|
{
|
|
# Assign values to serial constants like CFGCMD_* and CFGOPT_*. New commands and options (especially options) renumber the list
|
|
# and cause a lot of churn in the commits. This takes care of the renumbering to cut down on that churn.
|
|
my $strPrefixLast = 'XXXXXXXX';
|
|
my $iConstantIdx = 0;
|
|
|
|
foreach my $strConstant (@{$EXPORT_TAGS{$strSection}})
|
|
{
|
|
my $strPrefix = ($strConstant =~ m/^[A-Z0-9]+/g)[0];
|
|
|
|
if (defined($strPrefix))
|
|
{
|
|
if ($strPrefix ne $strPrefixLast)
|
|
{
|
|
$iConstantIdx = 0;
|
|
}
|
|
else
|
|
{
|
|
$iConstantIdx++;
|
|
}
|
|
|
|
if ($strPrefix eq 'CFGCMD' || $strPrefix eq 'CFGOPT')
|
|
{
|
|
eval "use constant ${strConstant} => ${iConstantIdx}";
|
|
}
|
|
|
|
$strPrefixLast = $strPrefix;
|
|
}
|
|
}
|
|
|
|
# OK to export everything in the tag
|
|
push(@EXPORT_OK, @{$EXPORT_TAGS{$strSection}});
|
|
}
|
|
|
|
# Nothing is exported by default
|
|
our @EXPORT = ();
|
|
|
|
1;
|