db/pgbackrest
1
0
Fork 0
mirror of https://github.com/pgbackrest/pgbackrest.git synced 2025-07-17 01:12:23 +02:00
Code Issues Releases Activity

Add LibC.template.pm to simplify LibC module generation.

Browse Source
This commit is contained in:
David Steele
2017-10-10 18:21:44 -04:00
parent abea4d1fd5
commit 08d6f14603
3 changed files with 102 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
doc/xml/release.xml
View File

@ -24,6 +24,10 @@
<release-item> <release-item>
<p>Better separation of C source from Perl interface.</p> <p>Better separation of C source from Perl interface.</p>
</release-item> </release-item>
<release-item>
<p>Add <file>LibC.template.pm</file> to simplify LibC module generation.</p>
</release-item>
</release-refactor-list> </release-refactor-list>
</release-core-list> </release-core-list>

67
libc/LibC.template.pm Normal file
View File

@ -0,0 +1,67 @@
####################################################################################################################################
# C to Perl Interface
#
# {[LIBC_AUTO_WARNING]}
####################################################################################################################################
package pgBackRest::LibC;
use 5.010001;
use strict;
use warnings;
use Carp;
require Exporter;
use AutoLoader;
our @ISA = qw(Exporter);
# Library version (.999 indicates development version)
our $VERSION = '{[LIBC_VERSION]}';
sub libCVersion {return $VERSION};
# Configuration option value constants
use constant
{
{[LIBC_CONSTANT]}
};
# Export function and constants
our %EXPORT_TAGS =
(
{[LIBC_EXPORT_TAGS]}
);
our @EXPORT_OK = (
{[LIBC_EXPORT_OK]}
);
# Nothing is exported by default
our @EXPORT = qw();
# Autoload constants from the constant() XS function
sub AUTOLOAD
{
my $strConstantFunctionName;
our $AUTOLOAD;
($strConstantFunctionName = $AUTOLOAD) =~ s/.*:://;
croak "&pgBackRest::LibC::constant not defined"
if $strConstantFunctionName eq 'constant';
my ($error, $val) = constant($strConstantFunctionName);
if ($error) {croak $error;}
{
no strict 'refs';
*$AUTOLOAD = sub {$val};
}
goto &$AUTOLOAD;
}
require XSLoader;
XSLoader::load('pgBackRest::LibC', $VERSION);
1;
__END__

117
libc/Makefile.PL
View File

@ -140,6 +140,12 @@ sub formatText
# Build file # Build file
{ {
my $strLibC = ${$oStorage->get('libc/' . LIB_NAME . '.template.pm')};
# Generate auto-build warning
my $strAutoWarning = cgenAutoWarning('Makefile.PL');
$strLibC =~ s/\{\[LIBC\_AUTO\_WARNING\]\}/$strAutoWarning/g;
# Get current version # Get current version
my $strVersion = BACKREST_VERSION; my $strVersion = BACKREST_VERSION;
my $bDev = false; my $bDev = false;
@ -150,37 +156,11 @@ sub formatText
$bDev = true; $bDev = true;
} }
my $strLibC = $strLibC =~ s/\{\[LIBC\_VERSION\]\}/$strVersion/g;
('#' x 132) . "\n" .
"# C to Perl Interface\n" .
"# \n" .
'# ' . cgenAutoWarning('Makefile.PL') . "\n" .
('#' x 132) . "\n" .
'package ' . BACKREST_NAME . '::' . LIB_NAME . ";\n" .
"\n" .
"use 5.010001;\n" .
"use strict;\n" .
"use warnings;\n" .
"use Carp;\n" .
"\n" .
"require Exporter;\n" .
"use AutoLoader;\n" .
"\n" .
"our \@ISA = qw(Exporter);\n" .
"\n" .
'# Library version' . ($bDev ? " (.999 indicates development version)" : '') . "\n" .
"our \$VERSION = '${strVersion}';\n" .
"\n" .
"sub libCVersion {return \$VERSION};\n";
# Generate constants for options that have a list of strings as allowed values # Generate constants for options that have a list of strings as allowed values
my $bFirst = true;
my $rhOptionRule = cfgdefRule(); my $rhOptionRule = cfgdefRule();
my $strConstantBlock;
$strLibC .=
"\n# Configuration option value constants\n" .
"use constant\n" .
"{\n";
foreach my $strOption (sort(keys(%{$rhOptionRule}))) foreach my $strOption (sort(keys(%{$rhOptionRule})))
{ {
@ -191,15 +171,14 @@ sub formatText
if (defined($rhOption->{&CFGBLDDEF_RULE_ALLOW_LIST})) if (defined($rhOption->{&CFGBLDDEF_RULE_ALLOW_LIST}))
{ {
$strLibC .= $bFirst ? '' : "\n"; $strConstantBlock .= defined($strConstantBlock) ? "\n" : '';
$bFirst = false;
foreach my $strValue (@{$rhOption->{&CFGBLDDEF_RULE_ALLOW_LIST}}) foreach my $strValue (@{$rhOption->{&CFGBLDDEF_RULE_ALLOW_LIST}})
{ {
my $strConstant = 'CFGOPTVAL_' . uc("${strOption}_${strValue}"); my $strConstant = 'CFGOPTVAL_' . uc("${strOption}_${strValue}");
$strConstant =~ s/\-/\_/g; $strConstant =~ s/\-/\_/g;
$strLibC .= " ${strConstant}" . (' ' x (69 - length($strConstant) - 4)) . "=> '${strValue}',\n"; $strConstantBlock .= " ${strConstant}" . (' ' x (69 - length($strConstant) - 4)) . "=> '${strValue}',\n";
push(@{$rhExport->{'config'}{&BLD_EXPORTTYPE_CONSTANT}}, $strConstant); push(@{$rhExport->{'config'}{&BLD_EXPORTTYPE_CONSTANT}}, $strConstant);
} }
} }
@ -210,32 +189,24 @@ sub formatText
if (defined($rhCommand->{&CFGBLDDEF_RULE_ALLOW_LIST})) if (defined($rhCommand->{&CFGBLDDEF_RULE_ALLOW_LIST}))
{ {
$strLibC .= $bFirst ? '' : "\n"; $strConstantBlock .= defined($strConstantBlock) ? "\n" : '';
$bFirst = false;
foreach my $strValue (@{$rhCommand->{&CFGBLDDEF_RULE_ALLOW_LIST}}) foreach my $strValue (@{$rhCommand->{&CFGBLDDEF_RULE_ALLOW_LIST}})
{ {
my $strConstant = 'CFGOPTVAL_' . uc("${strCommand}_${strOption}_${strValue}"); my $strConstant = 'CFGOPTVAL_' . uc("${strCommand}_${strOption}_${strValue}");
$strConstant =~ s/\-/\_/g; $strConstant =~ s/\-/\_/g;
$strLibC .= " ${strConstant}" . (' ' x (69 - length($strConstant) - 4)) . "=> '${strValue}',\n"; $strConstantBlock .= " ${strConstant}" . (' ' x (69 - length($strConstant) - 4)) . "=> '${strValue}',\n";
push(@{$rhExport->{'config'}{&BLD_EXPORTTYPE_CONSTANT}}, $strConstant); push(@{$rhExport->{'config'}{&BLD_EXPORTTYPE_CONSTANT}}, $strConstant);
} }
} }
} }
} }
$strLibC .= $strConstantBlock = trim($strConstantBlock);
"};\n"; $strLibC =~ s/\{\[LIBC\_CONSTANT\]\}/$strConstantBlock/g;
# Generate export sections # Generate export sections
$bFirst = true;
$strLibC .=
"\n# Export function and constants\n" .
"our \%EXPORT_TAGS =\n" .
"(\n";
foreach my $strPath (sort(keys(%{$rhBuild}))) foreach my $strPath (sort(keys(%{$rhBuild})))
{ {
foreach my $strFile (sort(keys(%{$rhBuild->{$strPath}{&BLD_FILE}}))) foreach my $strFile (sort(keys(%{$rhBuild->{$strPath}{&BLD_FILE}})))
@ -259,69 +230,41 @@ sub formatText
} }
} }
# Generate export tags
my $strExportTags;
foreach my $strSection (sort(keys(%{$rhExport}))) foreach my $strSection (sort(keys(%{$rhExport})))
{ {
my $rhExportSection = $rhExport->{$strSection}; my $rhExportSection = $rhExport->{$strSection};
$strLibC .= ($bFirst ? '' : "\n") . " '${strSection}' => [qw(\n"; $strExportTags .= (defined($strExportTags) ? "\n" : '') . " '${strSection}' => [qw(\n";
if (defined($rhExportSection->{&BLD_EXPORTTYPE_CONSTANT}) && @{$rhExportSection->{&BLD_EXPORTTYPE_CONSTANT}} > 0) if (defined($rhExportSection->{&BLD_EXPORTTYPE_CONSTANT}) && @{$rhExportSection->{&BLD_EXPORTTYPE_CONSTANT}} > 0)
{ {
$strLibC .= formatText(join(' ', sort(@{$rhExportSection->{&BLD_EXPORTTYPE_CONSTANT}})), 132, 8) . "\n"; $strExportTags .= formatText(join(' ', sort(@{$rhExportSection->{&BLD_EXPORTTYPE_CONSTANT}})), 132, 8) . "\n";
} }
if (defined($rhExportSection->{&BLD_EXPORTTYPE_SUB}) && @{$rhExportSection->{&BLD_EXPORTTYPE_SUB}} > 0) if (defined($rhExportSection->{&BLD_EXPORTTYPE_SUB}) && @{$rhExportSection->{&BLD_EXPORTTYPE_SUB}} > 0)
{ {
$strLibC .= formatText(join(' ', sort(@{$rhExportSection->{&BLD_EXPORTTYPE_SUB}})), 132, 8) . "\n"; $strExportTags .= formatText(join(' ', sort(@{$rhExportSection->{&BLD_EXPORTTYPE_SUB}})), 132, 8) . "\n";
} }
$strLibC .= " )],\n"; $strExportTags .= " )],\n";
$bFirst = false;
} }
$strLibC .= $strExportTags = trim($strExportTags);
");\n" . $strLibC =~ s/\{\[LIBC\_EXPORT\_TAGS\]\}/$strExportTags/g;
"\n" .
"our \@EXPORT_OK = (\n"; # Generate export ok
my $strExportOk;
foreach my $strSection (sort(keys(%{$rhExport}))) foreach my $strSection (sort(keys(%{$rhExport})))
{ {
$strLibC .= " \@{\$EXPORT_TAGS{'${strSection}'}},\n"; $strExportOk .= " \@{\$EXPORT_TAGS{'${strSection}'}},\n";
} }
$strLibC .= $strExportOk = trim($strExportOk);
");\n" . $strLibC =~ s/\{\[LIBC\_EXPORT\_OK\]\}/$strExportOk/g;
"\n" .
"# Nothing is exported by default\n" .
"our \@EXPORT = qw();\n" .
"\n" .
"# Autoload constants from the constant() XS function\n" .
"sub AUTOLOAD\n" .
"{\n" .
" my \$strConstantFunctionName;\n" .
" our \$AUTOLOAD;\n" .
"\n" .
" (\$strConstantFunctionName = \$AUTOLOAD) =~ s/.*:://;\n" .
"\n" .
' croak "&' . BACKREST_NAME . '::' . LIB_NAME . "::constant not defined\"\n" .
" if \$strConstantFunctionName eq 'constant';\n" .
" my (\$error, \$val) = constant(\$strConstantFunctionName);\n" .
" if (\$error) {croak \$error;}\n" .
"\n" .
" {\n" .
" no strict 'refs';\n" .
" *\$AUTOLOAD = sub {\$val};\n" .
" }\n" .
"\n" .
" goto &\$AUTOLOAD;\n" .
"}\n" .
"\n" .
"require XSLoader;\n" .
"XSLoader::load('" . BACKREST_NAME . '::' . LIB_NAME . "', \$VERSION);\n" .
"\n" .
"1;\n" .
"__END__\n";
my $strLibFile = 'libc/lib/' . BACKREST_NAME . '/' . LIB_NAME . '.pm'; my $strLibFile = 'libc/lib/' . BACKREST_NAME . '/' . LIB_NAME . '.pm';
$oStorage->pathCreate(dirname($strLibFile), {bCreateParent => true, bIgnoreExists => true}); $oStorage->pathCreate(dirname($strLibFile), {bCreateParent => true, bIgnoreExists => true});
@ -397,6 +340,8 @@ WriteMakefile
-I../src -I../src
)), )),
PM => {('lib/' . BACKREST_NAME . '/' . LIB_NAME . '.pm') => ('$(INST_LIB)/' . BACKREST_NAME . '/' . LIB_NAME . '.pm')},
C => \@stryCFile, C => \@stryCFile,
OBJECT => '$(O_FILES)', OBJECT => '$(O_FILES)',