KevinSchoenmayer/GseTDDUebungKCLR
2
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Commit

Browse Source
This commit is contained in:
Riley Schneider
2025-12-03 16:38:10 +01:00
parent c5e26bf594
commit b732d8d4b5
17680 changed files with 5977495 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

557
database/perl/vendor/lib/FFI/Build.pm vendored Normal file
View File

@@ -0,0 +1,557 @@
package FFI::Build;
use strict;
use warnings;
use 5.008004;
use FFI::Build::File::Library;
use Carp ();
use File::Glob ();
use File::Basename ();
use List::Util 1.45 ();
use Capture::Tiny ();
use File::Path ();
# ABSTRACT: Build shared libraries for use with FFI
our $VERSION = '1.34'; # VERSION
sub _native_name
{
my($self, $name) = @_;
join '', $self->platform->library_prefix, $name, scalar $self->platform->library_suffix;
}
sub new
{
my($class, $name, %args) = @_;
Carp::croak "name is required" unless defined $name;
my $self = bless {
source => [],
cflags_I => [],
cflags => [],
libs_L => [],
libs => [],
alien => [],
}, $class;
my $platform = $self->{platform} = $args{platform} || FFI::Build::Platform->default;
my $file = $self->{file} = $args{file} || FFI::Build::File::Library->new([$args{dir} || '.', $self->_native_name($name)], platform => $self->platform);
my $buildname = $self->{buildname} = $args{buildname} || '_build';
my $verbose = $self->{verbose} = $args{verbose} || 0;
my $export = $self->{export} = $args{export} || [];
if(defined $args{cflags})
{
my @flags = ref $args{cflags} ? @{ $args{cflags} } : $self->platform->shellwords($args{cflags});
push @{ $self->{cflags} }, grep !/^-I/, @flags;
push @{ $self->{cflags_I} }, grep /^-I/, @flags;
}
if(defined $args{libs})
{
my @flags = ref $args{libs} ? @{ $args{libs} } : $self->platform->shellwords($args{libs});
push @{ $self->{libs} }, grep !/^-L/, @flags;
push @{ $self->{libs_L} }, grep /^-L/, @flags;
}
if(defined $args{alien})
{
my @aliens = ref $args{alien} ? @{ $args{alien} } : ($args{alien});
foreach my $alien (@aliens)
{
unless(eval { $alien->can('cflags') && $alien->can('libs') })
{
my $pm = "$alien.pm";
$pm =~ s/::/\//g;
require $pm;
}
push @{ $self->{alien} }, $alien;
push @{ $self->{cflags} }, grep !/^-I/, $self->platform->shellwords($alien->cflags);
push @{ $self->{cflags_I} }, grep /^-I/, $self->platform->shellwords($alien->cflags);
push @{ $self->{libs} }, grep !/^-L/, $self->platform->shellwords($alien->libs);
push @{ $self->{libs_L} }, grep /^-L/, $self->platform->shellwords($alien->libs);
}
}
$self->source(ref $args{source} ? @{ $args{source} } : ($args{source})) if $args{source};
$self;
}
sub buildname { shift->{buildname} }
sub export { shift->{export} }
sub file { shift->{file} }
sub platform { shift->{platform} }
sub verbose { shift->{verbose} }
sub cflags { shift->{cflags} }
sub cflags_I { shift->{cflags_I} }
sub libs { shift->{libs} }
sub libs_L { shift->{libs_L} }
sub alien { shift->{alien} }
my @file_classes;
sub _file_classes
{
unless(@file_classes)
{
if(defined $FFI::Build::VERSION)
{
foreach my $inc (@INC)
{
push @file_classes,
map { my $f = $_; $f =~ s/\.pm$//; "FFI::Build::File::$f" }
grep !/^Base\.pm$/,
map { File::Basename::basename($_) }
File::Glob::bsd_glob(
File::Spec->catfile($inc, 'FFI', 'Build', 'File', '*.pm')
);
}
}
else
{
# When building out of git without dzil, $VERSION will not
# usually be defined and any file plugins that require a
# specific version will break, so we only use core file
# classes for that.
push @file_classes, map { "FFI::Build::File::$_" } qw( C CXX Library Object );
}
# also anything already loaded, that might not be in the
# @INC path (for testing ususally)
push @file_classes,
map { my $f = $_; $f =~ s/::$//; "FFI::Build::File::$f" }
grep !/Base::/,
grep /::$/,
keys %{FFI::Build::File::};
@file_classes = List::Util::uniq(@file_classes);
foreach my $class (@file_classes)
{
next if(eval { $class->can('new') });
my $pm = $class . ".pm";
$pm =~ s/::/\//g;
require $pm;
}
}
@file_classes;
}
sub source
{
my($self, @file_spec) = @_;
foreach my $file_spec (@file_spec)
{
if(eval { $file_spec->isa('FFI::Build::File::Base') })
{
push @{ $self->{source} }, $file_spec;
next;
}
if(ref $file_spec eq 'ARRAY')
{
my($type, $content, @args) = @$file_spec;
my $class = "FFI::Build::File::$type";
unless($class->can('new'))
{
my $pm = "FFI/Build/File/$type.pm";
require $pm;
}
push @{ $self->{source} }, $class->new(
$content,
build => $self,
platform => $self->platform,
@args
);
next;
}
my @paths = File::Glob::bsd_glob($file_spec);
path:
foreach my $path (@paths)
{
foreach my $class (_file_classes)
{
foreach my $regex ($class->accept_suffix)
{
if($path =~ $regex)
{
push @{ $self->{source} }, $class->new($path, platform => $self->platform, build => $self);
next path;
}
}
}
Carp::croak("Unknown file type: $path");
}
}
@{ $self->{source} };
}
sub build
{
my($self) = @_;
my @objects;
my $ld = $self->platform->ld;
foreach my $source ($self->source)
{
if($source->can('build_all'))
{
my $count = scalar $self->source;
if($count == 1)
{
return $source->build_all($self->file);
}
else
{
die "@{[ ref $source ]} has build_all method, but there is not exactly one source";
}
}
$ld = $source->ld if $source->ld;
my $output;
while(my $next = $source->build_item)
{
$ld = $next->ld if $next->ld;
$output = $source = $next;
}
push @objects, $output;
}
my $needs_rebuild = sub {
my(@objects) = @_;
return 1 unless -f $self->file->path;
my $target_time = [stat $self->file->path]->[9];
foreach my $object (@objects)
{
my $object_time = [stat "$object"]->[9];
return 1 if $object_time > $target_time;
}
return 0;
};
return $self->file unless $needs_rebuild->(@objects);
File::Path::mkpath($self->file->dirname, 0, oct(755));
my @cmd = (
$ld,
$self->libs_L,
$self->platform->ldflags,
(map { "$_" } @objects),
$self->libs,
$self->platform->flag_export(@{ $self->export }),
$self->platform->flag_library_output($self->file->path),
);
my($out, $exit) = Capture::Tiny::capture_merged(sub {
$self->platform->run(@cmd);
});
if($exit || !-f $self->file->path)
{
print $out;
die "error building @{[ $self->file->path ]} from @objects";
}
elsif($self->verbose >= 2)
{
print $out;
}
elsif($self->verbose >= 1)
{
print "LD @{[ $self->file->path ]}\n";
}
$self->file;
}
sub clean
{
my($self) = @_;
my $dll = $self->file->path;
unlink $dll if -f $dll;
foreach my $source ($self->source)
{
my $dir = File::Spec->catdir($source->dirname, $self->buildname);
if(-d $dir)
{
unlink $_ for File::Glob::bsd_glob("$dir/*");
rmdir $dir;
}
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build - Build shared libraries for use with FFI
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Platypus;
use FFI::Build;
my $build = FFI::Build->new(
'frooble',
source => 'ffi/*.c',
);
# $lib is an instance of FFI::Build::File::Library
my $lib = $build->build;
my $ffi = FFI::Platypus->new( api => 1 );
# The filename will be platform dependant, but something like libfrooble.so or frooble.dll
$ffi->lib($lib->path);
... # use $ffi to attach functions in ffi/*.c
=head1 DESCRIPTION
Using libffi based L<FFI::Platypus> is a great alternative to XS for writing library bindings for Perl.
Sometimes, however, you need to bundle a little C code with your FFI module, but this has never been
that easy to use. L<Module::Build::FFI> was an early attempt to address this use case, but it uses
the now out of fashion L<Module::Build>.
This module itself doesn't directly integrate with CPAN installers like L<ExtUtils::MakeMaker> or
L<Module::Build>, but there is a light weight layer L<FFI::Build::MM> that will allow you to easily
use this module with L<ExtUtils::MakeMaker>. If you are using L<Dist::Zilla> as your dist builder,
then there is also L<Dist::Zilla::Plugin::FFI::Build>, which will help with the connections.
There is some functional overlap with L<ExtUtils::CBuilder>, which was in fact used by L<Module::Build::FFI>.
For this iteration I have decided not to use that module because although it will generate dynamic libraries
that can sometimes be used by L<FFI::Platypus>, it is really designed for building XS modules, and trying
to coerce it into a more general solution has proved difficult in the past.
Supported languages out of the box are C, C++ and Fortran. Rust is supported via a language plugin,
see L<FFI::Platypus::Lang::Rust>.
=head1 CONSTRUCTOR
=head2 new
my $build = FFI::Build->new($name, %options);
Create an instance of this class. The C<$name> argument is used when computing the file name for
the library. The actual name will be something like C<lib$name.so> or C<$name.dll>. The following
options are supported:
=over 4
=item alien
List of Aliens to compile/link against. L<FFI::Build> will work with any L<Alien::Base> based
alien, or modules that provide a compatible API.
=item buildname
Directory name that will be used for building intermediate files, such as object files. This is
C<_build> by default.
=item cflags
Extra compiler flags to use. Things like C<-I/foo/include> or C<-DFOO=1>.
=item dir
The directory where the library will be written. This is C<.> by default.
=item export
Functions that should be exported (Windows + Visual C++ only)
=item file
An instance of L<FFI::Build::File::Library> to which the library will be written. Normally not needed.
=item libs
Extra library flags to use. Things like C<-L/foo/lib -lfoo>.
=item platform
An instance of L<FFI::Build::Platform>. Usually you want to omit this and use the default instance.
=item source
List of source files. You can use wildcards supported by C<bsd_glob> from L<File::Glob>.
=item verbose
By default this class does not print out the actual compiler and linker commands used in building
the library unless there is a failure. You can alter this behavior with this option. Set to
one of these values:
=over 4
=item zero (0)
Default, quiet unless there is a failure.
=item one (1)
Output the operation (compile, link, etc) and the file, but nothing else
=item two (2)
Output the complete commands run verbatim.
=back
=back
=head1 METHODS
=head2 dir
my $dir = $build->dir;
Returns the directory where the library will be written.
=head2 buildname
my $builddir = $build->builddir;
Returns the build name. This is used in computing a directory to save intermediate files like objects. For example,
if you specify a file like C<ffi/foo.c>, then the object file will be stored in C<ffi/_build/foo.o> by default.
C<_build> in this example (the default) is the build name.
=head2 export
my $exports = $build->export;
Returns a array reference of the exported functions (Windows + Visual C++ only)
=head2 file
my $file = $build->file;
Returns an instance of L<FFI::Build::File::Library> corresponding to the library being built. This is
also returned by the C<build> method below.
=head2 platform
my $platform = $build->platform;
An instance of L<FFI::Build::Platform>, which contains information about the platform on which you are building.
The default is usually reasonable.
=head2 verbose
my $verbose = $build->verbose;
Returns the verbose flag.
=head2 cflags
my @cflags = @{ $build->cflags };
Returns the compiler flags.
=head2 cflags_I
my @cflags_I = @{ $build->cflags_I };
Returns the C<-I> cflags.
=head2 libs
my @libs = @{ $build->libs };
Returns the library flags.
=head2 libs_L
my @libs = @{ $build->libs };
Returns the C<-L> library flags.
=head2 alien
my @aliens = @{ $build->alien };
Returns a the list of aliens being used.
=head2 source
$build->source(@files);
Add the C<@files> to the list of source files that will be used in building the library.
The format is the same as with the C<source> attribute above.
=head2 build
my $lib = $build->build;
This compiles the source files and links the library. Files that have already been compiled or linked
may be reused without recompiling/linking if the timestamps are newer than the source files. An instance
of L<FFI::Build::File::Library> is returned which can be used to get the path to the library, which can
be feed into L<FFI::Platypus> or similar.
=head2 clean
$build->clean;
Removes the library and intermediate files.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

357
database/perl/vendor/lib/FFI/Build/File/Base.pm vendored Normal file
View File

@@ -0,0 +1,357 @@
package FFI::Build::File::Base;
use strict;
use warnings;
use 5.008004;
use Carp ();
use FFI::Temp;
use File::Basename ();
use FFI::Build::Platform;
use overload '""' => sub { $_[0]->path }, bool => sub { 1 }, fallback => 1;
# ABSTRACT: Base class for File::Build files
our $VERSION = '1.34'; # VERSION
sub new
{
my($class, $content, %config) = @_;
my $base = $config{base} || 'ffi_build_';
my $dir = $config{dir};
my $build = $config{build};
my $platform = $config{platform} || FFI::Build::Platform->new;
my $self = bless {
platform => $platform,
build => $build,
}, $class;
if(!defined $content)
{
Carp::croak("content is required");
}
elsif(ref($content) eq 'ARRAY')
{
$self->{path} = File::Spec->catfile(@$content);
}
elsif(ref($content) eq 'SCALAR')
{
my %args;
$args{TEMPLATE} = "${base}XXXXXX";
$args{DIR} = $dir if $dir;
$args{SUFFIX} = $self->default_suffix;
$args{UNLINK} = 0;
my $fh = $self->{fh} = FFI::Temp->new(%args);
binmode( $fh, $self->default_encoding );
print $fh $$content;
close $fh;
$self->{path} = $fh->filename;
$self->{temp} = 1;
}
elsif(ref($content) eq '')
{
$self->{path} = $content;
}
if($self->platform->osname eq 'MSWin32')
{
$self->{native} = File::Spec->catfile($self->{path});
$self->{path} =~ s{\\}{/}g;
}
$self;
}
sub default_suffix { die "must define a default extension in subclass" }
sub default_encoding { die "must define an encoding" }
sub accept_suffix { () }
sub path { shift->{path} }
sub basename { File::Basename::basename shift->{path} }
sub dirname { File::Basename::dirname shift->{path} }
sub is_temp { shift->{temp} }
sub platform { shift->{platform} }
sub build { shift->{build} }
sub native {
my($self) = @_;
$self->platform->osname eq 'MSWin32'
? $self->{native}
: $self->{path};
}
sub slurp
{
my($self) = @_;
my $fh;
open($fh, '<', $self->path) || Carp::croak "Error opening @{[ $self->path ]} for read $!";
binmode($fh, $self->default_encoding);
my $content = do { local $/; <$fh> };
close $fh;
$content;
}
sub keep
{
delete shift->{temp};
}
sub build_item
{
Carp::croak("Not implemented!");
}
sub needs_rebuild
{
my($self, @source) = @_;
# if the target doesn't exist, then we definitely
# need a rebuild.
return 1 unless -f $self->path;
my $target_time = [stat $self->path]->[9];
foreach my $source (@source)
{
my $source_time = [stat "$source"]->[9];
return 1 if ! defined $source_time;
return 1 if $source_time > $target_time;
}
return 0;
}
sub ld
{
return undef;
}
sub DESTROY
{
my($self) = @_;
if($self->{temp})
{
unlink($self->path);
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::File::Base - Base class for File::Build files
=head1 VERSION
version 1.34
=head1 SYNOPSIS
Create your own file class
package FFI::Build::File::Foo;
use base qw( FFI::Build::File::Base );
use constant default_suffix => '.foo';
use constant default_encoding => ':utf8';
Use it:
# use an existing file in the filesystem
my $file = FFI::Build::File::Foo->new('src/myfile.foo');
# generate a temp file with provided content
# file will be deletd when $file falls out of scope.
my $file = FFI::Build::File::Foo->new(\'content for a temp foo');
=head1 DESCRIPTION
This class is the base class for other L<FFI::Build::File> classes.
=head1 CONSTRUCTOR
=head2 new
my $file = FFI::Build::File::Base->new(\$content, %options);
my $file = FFI::Build::File::Base->new($filename, %options);
Create a new instance of the file class. You may provide either the
content of the file as a scalar reference, or the path to an existing
filename. Options:
=over 4
=item base
The base name for any temporary file C<ffi_build_> by default.
=item build
The L<FFI::Build> instance to use.
=item dir
The directory to store any temporary file.
=item platform
The L<FFI::Build::Platform> instance to use.
=back
=head1 METHODS
=head2 default_suffix
my $suffix = $file->default_suffix;
B<MUST> be overridden in the subclass. This is the standard extension for the file type. C<.c> for a C file, C<.o> or C<.obj> for an object file depending on platform. etc.
=head2 default_encoding
my $encoding = $file->default_encoding;
B<MUST> be overridden in the subclass. This is the passed to C<binmode> when the file is opened for reading or writing.
=head2 accept_suffix
my @suffix_list = $file->accept_suffix;
Returns a list of regexes that recognize the file type.
=head2 path
my $path = $file->path;
The full or relative path to the file.
=head2 basename
my $basename = $file->basename;
The base filename part of the path.
=head2 dirname
my $dir = $file->dirname;
The directory part of the path.
=head2 is_temp
my $bool = $file->is_temp;
Returns true if the file is temporary, that is, it will be deleted when the file object falls out of scope.
You can call C<keep>, to keep the file.
=head2 platform
my $platform = $file->platform;
The L<FFI::Build::Platform> instance used for this file object.
=head2 build
my $build = $file->build;
The L<FFI::Build> instance used for this file object, if any.
=head2 native
my $path = $file->native;
Returns the operating system native version of the filename path. On Windows, this means that forward slash C<\> is
used instead of backslash C</>.
=head2 slurp
my $content = $file->slurp;
Returns the content of the file.
=head2 keep
$file->keep;
Turns off the temporary flag on the file object, meaning it will not automatically be deleted when the
file object is deallocated or falls out of scope.
=head2 build_item
$file->build_item;
Builds the file into its natural output type, usually an object file. It returns a new file instance,
or if the file is an object file then it returns empty list.
=head2 build_all
$file->build_all;
If implemented the file in question can directly create a shared or dynamic library
without needing a link step. This is useful for languages that have their own build
systems.
=head2 needs_rebuild
my $bool = $file->needs_rebuild
=head2 ld
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

244
database/perl/vendor/lib/FFI/Build/File/C.pm vendored Normal file
View File

@@ -0,0 +1,244 @@
package FFI::Build::File::C;
use strict;
use warnings;
use 5.008004;
use base qw( FFI::Build::File::Base );
use constant default_suffix => '.c';
use constant default_encoding => ':utf8';
use Capture::Tiny ();
use File::Path ();
use FFI::Build::File::Object;
# ABSTRACT: Class to track C source file in FFI::Build
our $VERSION = '1.34'; # VERSION
sub accept_suffix
{
(qr/\.(c|i)$/)
}
sub build_item
{
my($self) = @_;
my $oname = $self->basename;
$oname =~ s/\.(c(xx|pp)|i)?$//;
$oname .= $self->platform->object_suffix;
my $buildname = '_build';
$buildname = $self->build->buildname if $self->build;
my $object = FFI::Build::File::Object->new(
[ $self->dirname, $buildname, $oname ],
platform => $self->platform,
build => $self->build,
);
return $object if -f $object->path && !$object->needs_rebuild($self->_deps);
File::Path::mkpath($object->dirname, { verbose => 0, mode => oct(700) });
my @cmd = (
$self->_base_args,
-c => $self->path,
$self->platform->flag_object_output($object->path),
);
my($out, $exit) = Capture::Tiny::capture_merged(sub {
$self->platform->run(@cmd);
});
if($exit || !-f $object->path)
{
print $out;
die "error building $object from $self";
}
elsif($self->build && $self->build->verbose >= 2)
{
print $out;
}
elsif($self->build && $self->build->verbose >= 1)
{
print "CC @{[ $self->path ]}\n";
}
$object;
}
sub cc
{
my($self) = @_;
$self->platform->cc;
}
sub _base_args
{
my($self) = @_;
my @cmd = ($self->cc);
push @cmd, $self->build->cflags_I if $self->build;
push @cmd, $self->platform->ccflags;
push @cmd, @{ $self->build->cflags } if $self->build;
@cmd;
}
sub _base_args_cpp
{
my($self) = @_;
my @cmd = ($self->platform->cpp);
push @cmd, $self->build->cflags_I if $self->build;
push @cmd, grep /^-[DI]/, $self->platform->ccflags;
push @cmd, grep /^-D/, @{ $self->build->cflags } if $self->build;
@cmd;
}
sub build_item_cpp
{
my($self) = @_;
my $oname = $self->basename;
$oname =~ s/\.(c(xx|pp)|i)$?$//;
$oname .= '.i';
my $buildname = '_build';
$buildname = $self->build->buildname if $self->build;
my $ifile = FFI::Build::File::C->new(
[ $self->dirname, $buildname, $oname ],
platform => $self->platform,
build => $self->build,
);
File::Path::mkpath($ifile->dirname, { verbose => 0, mode => oct(700) });
my @cmd = (
$self->_base_args_cpp,
$self->path,
);
my($out, $err, $exit) = Capture::Tiny::capture(sub {
$self->platform->run(@cmd);
});
if($exit)
{
print "[out]\n$out\n" if defined $out && $out ne '';
print "[err]\n$err\n" if defined $err && $err ne '';
die "error building $ifile from $self";
}
else
{
my $fh;
open($fh, '>', $ifile->path);
print $fh $out;
close $fh;
}
$ifile;
}
sub _deps
{
my($self) = @_;
return $self->path unless $self->platform->cc_mm_works;
my @cmd = (
$self->_base_args,
'-MM',
$self->path,
);
my($out,$err,$exit) = Capture::Tiny::capture(sub {
$self->platform->run(@cmd);
});
if($exit)
{
print $out;
print $err;
warn "error computing dependencies for $self";
return ($self->path);
}
else
{
$out =~ s/^\+.*\n//; # remove the command line
# which on windows could have an confusing :
my(undef, $deps) = split /:/, $out, 2;
$deps =~ s/^\s+//;
$deps =~ s/\s+$//;
return grep !/^\\$/, split /\s+/, $deps;
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::File::C - Class to track C source file in FFI::Build
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Build::File::C;
my $c = FFI::Build::File::C->new('src/foo.c');
=head1 DESCRIPTION
File class for C source files.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

100
database/perl/vendor/lib/FFI/Build/File/CXX.pm vendored Normal file
View File

@@ -0,0 +1,100 @@
package FFI::Build::File::CXX;
use strict;
use warnings;
use 5.008004;
use base qw( FFI::Build::File::C );
use constant default_suffix => '.cxx';
use constant default_encoding => ':utf8';
# ABSTRACT: Class to track C source file in FFI::Build
our $VERSION = '1.34'; # VERSION
sub accept_suffix
{
(qr/\.c(xx|pp)$/)
}
sub cc
{
my($self) = @_;
$self->platform->cxx;
}
sub ld
{
my($self) = @_;
$self->platform->cxx;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::File::CXX - Class to track C source file in FFI::Build
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Build::File::CXX;
my $c = FFI::Build::File::CXX->new('src/foo.cxx');
=head1 DESCRIPTION
File class for C++ source files.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

101
database/perl/vendor/lib/FFI/Build/File/Library.pm vendored Normal file
View File

@@ -0,0 +1,101 @@
package FFI::Build::File::Library;
use strict;
use warnings;
use 5.008004;
use base qw( FFI::Build::File::Base );
use constant default_encoding => ':raw';
# ABSTRACT: Class to track object file in FFI::Build
our $VERSION = '1.34'; # VERSION
sub default_suffix
{
shift->platform->library_suffix;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::File::Library - Class to track object file in FFI::Build
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Build;
my $build = FFI::Build->new(source => 'src/*.c');
# $lib is an instance of FFI::Build::File::Library
my $lib = $build->build;
=head1 DESCRIPTION
This is a class to track a library generated by L<FFI::Build>.
This is returned by L<FFI::Build>'s build method. This class
is a subclass of L<FFI::Build::File::Base>. The most important
method is probably C<path>, which returns the path to the library
which can be passed into L<FFI::Platypus> for immediate use.
=head1 METHODS
=head2 path
my $path = $lib->path;
Returns the path of the library.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

98
database/perl/vendor/lib/FFI/Build/File/Object.pm vendored Normal file
View File

@@ -0,0 +1,98 @@
package FFI::Build::File::Object;
use strict;
use warnings;
use 5.008004;
use base qw( FFI::Build::File::Base );
use constant default_encoding => ':raw';
use Carp ();
# ABSTRACT: Class to track object file in FFI::Build
our $VERSION = '1.34'; # VERSION
sub default_suffix
{
shift->platform->object_suffix;
}
sub build_item
{
my($self) = @_;
unless(-f $self->path)
{
Carp::croak "File not built"
}
return;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::File::Object - Class to track object file in FFI::Build
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Build::File::Object;
my $o = FFI::Build::File::Object->new('src/_build/foo.o');
=head1 DESCRIPTION
This class represents an object file. You normally do not need
to use it directly.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

440
database/perl/vendor/lib/FFI/Build/MM.pm vendored Normal file
View File

@@ -0,0 +1,440 @@
package FFI::Build::MM;
use strict;
use warnings;
use 5.008004;
use Carp ();
use FFI::Build;
use JSON::PP ();
use File::Glob ();
use File::Basename ();
use File::Path ();
use File::Copy ();
use ExtUtils::MakeMaker 7.12;
# ABSTRACT: FFI::Build installer code for ExtUtils::MakeMaker
our $VERSION = '1.34'; # VERSION
sub new
{
my($class, %opt) = @_;
my $save = defined $opt{save} ? $opt{save} : 1;
my $self = bless { save => $save }, $class;
$self->load_prop;
$self;
}
sub mm_args
{
my($self, %args) = @_;
if($args{DISTNAME})
{
$self->{prop}->{distname} ||= $args{DISTNAME};
$self->{prop}->{share} ||= "blib/lib/auto/share/dist/@{[ $self->distname ]}";
$self->{prop}->{arch} ||= "blib/arch/auto/@{[ join '/', split /-/, $self->distname ]}";
$self->save_prop;
}
else
{
Carp::croak "DISTNAME is required";
}
if(my $build = $self->build)
{
foreach my $alien (@{ $build->alien })
{
next if ref $alien;
$args{BUILD_REQUIRES}->{$alien} ||= 0;
}
}
if(my $test = $self->test)
{
foreach my $alien (@{ $test->alien })
{
next if ref $alien;
$args{TEST_REQUIRES}->{$alien} ||= 0;
}
}
%args;
}
sub distname { shift->{prop}->{distname} }
sub sharedir
{
my($self, $new) = @_;
if(defined $new)
{
$self->{prop}->{share} = $new;
$self->save_prop;
}
$self->{prop}->{share};
}
sub archdir
{
my($self, $new) = @_;
if(defined $new)
{
$self->{prop}->{arch} = $new;
$self->save_prop;
}
$self->{prop}->{arch};
}
sub load_build
{
my($self, $dir, $name, $install) = @_;
return unless -d $dir;
my($fbx) = File::Glob::bsd_glob("./$dir/*.fbx");
my $options;
my $platform = FFI::Build::Platform->default;
if($fbx)
{
$name = File::Basename::basename($fbx);
$name =~ s/\.fbx$//;
$options = do {
package FFI::Build::MM::FBX;
our $DIR = $dir;
our $PLATFORM = $platform;
# make sure we catch all of the errors
# code copied from `perldoc -f do`
my $return = do $fbx;
unless ( $return ) {
Carp::croak( "couldn't parse $fbx: $@" ) if $@;
Carp::croak( "couldn't do $fbx: $!" ) unless defined $return;
Carp::croak( "couldn't run $fbx" ) unless $return;
}
$return;
};
}
else
{
$name ||= $self->distname;
$options = {
source => ["$dir/*.c", "$dir/*.cxx", "$dir/*.cpp"],
};
# if we see a Go, Rust control file then we assume the
# ffi mod is written in that language.
foreach my $control_file ("$dir/Cargo.toml", "$dir/go.mod")
{
if(-f $control_file)
{
$options->{source} = [$control_file];
last;
}
}
}
$options->{platform} ||= $platform;
$options->{dir} ||= ref $install ? $install->($options) : $install;
$options->{verbose} = 1 unless defined $options->{verbose};
FFI::Build->new($name, %$options);
}
sub build
{
my($self) = @_;
$self->{build} ||= $self->load_build('ffi', undef, $self->sharedir . "/lib");
}
sub test
{
my($self) = @_;
$self->{test} ||= $self->load_build('t/ffi', 'test', sub {
my($opt) = @_;
my $buildname = $opt->{buildname} || '_build';
"t/ffi/$buildname";
});
}
sub save_prop
{
my($self) = @_;
return unless $self->{save};
open my $fh, '>', 'fbx.json';
print $fh JSON::PP::encode_json($self->{prop});
close $fh;
}
sub load_prop
{
my($self) = @_;
return unless $self->{save};
unless(-f 'fbx.json')
{
$self->{prop} = {};
return;
}
open my $fh, '<', 'fbx.json';
$self->{prop} = JSON::PP::decode_json(do { local $/; <$fh> });
close $fh;
}
sub clean
{
my($self) = @_;
foreach my $stage (qw( build test ))
{
my $build = $self->$stage;
$build->clean if $build;
}
unlink 'fbx.json' if -f 'fbx.json';
}
sub mm_postamble
{
my($self) = @_;
my $postamble = ".PHONY: fbx_build ffi fbx_test ffi-test fbx_clean ffi-clean\n\n";
# make fbx_realclean ; make clean
$postamble .= "realclean :: fbx_clean\n" .
"\n" .
"fbx_clean ffi-clean:\n" .
"\t\$(FULLPERL) -MFFI::Build::MM=cmd -e fbx_clean\n\n";
# make fbx_build; make
$postamble .= "pure_all :: fbx_build\n" .
"\n" .
"fbx_build ffi:\n" .
"\t\$(FULLPERL) -MFFI::Build::MM=cmd -e fbx_build\n\n";
# make fbx_test; make test
$postamble .= "subdirs-test_dynamic subdirs-test_static subdirs-test :: fbx_test\n" .
"\n" .
"fbx_test ffi-test:\n" .
"\t\$(FULLPERL) -MFFI::Build::MM=cmd -e fbx_test\n\n";
$postamble;
}
sub action_build
{
my($self) = @_;
my $build = $self->build;
if($build)
{
my $lib = $build->build;
if($self->archdir)
{
File::Path::mkpath($self->archdir, 0, oct(755));
my $archfile = File::Spec->catfile($self->archdir, File::Basename::basename($self->archdir) . ".txt");
open my $fh, '>', $archfile;
my $lib_path = $lib->path;
$lib_path =~ s/^blib\/lib\///;
print $fh "FFI::Build\@$lib_path\n";
close $fh;
}
}
return;
}
sub action_test
{
my($self) = @_;
my $build = $self->test;
$build->build if $build;
}
sub action_clean
{
my($self) = @_;
my $build = $self->clean;
();
}
sub import
{
my(undef, @args) = @_;
foreach my $arg (@args)
{
if($arg eq 'cmd')
{
package main;
my $mm = sub {
my($action) = @_;
my $build = FFI::Build::MM->new;
$build->$action;
};
no warnings 'once';
*fbx_build = sub {
$mm->('action_build');
};
*fbx_test = sub {
$mm->('action_test');
};
*fbx_clean = sub {
$mm->('action_clean');
};
}
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::MM - FFI::Build installer code for ExtUtils::MakeMaker
=head1 VERSION
version 1.34
=head1 SYNOPSIS
In your Makefile.PL:
use ExtUtils::MakeMaker;
use FFI::Build::MM;
my $fbmm = FFI::Build::MM->new;
WriteMakefile($fbmm->mm_args(
ABSTRACT => 'My FFI extension',
DISTNAME => 'Foo-Bar-Baz-FFI',
NAME => 'Foo::Bar::Baz::FFI',
VERSION_FROM => 'lib/Foo/Bar/Baz/FFI.pm',
...
));
sub MY::postamble {
$fbmm->mm_postamble;
}
Then put the C, C++ or Fortran files in C<./ffi> for your runtime library
and C<./t/ffi> for your test time library.
=head1 DESCRIPTION
This module provides a thin layer between L<FFI::Build> and L<ExtUtils::MakeMaker>.
Its interface is influenced by the design of L<Alien::Build::MM>. The idea is that
for your distribution you throw some C, C++ or Fortran source files into a directory
called C<ffi> and these files will be compiled and linked into a library that can
be used by your module. There is a control file C<ffi/*.fbx> which can be used to
control the compiler and linker options. (options passed directly into L<FFI::Build>).
The interface for this file is still under development.
=head1 CONSTRUCTOR
=head2 new
my $fbmm = FFI::Build::MM->new;
Create a new instance of L<FFI::Build::MM>.
=head1 METHODS
=head2 mm_args
my %new_args = $fbmm->mm_args(%old_args);
This method does two things:
=over 4
=item reads the arguments to determine sensible defaults (library name, install location, etc).
=item adjusts the arguments as necessary and returns an updated set of arguments.
=back
=head2 mm_postamble
my $postamble = $fbmm->mm_postamble;
This returns the Makefile postamble used by L<ExtUtils::MakeMaker>. The synopsis above for
how to invoke it properly. It adds the following Make targets:
=over 4
=item fbx_build / ffi
build the main runtime library in C<./ffi>.
=item fbx_test / ffi-test
Build the test library in C<./t/ffi>.
=item fbx_clean / ffi-clean
Clean any runtime or test libraries already built.
=back
Normally you do not need to build these targets manually, they will be built automatically
at the appropriate stage.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

623
database/perl/vendor/lib/FFI/Build/Platform.pm vendored Normal file
View File

@@ -0,0 +1,623 @@
package FFI::Build::Platform;
use strict;
use warnings;
use 5.008004;
use Carp ();
use Text::ParseWords ();
use FFI::Temp;
use Capture::Tiny ();
use File::Spec;
use FFI::Platypus::ShareConfig;
# ABSTRACT: Platform specific configuration.
our $VERSION = '1.34'; # VERSION
sub new
{
my($class, $config) = @_;
$config ||= do {
require Config;
\%Config::Config;
};
my $self = bless {
config => $config,
}, $class;
$self;
}
my $default;
sub default
{
$default ||= FFI::Build::Platform->new;
}
sub _self
{
my($self) = @_;
ref $self ? $self : $self->default;
}
sub osname
{
_self(shift)->{config}->{osname};
}
sub object_suffix
{
_self(shift)->{config}->{obj_ext};
}
sub library_suffix
{
my $self = _self(shift);
my $osname = $self->osname;
my @suffix;
if($osname eq 'darwin')
{
push @suffix, '.dylib', '.bundle';
}
elsif($osname =~ /^(MSWin32|msys|cygwin)$/)
{
push @suffix, '.dll';
}
else
{
push @suffix, '.' . $self->{config}->{dlext};
}
wantarray ? @suffix : $suffix[0]; ## no critic (Freenode::Wantarray)
}
sub library_prefix
{
my $self = _self(shift);
# this almost certainly requires refinement.
if($self->osname eq 'cygwin')
{
return 'cyg';
}
elsif($self->osname eq 'msys')
{
return 'msys-';
}
elsif($self->osname eq 'MSWin32')
{
return '';
}
else
{
return 'lib';
}
}
sub cc
{
my $self = _self(shift);
my $cc = $self->{config}->{cc};
[$self->shellwords($cc)];
}
sub cpp
{
my $self = _self(shift);
my $cpp = $self->{config}->{cpprun};
[$self->shellwords($cpp)];
}
sub cxx
{
my $self = _self(shift);
my @cc = @{ $self->cc };
if($self->{config}->{ccname} eq 'gcc')
{
if($cc[0] =~ /gcc$/)
{
my @maybe = @cc;
$maybe[0] =~ s/gcc$/g++/;
return \@maybe if $self->which($maybe[0]);
}
if($cc[0] =~ /clang/)
{
my @maybe = @cc;
$maybe[0] =~ s/clang/clang++/;
return \@maybe if $self->which($maybe[0]);
}
# TODO: there are probably situations, eg solaris
# where we don't want to try c++ in the case of
# a ccname = gcc ?
my @maybe = qw( c++ g++ clang++ );
foreach my $maybe (@maybe)
{
return [$maybe] if $self->which($maybe);
}
}
elsif($self->osname eq 'MSWin32' && $self->{config}->{ccname} eq 'cl')
{
# TODO: see https://github.com/PerlFFI/FFI-Platypus/issues/203
#return \@cc;
}
Carp::croak("unable to detect corresponding C++ compiler");
}
sub for
{
my $self = _self(shift);
my @cc = @{ $self->cc };
if($self->{config}->{ccname} eq 'gcc')
{
if($cc[0] =~ /gcc$/)
{
my @maybe = @cc;
$maybe[0] =~ s/gcc$/gfortran/;
return \@maybe if $self->which($maybe[0]);
}
foreach my $maybe (qw( gfortran ))
{
return [$maybe] if $self->which($maybe);
}
}
else
{
Carp::croak("unable to detect correspnding Fortran Compiler");
}
}
sub ld
{
my($self) = @_;
my $ld = $self->{config}->{ld};
[$self->shellwords($ld)];
}
sub shellwords
{
my $self = _self(shift);
my $win = !!($self->osname eq 'MSWin32');
grep { defined $_ } map {
ref $_
# if we have an array ref then it has already been shellworded
? @$_
: do {
# remove leading whitespace, confuses some older versions of shellwords
my $str = /^\s*(.*)$/ && $1;
# escape things on windows
$str =~ s,\\,\\\\,g if $win;
Text::ParseWords::shellwords($str);
}
} @_;
}
sub ccflags
{
my $self = _self(shift);
my @ccflags;
push @ccflags, $self->shellwords($self->{config}->{cccdlflags});
push @ccflags, $self->shellwords($self->{config}->{ccflags});
push @ccflags, $self->shellwords($self->{config}->{optimize});
my $dist_include = eval { File::Spec->catdir(FFI::Platypus::ShareConfig::dist_dir('FFI-Platypus'), 'include') };
push @ccflags, "-I$dist_include" unless $@;
\@ccflags;
}
sub ldflags
{
my $self = _self(shift);
my @ldflags = $self->shellwords($self->{config}->{lddlflags});
if($self->osname eq 'cygwin')
{
no warnings 'qw';
# doesn't appear to be necessary, Perl has this in lddlflags already on cygwin
#push @ldflags, qw( -Wl,--enable-auto-import -Wl,--export-all-symbols -Wl,--enable-auto-image-base );
}
elsif($self->osname eq 'MSWin32' && $self->{config}->{ccname} eq 'cl')
{
push @ldflags, qw( -dll );
@ldflags = grep !/^-nodefaultlib$/, @ldflags;
}
elsif($self->osname eq 'MSWin32')
{
no warnings 'qw';
push @ldflags, qw( -Wl,--enable-auto-import -Wl,--export-all-symbols -Wl,--enable-auto-image-base );
}
elsif($self->osname eq 'darwin')
{
# we want to build a .dylib instead of a .bundle
@ldflags = map { $_ eq '-bundle' ? '-shared' : $_ } @ldflags;
}
\@ldflags;
}
sub cc_mm_works
{
my $self = _self(shift);
my $verbose = shift;
$verbose ||= 0;
unless(defined $self->{cc_mm_works})
{
require FFI::Build::File::C;
my $c = FFI::Build::File::C->new(\"#include \"foo.h\"\n");
my $dir = FFI::Temp->newdir;
{
open my $fh, '>', "$dir/foo.h";
print $fh "\n";
close $fh;
}
my @cmd = (
$self->cc,
$self->ccflags,
"-I$dir",
'-MM',
$c->path,
);
my($out, $exit) = Capture::Tiny::capture_merged(sub {
$self->run(@cmd);
});
if($verbose >= 2)
{
print $out;
}
elsif($verbose >= 1)
{
print "CC (checkfor -MM)\n";
}
if(!$exit && $out =~ /foo\.h/)
{
$self->{cc_mm_works} = '-MM';
}
else
{
$self->{cc_mm_works} = 0;
}
}
$self->{cc_mm_works};
}
sub flag_object_output
{
my $self = _self(shift);
my $file = shift;
if($self->osname eq 'MSWin32' && $self->{config}->{ccname} eq 'cl')
{
return ("-Fo$file");
}
else
{
return ('-o' => $file);
}
}
sub flag_library_output
{
my $self = _self(shift);
my $file = shift;
if($self->osname eq 'MSWin32' && $self->{config}->{ccname} eq 'cl')
{
return ("-OUT:$file");
}
elsif($self->osname eq 'darwin')
{
return ('-install_name' => "\@rpath/$file", -o => $file);
}
else
{
return ('-o' => $file);
}
}
sub flag_exe_output
{
my $self = _self(shift);
my $file = shift;
if($self->osname eq 'MSWin32' && $self->{config}->{ccname} eq 'cl')
{
my $file = File::Spec->rel2abs($file);
return ("/Fe:$file");
}
else
{
return ('-o' => $file);
}
}
sub flag_export
{
my $self = _self(shift);
return () unless $self->osname eq 'MSWin32' && $self->{config}->{ccname} eq 'cl';
return map { "/EXPORT:$_" } @_;
}
sub which
{
my(undef, $command) = @_;
require IPC::Cmd;
my @command = ref $command ? @$command : ($command);
IPC::Cmd::can_run($command[0]);
}
sub run
{
my $self = shift;
my @command = map { ref $_ ? @$_ : $_ } grep { defined $_ } @_;
print "+@command\n";
system @command;
$?;
}
sub _c { join ',', @_ }
sub _l { join ' ', map { ref $_ ? @$_ : $_ } @_ }
sub diag
{
my $self = _self(shift);
my @diag;
push @diag, "osname : ". _c($self->osname);
push @diag, "cc : ". _l($self->cc);
push @diag, "cxx : ". (eval { _l($self->cxx) } || '---' );
push @diag, "for : ". (eval { _l($self->for) } || '---' );
push @diag, "ld : ". _l($self->ld);
push @diag, "ccflags : ". _l($self->ccflags);
push @diag, "ldflags : ". _l($self->ldflags);
push @diag, "object suffix : ". _c($self->object_suffix);
push @diag, "library prefix : ". _c($self->library_prefix);
push @diag, "library suffix : ". _c($self->library_suffix);
push @diag, "cc mm works : ". $self->cc_mm_works;
join "\n", @diag;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Build::Platform - Platform specific configuration.
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Build::Platform;
=head1 DESCRIPTION
This class is used to abstract out the platform specific parts of the L<FFI::Build> system.
You shouldn't need to use it directly in most cases, unless you are working on L<FFI::Build>
itself.
=head1 CONSTRUCTOR
=head2 new
my $platform = FFI::Build::Platform->new;
Create a new instance of L<FFI::Build::Platform>.
=head2 default
my $platform = FFI::Build::Platform->default;
Returns the default instance of L<FFI::Build::Platform>.
=head1 METHODS
All of these methods may be called either as instance or classes
methods. If called as a class method, the default instance will
be used.
=head2 osname
my $osname = $platform->osname;
The "os name" as understood by Perl. This is the same as C<$^O>.
=head2 object_suffix
my $suffix = $platform->object_suffix;
The object suffix for the platform. On UNIX this is usually C<.o>. On Windows this
is usually C<.obj>.
=head2 library_suffix
my(@suffix) = $platform->library_suffix;
my $suffix = $platform->library_suffix;
The library suffix for the platform. On Linux and some other UNIX this is often C<.so>.
On OS X, this is C<.dylib> and C<.bundle>. On Windows this is C<.dll>.
=head2 library_prefix
my $prefix = $platform->library_prefix;
The library prefix for the platform. On Unix this is usually C<lib>, as in C<libfoo>.
=head2 cc
my @cc = @{ $platform->cc };
The C compiler
=head2 cpp
my @cpp = @{ $platform->cpp };
The C pre-processor
=head2 cxx
my @cxx = @{ $platform->cxx };
The C++ compiler that naturally goes with the C compiler.
=head2 for
my @for = @{ $platform->for };
The Fortran compiler that naturally goes with the C compiler.
=head2 ld
my $ld = $platform->ld;
The C linker
=head2 shellwords
my @words = $platform->shellwords(@strings);
This is a wrapper around L<Text::ParseWords>'s C<shellwords> with some platform workarounds
applied.
=head2 ccflags
my @ccflags = @{ $platform->cflags};
The compiler flags, including those needed to compile object files that can be linked into a dynamic library.
On Linux, for example, this is usually includes C<-fPIC>.
=head2 ldflags
my @ldflags = @{ $platform->ldflags };
The linker flags needed to link object files into a dynamic library. This is NOT the C<libs> style library
flags that specify the location and name of a library to link against, this is instead the flags that tell
the linker to generate a dynamic library. On Linux, for example, this is usually C<-shared>.
=head2 cc_mm_works
my $bool = $platform->cc_mm_works;
Returns the flags that can be passed into the C compiler to compute dependencies.
=head2 flag_object_output
my @flags = $platform->flag_object_output($object_filename);
Returns the flags that the compiler recognizes as being used to write out to a specific object filename.
=head2 flag_library_output
my @flags = $platform->flag_library_output($library_filename);
Returns the flags that the compiler recognizes as being used to write out to a specific library filename.
=head2 flag_exe_output
my @flags = $platform->flag_exe_output($library_filename);
Returns the flags that the compiler recognizes as being used to write out to a specific exe filename.
=head2 flag_export
my @flags = $platform->flag_export(@symbols);
Returns the flags that the linker recognizes for exporting functions.
=head2 which
my $path = $platform->which($command);
Returns the full path of the given command, if it is available, otherwise C<undef> is returned.
=head2 run
$platform->run(@command);
=head2 diag
Diagnostic for the platform as a string. This is for human consumption only, and the format
may and will change over time so do not attempt to use is programmatically.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

720
database/perl/vendor/lib/FFI/CheckLib.pm vendored Normal file
View File

@@ -0,0 +1,720 @@
package FFI::CheckLib;
use strict;
use warnings;
use File::Spec;
use Carp qw( croak carp );
use base qw( Exporter );
our @EXPORT = qw(
find_lib
assert_lib
check_lib
check_lib_or_exit
find_lib_or_exit
find_lib_or_die
);
our @EXPORT_OK = qw(
which
where
has_symbols
);
# ABSTRACT: Check that a library is available for FFI
our $VERSION = '0.27'; # VERSION
our $system_path = [];
our $os ||= $^O;
my $try_ld_on_text = 0;
if($os eq 'MSWin32' || $os eq 'msys')
{
$system_path = eval {
require Env;
Env->import('@PATH');
\our @PATH;
};
die $@ if $@;
}
else
{
$system_path = eval {
require DynaLoader;
no warnings 'once';
\@DynaLoader::dl_library_path;
};
die $@ if $@;
}
our $pattern = [ qr{^lib(.*?)\.so(?:\.([0-9]+(?:\.[0-9]+)*))?$} ];
our $version_split = qr/\./;
if($os eq 'cygwin')
{
push @$pattern, qr{^cyg(.*?)(?:-([0-9])+)?\.dll$};
}
elsif($os eq 'msys')
{
# doesn't seem as though msys uses psudo libfoo.so files
# in the way that cygwin sometimes does. we can revisit
# this if we find otherwise.
$pattern = [ qr{^msys-(.*?)(?:-([0-9])+)?\.dll$} ];
}
elsif($os eq 'MSWin32')
{
# handle cases like libgeos-3-7-0___.dll and libgtk-2.0-0.dll
$pattern = [ qr{^(?:lib)?(\w+?)(?:-([0-9-\.]+))?_*\.dll$}i ];
$version_split = qr/\-/;
}
elsif($os eq 'darwin')
{
push @$pattern, qr{^lib(.*?)(?:\.([0-9]+(?:\.[0-9]+)*))?\.(?:dylib|bundle)$};
}
elsif($os eq 'linux')
{
if(-e '/etc/redhat-release' && -x '/usr/bin/ld')
{
$try_ld_on_text = 1;
}
}
sub _matches
{
my($filename, $path) = @_;
foreach my $regex (@$pattern)
{
return [
$1, # 0 capture group 1 library name
File::Spec->catfile($path, $filename), # 1 full path to library
defined $2 ? (split $version_split, $2) : (), # 2... capture group 2 library version
] if $filename =~ $regex;
}
return ();
}
sub _cmp
{
my($A,$B) = @_;
return $A->[0] cmp $B->[0] if $A->[0] ne $B->[0];
my $i=2;
while(1)
{
return 0 if !defined($A->[$i]) && !defined($B->[$i]);
return -1 if !defined $A->[$i];
return 1 if !defined $B->[$i];
return $B->[$i] <=> $A->[$i] if $A->[$i] != $B->[$i];
$i++;
}
}
my $diagnostic;
sub _is_binary
{
-B $_[0]
}
sub find_lib
{
my(%args) = @_;
undef $diagnostic;
croak "find_lib requires lib argument" unless defined $args{lib};
my $recursive = $args{_r} || $args{recursive} || 0;
# make arguments be lists.
foreach my $arg (qw( lib libpath symbol verify alien ))
{
next if ref $args{$arg} eq 'ARRAY';
if(defined $args{$arg})
{
$args{$arg} = [ $args{$arg} ];
}
else
{
$args{$arg} = [];
}
}
if(defined $args{systempath} && !ref($args{systempath}))
{
$args{systempath} = [ $args{systempath} ];
}
my @path = @{ $args{libpath} };
@path = map { _recurse($_) } @path if $recursive;
push @path, grep { defined } defined $args{systempath}
? @{ $args{systempath} }
: @$system_path;
my $any = 1 if grep { $_ eq '*' } @{ $args{lib} };
my %missing = map { $_ => 1 } @{ $args{lib} };
my %symbols = map { $_ => 1 } @{ $args{symbol} };
my @found;
delete $missing{'*'};
foreach my $alien (@{ $args{alien} })
{
unless($alien =~ /^([A-Za-z_][A-Za-z_0-9]*)(::[A-Za-z_][A-Za-z_0-9]*)*$/)
{
croak "Doesn't appear to be a valid Alien name $alien";
}
unless(eval { $alien->can('dynamic_libs') })
{
my $pm = "$alien.pm";
$pm =~ s/::/\//g;
require $pm;
unless(eval { $alien->can('dynamic_libs') })
{
croak "Alien $alien doesn't provide a dynamic_libs method";
}
}
push @path, [$alien->dynamic_libs];
}
foreach my $path (@path)
{
next if ref $path ne 'ARRAY' && ! -d $path;
my @maybe =
# make determinist based on names and versions
sort { _cmp($a,$b) }
# Filter out the items that do not match the name that we are looking for
# Filter out any broken symbolic links
grep { ($any || $missing{$_->[0]} ) && (-e $_->[1]) }
ref $path eq 'ARRAY'
? do {
map {
my($v, $d, $f) = File::Spec->splitpath($_);
_matches($f, File::Spec->catpath($v,$d));
} @$path;
}
: do {
my $dh;
opendir $dh, $path;
# get [ name, full_path ] mapping,
# each entry is a 2 element list ref
map { _matches($_,$path) } readdir $dh;
};
if($try_ld_on_text && $args{try_linker_script})
{
# This is tested in t/ci.t only
@maybe = map {
-B $_->[1] ? $_ : do {
my($name, $so) = @$_;
my $output = `/usr/bin/ld -t $so -o /dev/null -shared`;
$output =~ /\((.*?lib.*\.so.*?)\)/
? [$name, $1]
: die "unable to parse ld output";
}
} @maybe;
}
midloop:
foreach my $lib (@maybe)
{
next unless $any || $missing{$lib->[0]};
foreach my $verify (@{ $args{verify} })
{
next midloop unless $verify->(@$lib);
}
delete $missing{$lib->[0]};
if(%symbols)
{
require DynaLoader;
my $dll = DynaLoader::dl_load_file($lib->[1],0);
foreach my $symbol (keys %symbols)
{
if(DynaLoader::dl_find_symbol($dll, $symbol) ? 1 : 0)
{
delete $symbols{$symbol}
}
}
DynaLoader::dl_unload_file($dll);
}
my $found = $lib->[1];
unless($any)
{
while(-l $found)
{
require File::Basename;
my $dir = File::Basename::dirname($found);
$found = File::Spec->rel2abs( readlink($found), $dir );
}
}
push @found, $found;
}
}
if(%missing)
{
my @missing = sort keys %missing;
if(@missing > 1)
{ $diagnostic = "libraries not found: @missing" }
else
{ $diagnostic = "library not found: @missing" }
}
elsif(%symbols)
{
my @missing = sort keys %symbols;
if(@missing > 1)
{ $diagnostic = "symbols not found: @missing" }
else
{ $diagnostic = "symbol not found: @missing" }
}
return if %symbols;
return $found[0] unless wantarray;
return @found;
}
sub _recurse
{
my($dir) = @_;
return unless -d $dir;
my $dh;
opendir $dh, $dir;
my @list = grep { -d $_ } map { File::Spec->catdir($dir, $_) } grep !/^\.\.?$/, readdir $dh;
closedir $dh;
($dir, map { _recurse($_) } @list);
}
sub assert_lib
{
croak $diagnostic || 'library not found' unless check_lib(@_);
}
sub check_lib_or_exit
{
unless(check_lib(@_))
{
carp $diagnostic || 'library not found';
exit;
}
}
sub find_lib_or_exit
{
my(@libs) = find_lib(@_);
unless(@libs)
{
carp $diagnostic || 'library not found';
exit;
}
return unless @libs;
wantarray ? @libs : $libs[0];
}
sub find_lib_or_die
{
my(@libs) = find_lib(@_);
unless(@libs)
{
croak $diagnostic || 'library not found';
}
return unless @libs;
wantarray ? @libs : $libs[0];
}
sub check_lib
{
find_lib(@_) ? 1 : 0;
}
sub which
{
my($name) = @_;
croak("cannot which *") if $name eq '*';
scalar find_lib( lib => $name );
}
sub where
{
my($name) = @_;
$name eq '*'
? find_lib(lib => '*')
: find_lib(lib => '*', verify => sub { $_[0] eq $name });
}
sub has_symbols
{
my($path, @symbols) = @_;
require DynaLoader;
my $dll = DynaLoader::dl_load_file($path, 0);
my $ok = 1;
foreach my $symbol (@symbols)
{
unless(DynaLoader::dl_find_symbol($dll, $symbol))
{
$ok = 0;
last;
}
}
DynaLoader::dl_unload_file($dll);
$ok;
}
sub system_path
{
$system_path;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::CheckLib - Check that a library is available for FFI
=head1 VERSION
version 0.27
=head1 SYNOPSIS
use FFI::CheckLib;
check_lib_or_exit( lib => 'jpeg', symbol => 'jinit_memory_mgr' );
check_lib_or_exit( lib => [ 'iconv', 'jpeg' ] );
# or prompt for path to library and then:
print "where to find jpeg library: ";
my $path = <STDIN>;
check_lib_or_exit( lib => 'jpeg', libpath => $path );
=head1 DESCRIPTION
This module checks whether a particular dynamic library is available for
FFI to use. It is modeled heavily on L<Devel::CheckLib>, but will find
dynamic libraries even when development packages are not installed. It
also provides a L<find_lib|FFI::CheckLib#find_lib> function that will
return the full path to the found dynamic library, which can be feed
directly into L<FFI::Platypus> or another FFI system.
Although intended mainly for FFI modules via L<FFI::Platypus> and
similar, this module does not actually use any FFI to do its detection
and probing. This module does not have any non-core runtime dependencies.
The test suite does depend on L<Test2::Suite>.
=head1 FUNCTIONS
All of these take the same named parameters and are exported by default.
=head2 find_lib
my(@libs) = find_lib(%args);
This will return a list of dynamic libraries, or empty list if none were
found.
[version 0.05]
If called in scalar context it will return the first library found.
Arguments are key value pairs with these keys:
=over 4
=item lib
Must be either a string with the name of a single library or a reference
to an array of strings of library names. Depending on your platform,
C<CheckLib> will prepend C<lib> or append C<.dll> or C<.so> when
searching.
[version 0.11]
As a special case, if C<*> is specified then any libs found will match.
=item libpath
A string or array of additional paths to search for libraries.
=item systempath
[version 0.11]
A string or array of system paths to search for instead of letting
L<FFI::CheckLib> determine the system path. You can set this to C<[]>
in order to not search I<any> system paths.
=item symbol
A string or a list of symbol names that must be found.
=item verify
A code reference used to verify a library really is the one that you
want. It should take two arguments, which is the name of the library
and the full path to the library pathname. It should return true if it
is acceptable, and false otherwise. You can use this in conjunction
with L<FFI::Platypus> to determine if it is going to meet your needs.
Example:
use FFI::CheckLib;
use FFI::Platypus;
my($lib) = find_lib(
lib => 'foo',
verify => sub {
my($name, $libpath) = @_;
my $ffi = FFI::Platypus->new;
$ffi->lib($libpath);
my $f = $ffi->function('foo_version', [] => 'int');
return $f->call() >= 500; # we accept version 500 or better
},
);
=item recursive
[version 0.11]
Recursively search for libraries in any non-system paths (those provided
via C<libpath> above).
=item try_linker_script
[version 0.24]
Some vendors provide C<.so> files that are linker scripts that point to
the real binary shared library. These linker scripts can be used by gcc
or clang, but are not directly usable by L<FFI::Platypus> and friends.
On select platforms, this options will use the linker command (C<ld>)
to attempt to resolve the real C<.so> for non-binary files. Since there
is extra overhead this is off by default.
An example is libyaml on Red Hat based Linux distributions. On Debian
these are handled with symlinks and no trickery is required.
=item alien
[version 0.25]
If no libraries can be found, try the given aliens instead. The Alien
classes specified must provide the L<Alien::Base> interface for dynamic
libraries, which is to say they should provide a method called
C<dynamic_libs> that returns a list of dynamic libraries.
=back
=head2 assert_lib
assert_lib(%args);
This behaves exactly the same as L<find_lib|FFI::CheckLib#find_lib>,
except that instead of returning empty list of failure it throws an
exception.
=head2 check_lib_or_exit
check_lib_or_exit(%args);
This behaves exactly the same as L<assert_lib|FFI::CheckLib#assert_lib>,
except that instead of dying, it warns (with exactly the same error
message) and exists. This is intended for use in C<Makefile.PL> or
C<Build.PL>
=head2 find_lib_or_exit
[version 0.05]
my(@libs) = find_lib_or_exit(%args);
This behaves exactly the same as L<find_lib|FFI::CheckLib#find_lib>,
except that if the library is not found, it will call exit with an
appropriate diagnostic.
=head2 find_lib_or_die
[version 0.06]
my(@libs) = find_lib_or_die(%args);
This behaves exactly the same as L<find_lib|FFI::CheckLib#find_lib>,
except that if the library is not found, it will die with an appropriate
diagnostic.
=head2 check_lib
my $bool = check_lib(%args);
This behaves exactly the same as L<find_lib|FFI::CheckLib#find_lib>,
except that it returns true (1) on finding the appropriate libraries or
false (0) otherwise.
=head2 which
[version 0.17]
my $path = where($name);
Return the path to the first library that matches the given name.
Not exported by default.
=head2 where
[version 0.17]
my @paths = where($name);
Return the paths to all the libraries that match the given name.
Not exported by default.
=head2 has_symbols
[version 0.17]
my $bool = has_symbols($path, @symbol_names);
Returns true if I<all> of the symbols can be found in the dynamic library located
at the given path. Can be useful in conjunction with C<verify> with C<find_lib>
above.
Not exported by default.
=head2 system_path
[version 0.20]
my $path = FFI::CheckLib::system_path;
Returns the system path as a list reference. On some systems, this is C<PATH>
on others it might be C<LD_LIBRARY_PATH> on still others it could be something
completely different. So although you I<may> add items to this list, you should
probably do some careful consideration before you do so.
This function is not exportable, even on request.
=head1 FAQ
=over 4
=item Why not just use C<dlopen>?
Calling C<dlopen> on a library name and then C<dlclose> immediately can tell
you if you have the exact name of a library available on a system. It does
have a number of drawbacks as well.
=over 4
=item No absolute or relative path
It only tells you that the library is I<somewhere> on the system, not having
the absolute or relative path makes it harder to generate useful diagnostics.
=item POSIX only
This doesn't work on non-POSIX systems like Microsoft Windows. If you are
using a POSIX emulation layer on Windows that provides C<dlopen>, like
Cygwin, there are a number of gotchas there as well. Having a layer written
in Perl handles this means that developers on Unix can develop FFI that will
more likely work on these platforms without special casing them.
=item inconsistent implementations
Even on POSIX systems you have inconsistent implementations. OpenBSD for
example don't usually include symlinks for C<.so> files meaning you need
to know the exact C<.so> version.
=item non-system directories
By default C<dlopen> only works for libraries in the system paths. Most
platforms have a way of configuring the search for different non-system
paths, but none of them are portable, and are usually discouraged anyway.
L<Alien> and friends need to do searches for dynamic libraries in
non-system directories for C<share> installs.
=back
=item My 64-bit Perl is misconfigured and has 32-bit libraries in its search path. Is that a bug in L<FFI::CheckLib>?
Nope.
=item The way L<FFI::CheckLib> is implemented it won't work on AIX, HP-UX, OpenVMS or Plan 9.
I know for a fact that it doesn't work on AIX I<as currently implemented>
because I used to develop on AIX in the early 2000s, and I am aware of some
of the technical challenges. There are probably other systems that it won't
work on. I would love to add support for these platforms. Realistically
these platforms have a tiny market share, and absent patches from users or
the companies that own these operating systems (patches welcome), or hardware
/ CPU time donations, these platforms are unsupportable anyway.
=back
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
Call library functions dynamically without a compiler.
=item L<Dist::Zilla::Plugin::FFI::CheckLib>
L<Dist::Zilla> plugin for this module.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dan Book (grinnz, DBOOK)
Ilya Pavlov (Ilya, ILUX)
Shawn Laffan (SLAFFAN)
Petr Pisar (ppisar)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2014-2018 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

2468
database/perl/vendor/lib/FFI/Platypus.pm vendored Normal file
View File

File diff suppressed because it is too large Load Diff

283
database/perl/vendor/lib/FFI/Platypus/API.pm vendored Normal file
View File

@@ -0,0 +1,283 @@
package FFI::Platypus::API;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use base qw( Exporter );
our @EXPORT = grep /^arguments_/, keys %FFI::Platypus::API::;
# ABSTRACT: Platypus arguments and return value API for custom types
our $VERSION = '1.34'; # VERSION
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::API - Platypus arguments and return value API for custom types
=head1 VERSION
version 1.34
=head1 SYNOPSIS
package FFI::Platypus::Type::MyCustomType;
use FFI::Platypus::API;
sub ffi_custom_type_api_1
{
{
native_type => 'uint32',
perl_to_native => sub {
my($value, $i) = @_;
# Translates ($value) passed in from Perl
# into ($value+1, $value+2)
arguments_set_uint32($i, $value+1);
arguments_set_uint32($i+1, $value+2);
},
argument_count => 2,
}
}
=head1 DESCRIPTION
B<NOTE>: I added this interface early on to L<FFI::Platypus>, but haven't
used it much, generally finding function wrappers to be a more powerful
(although possibly not as fast) interface. It has thus not been
tested as much as the rest of Platypus. If you feel the need to use
this interface please coordinate with the Platypus developers.
The custom types API for L<FFI::Platypus> allows you to set multiple C
arguments from a single Perl argument as a common type. This is
sometimes useful for pointer / size pairs which are a common pattern in
C, but are usually represented by a single value (a string scalar) in
Perl.
The custom type API is somewhat experimental, and you should expect some
changes as needs arise (I won't break compatibility lightly, however).
=head1 FUNCTIONS
These functions are only valid within a custom type callback.
=head2 arguments_count
my $count = argument_count;
Returns the total number of native arguments.
=head2 arguments_get_sint8
my $sint8 = arguments_get_sint8 $i;
Get the 8 bit signed integer argument from position I<$i>.
=head2 arguments_set_sint8
arguments_set_sint8 $i, $sint8;
Set the 8 bit signed integer argument at position I<$i> to I<$sint8>.
=head2 arguments_get_uint8
my $uint8 = arguments_get_uint8 $i;
Get the 8 bit unsigned integer argument from position I<$i>.
=head2 arguments_set_uint8
arguments_set_uint8 $i, $uint8;
Set the 8 bit unsigned integer argument at position I<$i> to I<$uint8>.
=head2 arguments_get_sint16
my $sint16 = arguments_get_sint16 $i;
Get the 16 bit signed integer argument from position I<$i>.
=head2 arguments_set_sint16
arguments_set_sint16 $i, $sint16;
Set the 16 bit signed integer argument at position I<$i> to I<$sint16>.
=head2 arguments_get_uint16
my $uint16 = arguments_get_uint16 $i;
Get the 16 bit unsigned integer argument from position I<$i>.
=head2 arguments_set_uint16
arguments_set_uint16 $i, $uint16;
Set the 16 bit unsigned integer argument at position I<$i> to I<$uint16>.
=head2 arguments_get_sint32
my $sint32 = arguments_get_sint32 $i;
Get the 32 bit signed integer argument from position I<$i>.
=head2 arguments_set_sint32
arguments_set_sint32 $i, $sint32;
Set the 32 bit signed integer argument at position I<$i> to I<$sint32>.
=head2 arguments_get_uint32
my $uint32 = arguments_get_uint32 $i;
Get the 32 bit unsigned integer argument from position I<$i>.
=head2 arguments_set_uint32
arguments_set_uint32 $i, $uint32;
Set the 32 bit unsigned integer argument at position I<$i> to I<$uint32>.
=head2 arguments_get_sint64
my $sint64 = arguments_get_sint64 $i;
Get the 64 bit signed integer argument from position I<$i>.
=head2 arguments_set_sint64
arguments_set_sint64 $i, $sint64;
Set the 64 bit signed integer argument at position I<$i> to I<$sint64>.
=head2 arguments_get_uint64
my $uint64 = arguments_get_uint64 $i;
Get the 64 bit unsigned integer argument from position I<$i>.
=head2 arguments_set_uint64
arguments_set_uint64 $i, $uint64;
Set the 64 bit unsigned integer argument at position I<$i> to I<$uint64>.
=head2 arguments_get_float
my $float = arguments_get_float $i;
Get the floating point argument from position I<$i>.
=head2 arguments_set_float
arguments_set_float $i, $float;
Set the floating point argument at position I<$i> to I<$float>
=head2 arguments_get_double
my $double = arguments_get_double $i;
Get the double precision floating point argument from position I<$i>.
=head2 arguments_set_double
arguments_set_double $i, $double;
Set the double precision floating point argument at position I<$i> to
I<$double>
=head2 arguments_get_pointer
my $pointer = arguments_get_pointer $i;
Get the pointer argument from position I<$i>.
=head2 arguments_set_pointer
arguments_set_pointer $i, $pointer;
Set the pointer argument at position I<$i> to I<$pointer>.
=head2 arguments_get_string
my $string = arguments_get_string $i;
Get the string argument from position I<$i>.
=head2 arguments_set_string
arguments_set_string $i, $string;
Set the string argument at position I<$i> to I<$string>.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
=back
Examples of use:
=over 4
=item L<FFI::Platypus::Type::PointerSizeBuffer>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

356
database/perl/vendor/lib/FFI/Platypus/Buffer.pm vendored Normal file
View File

@@ -0,0 +1,356 @@
package FFI::Platypus::Buffer;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use base qw( Exporter );
our @EXPORT = qw( scalar_to_buffer buffer_to_scalar );
our @EXPORT_OK = qw ( scalar_to_pointer grow set_used_length window );
# ABSTRACT: Convert scalars to C buffers
our $VERSION = '1.34'; # VERSION
use constant _incantation =>
$^O eq 'MSWin32' && do { require Config; $Config::Config{archname} =~ /MSWin32-x64/ }
? 'Q'
: 'L!';
sub scalar_to_buffer ($)
{
(unpack(_incantation, pack 'P', $_[0]), do { use bytes; length $_[0] });
}
sub scalar_to_pointer ($)
{
unpack(_incantation, pack 'P', $_[0]);
}
sub buffer_to_scalar ($$)
{
unpack 'P'.$_[1], pack _incantation, defined $_[0] ? $_[0] : 0;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Buffer - Convert scalars to C buffers
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Platypus::Buffer;
my($pointer, $size) = scalar_to_buffer $scalar;
my $scalar2 = buffer_to_scalar $pointer, $size;
=head1 DESCRIPTION
A common pattern in C is to pass a "buffer" or region of memory into a
function with a pair of arguments, an opaque pointer and the size of the
memory region. In Perl the equivalent structure is a scalar containing
a string of bytes. This module provides portable functions for
converting a Perl string or scalar into a buffer and back.
These functions are implemented using L<pack and unpack|perlpacktut> and
so they should be relatively fast.
Both functions are exported by default, but you can explicitly export
one or neither if you so choose.
A better way to do this might be with custom types see
L<FFI::Platypus::API> and L<FFI::Platypus::Type>. These functions were
taken from the now obsolete L<FFI::Util> module, as they may be useful
in some cases.
B<Caution>: This module provides great power in the way that you
interact with C code, but with that power comes great responsibility.
Since you are dealing with blocks of memory you need to take care to
understand the underlying ownership model of these pointers.
=head1 FUNCTIONS
=head2 scalar_to_buffer
my($pointer, $size) = scalar_to_buffer $scalar;
Convert a string scalar into a buffer. Returned in order are a pointer
to the start of the string scalar's memory region and the size of the
region.
You should NEVER try to free C<$pointer>.
When you pass this pointer and size into a C function, it has direct
access to the data stored in your scalar, so it is important that you
not resize or free the scalar while it is in use by the C code. Typically
if you are passing a buffer into a C function which reads or writes to
the buffer, but does not keep the pointer for later use you are okay.
If the buffer is in use long term by the C code, then you should consider
copying the buffer instead. For example:
use FFI::Platypus::Buffer qw( scalar_to_buffer );
use FFI::Platypus::Memory qw( malloc memcpy free )
my($ptr, $size) = scalar_to_buffer $string;
c_function_thaat_does_not_keep_ptr( $ptr, $size); # okay
my($ptr, $size) = scalar_to_buffer $string;
my $ptr_copy = malloc($size);
memcpy($ptr_copy, $ptr, $size);
c_function_that_DOES_keep_ptr( $ptr_copy, $size); # also okay
...
# later when you know that the c code is no longer using the pointer
# Since you allocated the copy, you are responsible for free'ing it.
free($ptr_copy);
=head2 scalar_to_pointer
my $pointer = scalar_to_pointer $scalar;
Get the pointer to the scalar. (Similar to C<scalar_to_buffer> above, but
the size of the scalar is not computed or returned).
Not exported by default, but may be exported on request.
=head2 buffer_to_scalar
my $scalar = buffer_to_scalar $pointer, $size;
Convert the buffer region defined by the pointer and size into a string
scalar.
Because of the way memory management works in Perl, the buffer is copied
from the buffer into the scalar. If this pointer was returned from C
land, then you should only free it if you allocated it.
=head2 grow
grow $scalar, $size, \%options;
Ensure that the scalar can contain at least C<$size> bytes. The
following are recognized:
=over
=item clear => I<boolean>
If true, C<$scalar> is cleared prior to being enlarged. This
avoids copying the existing contents to the reallocated memory
if they are not needed.
For example, after
$scalar = "my string";
grow $scalar, 100, { clear => 0 };
C<$scalar == "my string">, while after
$scalar = "my string";
grow $scalar, 100;
C<length($scalar) == 0>
It defaults to C<true>.
=item set_length => I<boolean>
If true, the length of the I<string> in the C<$scalar> is set to C<$size>.
(See the discussion in L</set_used_length>.) This is useful if a
foreign function writes exactly C<$size> bytes to C<$scalar>, as it avoids
a subsequent call to C<set_used_length>. Contrast this
grow my $scalar, 100;
read_exactly_100_bytes_into_scalar( scalar_to_pointer($scalar) );
@chars = unpack( 'c*', $scalar );
with this:
grow my $scalar, 100, { set_length => 0 };
read_exactly_100_bytes_into_scalar( scalar_to_pointer($scalar) );
set_used_length( $scalar, 100 );
@chars = unpack( 'c*', $scalar );
It defaults to C<true>.
=back
Any pointers obtained with C<scalar_to_pointer> or C<scalar_to_buffer>
are no longer valid after growing the scalar.
Not exported by default, but may be exported on request.
=head2 set_used_length
set_used_length $scalar, $length;
Update Perl's notion of the length of the string in the scalar. A
string scalar keeps track of two lengths: the number of available
bytes and the number of used bytes. When a string scalar is
used as a buffer by a foreign function, it is necessary to indicate
to Perl how many bytes were actually written to it so that Perl's
string functions (such as C<substr> or C<unpack>) will work correctly.
If C<$length> is larger than what the scalar can hold, it is set to the
maximum possible size.
In the following example, the foreign routine C<read_doubles>
may fill the buffer with up to a set number of doubles, returning the
number actually written.
my $sizeof_double = $ffi->sizeof( 'double' );
my $max_doubles = 100;
my $max_length = $max_doubles * $sizeof_double;
my $buffer; # length($buffer) == 0
grow $buffer, $max_length; # length($buffer) is still 0
my $pointer = scalar_to_pointer($buffer);
my $num_read = read_doubles( $pointer, $max_doubles );
# length($buffer) is still == 0
set_used_length $buffer, $num_read * $sizeof_double;
# length($buffer) is finally != 0
# unpack the native doubles into a Perl array
my @doubles = unpack( 'd*', $buffer ); # @doubles == $num_read
Not exported by default, but may be exported on request.
=head2 window
window $scalar, $pointer;
window $scalar, $pointer, $size;
window $scalar, $pointer, $size, $utf8;
This makes the scalar a read-only window into the arbitrary region of
memory defined by C<$pointer>, pointing to the start of the region
and C<$size>, the size of the region. If C<$size> is omitted then
it will assume a C style string and use the C C<strlen> function to
determine the size (the terminating C<'\0'> will not be included).
This can be useful if you have a C function that returns a buffer
pair (pointer, size), and want to access it from Perl without having
to copy the data. This can also be useful when interfacing with
programming languages that store strings as a address/length pair
instead of a pointer to null-terminated sequence of bytes.
You can specify C<$utf8> to set the UTF-8 flag on the scalar. Note
that the behavior of setting the UTF-8 flag on a buffer that does
not contain UTF-8 as understood by the version of Perl that you are
running is undefined.
I<Hint>: If you have a buffer that needs to be free'd by C once the
scalar falls out of scope you can use L<Variable::Magic> to apply
magic to the scalar and free the pointer once it falls out of scope.
use FFI::Platypus::Buffer qw( scalar_to_pointer );
use FFI::Platypus::Memory qw( strdup free );
use Variable::Magic qw( wizard cast );
my $free_when_out_of_scope = wizard(
free => sub {
my $ptr = scalar_to_pointer ${$_[0]};
free $ptr;
}
);
my $ptr = strdup "Hello Perl";
my $scalar;
window $scalar, $ptr, 10;
cast $scalar, $free_when_out_of_scope;
undef $ptr; # don't need to track the pointer anymore.
# we can now use scalar as a regular read-only Perl variable
print $scalar, "\n"; # prints "Hello Perl" without the \0
# this will free the C pointer
undef $scalar;
I<Hint>: Returning a scalar string from a Perl function actually
copies the value. If you want to return a string without copying
then you need to return a reference.
sub c_string
{
my $ptr = strdup "Hello Perl";
my $scalar;
window $scalar, $ptr, 10;
cast $scalar, $free_when_out_of_scope;
\$scalar;
}
my $ref = c_string();
print $$ref, "\n"; # prints "Hello Perl" without the \0
Not exported by default, but may be exported on request.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
Main Platypus documentation.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

625
database/perl/vendor/lib/FFI/Platypus/Bundle.pm vendored Normal file
View File

@@ -0,0 +1,625 @@
package FFI::Platypus::Bundle;
use strict;
use warnings;
use 5.008004;
use Carp ();
# ABSTRACT: Bundle foreign code with your Perl module
our $VERSION = '1.34'; # VERSION
package FFI::Platypus;
sub _bundle
{
my @arg_ptrs;
if(defined $_[-1] && ref($_[-1]) eq 'ARRAY')
{
@arg_ptrs = @{ pop @_ };
}
push @arg_ptrs, undef;
my($self, $package) = @_;
$package = caller unless defined $package;
require List::Util;
my($pm) = do {
my $pm = "$package.pm";
$pm =~ s{::}{/}g;
# if the module is already loaded, we can use %INC
# otherwise we can go through @INC and find the first .pm
# this doesn't handle all edge cases, but probably enough
List::Util::first(sub { (defined $_) && (-f $_) }, ($INC{$pm}, map { "$_/$pm" } @INC));
};
Carp::croak "unable to find module $package" unless $pm;
my @parts = split /::/, $package;
my $incroot = $pm;
{
my $c = @parts;
$incroot =~ s![\\/][^\\/]+$!! while $c--;
}
my $txtfn = List::Util::first(sub { -f $_ }, do {
my $dir = join '/', @parts;
my $file = $parts[-1] . ".txt";
(
"$incroot/auto/$dir/$file",
"$incroot/../arch/auto/$dir/$file",
);
});
my $lib;
if($txtfn)
{
$lib = do {
my $fh;
open($fh, '<', $txtfn) or die "unable to read $txtfn $!";
my $line = <$fh>;
close $fh;
$line =~ /^FFI::Build\@(.*)$/
? "$incroot/$1"
: Carp::croak "bad format $txtfn";
};
Carp::croak "bundle code is missing: $lib" unless -f $lib;
}
elsif(-d "$incroot/../ffi")
{
require FFI::Build::MM;
require Capture::Tiny;
require Cwd;
require File::Spec;
my $save = Cwd::getcwd();
chdir "$incroot/..";
my($output, $error) = Capture::Tiny::capture_merged(sub {
$lib = eval {
my $dist_name = $package;
$dist_name =~ s/::/-/g;
my $fbmm = FFI::Build::MM->new( save => 0 );
$fbmm->mm_args( DISTNAME => $dist_name );
my $build = $fbmm->load_build('ffi', undef, 'ffi/_build');
$build->build;
};
$@;
});
if($error)
{
chdir $save;
print STDERR $output;
die $error;
}
else
{
$lib = File::Spec->rel2abs($lib);
chdir $save;
}
}
else
{
Carp::croak "unable to find bundle code for $package";
}
my $handle = FFI::Platypus::DL::dlopen($lib, FFI::Platypus::DL::RTLD_PLATYPUS_DEFAULT())
or Carp::croak "error loading bundle code: $lib @{[ FFI::Platypus::DL::dlerror() ]}";
$self->{handles}->{$lib} = $handle;
$self->lib($lib);
if(my $init = eval { $self->function( 'ffi_pl_bundle_init' => [ 'string', 'sint32', 'opaque[]' ] => 'void' ) })
{
$init->call($package, scalar(@arg_ptrs)-1, \@arg_ptrs);
}
if(my $init = eval { $self->function( 'ffi_pl_bundle_constant' => [ 'string', 'opaque' ] => 'void' ) })
{
require FFI::Platypus::Constant;
my $api = FFI::Platypus::Constant->new($package);
$init->call($package, $api->ptr);
}
if(my $address = $self->find_symbol( 'ffi_pl_bundle_fini' ))
{
push @{ $self->{fini} }, sub {
my $self = shift;
$self->function( $address => [ 'string' ] => 'void' )
->call( $package );
};
}
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Bundle - Bundle foreign code with your Perl module
=head1 VERSION
version 1.34
=head1 SYNOPSIS
C<ffi/foo.c>:
#include <ffi_platypus_bundle.h>
#include <string.h>
typedef struct {
char *name;
int value;
} foo_t;
foo_t*
foo__new(const char *class_name, const char *name, int value)
{
(void)class_name;
foo_t *self = malloc( sizeof( foo_t ) );
self->name = strdup(name);
self->value = value;
return self;
}
const char *
foo__name(foo_t *self)
{
return self->name;
}
int
foo__value(foo_t *self)
{
return self->value;
}
void
foo__DESTROY(foo_t *self)
{
free(self->name);
free(self);
}
C<lib/Foo.pm>:
package Foo;
use strict;
use warnings;
use FFI::Platypus;
{
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->type('object(Foo)' => 'foo_t');
$ffi->mangler(sub {
my $name = shift;
$name =~ s/^/foo__/;
$name;
});
$ffi->bundle;
$ffi->attach( new => [ 'string', 'string', 'int' ] => 'foo_t' );
$ffi->attach( name => [ 'foo_t' ] => 'string' );
$ffi->attach( value => [ 'foo_t' ] => 'int' );
$ffi->attach( DESTROY => [ 'foo_t' ] => 'void' );
}
1;
C<t/foo.t>
use Test::More;
use Foo;
my $foo = Foo->new("platypus", 10);
isa_ok $foo, 'Foo';
is $foo->name, "platypus";
is $foo->value, 10;
done_testing;
C<Makefile.PL>:
use ExtUtils::MakeMaker;
use FFI::Build::MM;
my $fbmm = FFI::Build::MM->new;
WriteMakefile(
$fbmm->mm_args(
NAME => 'Foo',
DISTNAME => 'Foo',
VERSION => '1.00',
# ...
)
);
sub MY::postamble
{
$fbmm->mm_postamble;
}
or C<dist.ini>:
name = Foo
version = 0.01
...
[FFI::Build]
version = 1.04
=head1 DESCRIPTION
This document serves as a tutorial for using the new bundling interface provided
by L<FFI::Platypus> as of api version 1. It requires L<FFI::Platypus> of at least
1.00.
Sometimes when writing FFI bindings you need to include a little C code (or your
favorite compiled language) to finish things off. Alternatively, you might just
want to write some C code (or your favorite compiled language) to include with your
Perl module to make a tight loop faster. The bundling interface has you covered.
=head2 Basic example
To illustrate we will go through the files in the synopsis and explain
how and why they work. To start with we have some C code which emulates object
oriented code using C<foo__> as a prefix. We use a C struct that we call
C<foo_t> to store our object data. On the C level the struct acts as a class,
when combined with its functions that act as methods. The constructor just
allocates the memory it needs for the C<foo_t> instance, fills in the
appropriate fields and returns the pointer:
foo_t*
foo__new(const char *class_name, const char *name, int value)
{
(void) class_name;
foo_t *self = malloc( sizeof( foo_t ) );
self->name = strdup(name);
self->value = value;
return self;
}
We include a class name as the first argument, because Perl will include that
when calling the constructor, but we do not use it here. An exercise for the
reader would be to add hierarchical inheritance.
There are also some methods which return member values. This class has only
read only members, but you could have read/write or other methods depending
on your needs.
const char *
foo__name(foo_t *self)
{
return self->name;
}
We also include a destructor so that the memory owned by the object can be
freed when it is no longer needed.
void
foo__DESTROY(foo_t *self)
{
free(self->name);
free(self);
}
This might start to look a little like a Perl module, and when we look at the Perl
code that binds to this code, you will see why. First lets prepare the
L<FFI::Platypus> instance and specify the correct api version:
my $ffi = FFI::Platypus->new( api => 1 );
The bundle interface is only supported with api version 1, so if you try to use
version 0 it will not work. Next we define an object type for C<foo_t> which will
associate it with the Perl class C<Foo>.
$ffi->type('object(Foo)' => 'foo_t');
As object type is a blessed reference to an opaque (default) or integer type which
can be used as a Perl object. Platypus does the translating of Perl object to and
from the foo_t pointers that the C code understands. For more details on Platypus
types see L<FFI::Platypus::Type>.
Next we set the mangler on the Platypus instance so that we can refer to function
names without the C<foo__> prefix. You could just not use the prefix in your C
code and skip this step, or you could refer to the function names in their full
in your Perl code, however, this saves extra typing and allows you to bundle more
than one class with your Perl code without having to worry about name conflicts.
$ffi->mangler(sub {
my $name = shift;
$name =~ s/^/foo__/;
$name;
});
Finally we let Platypus know that we will be bundling code.
$ffi->bundle;
By default, this searches for the appropriate place for your dynamic libraries using
the current package. In some cases you may need to override this, for example if your
dist is named C<Foo-Bar> but your specific class is named C<Foo::Bar::Baz>, you'd
want something like this:
package Foo::Bar::Baz;
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->bundle('Foo::Bar');
...
Now, finally we can attach the methods for our class:
$ffi->attach( new => [ 'string', 'int' ] => 'foo_t' );
$ffi->attach( name => [ 'foo_t' ] => 'string' );
$ffi->attach( value => [ 'foo_t' ] => 'int' );
$ffi->attach( DESTROY => [ 'foo_t' ] => 'void' );
Note that we do not have to include the C<foo__> prefix because of the way we set up
the mangler. If we hadn't done that then we could instead attach with the full names:
$ffi->attach( [ 'foo__new' => 'new' ] => [ 'string', 'int' ] => 'foo_t' );
$ffi->attach( [ 'foo__name' => 'name' ] => [ 'foo_t' ] => 'string' );
...
You're done! You can now use this class. Lets write a test to make sure it works,
use strict;
use warnings;
use Test::More;
use Foo;
my $foo = Foo->new("platypus", 10);
isa_ok $foo, 'Foo';
is $foo->name, "platypus";
is $foo->value, 10;
done_testing;
and use C<prove> to check that it works:
% prove -lvm
t/foo.t ..
ok 1 - An object of class 'Foo' isa 'Foo'
ok 2
ok 3
1..3
ok
All tests successful.
Files=1, Tests=3, 0 wallclock secs ( 0.02 usr 0.00 sys + 0.14 cusr 0.03 csys = 0.19 CPU)
Result: PASS
Platypus automatically compiles and links the dynamic library for you:
% ls ffi/_build
foo.c.o libFoo.so
The C code will be rebuilt next time if the source code is newer than the object or dynamic libraries
files. If the source files are not changed, then it won't be rebuilt to save time. If you are using
the code without MakeMaker, or another build system you are responsible for cleaning up these files.
This is intended as a convenience to allow you to test your code without having to invoke MakeMaker,
or C<dzil> or whatever build system you are using.
When you distribute your module though, you will want the dynamic library built just once
at build-time and installed correctly so that it can be found at run-time. You don't need
to make any changes to your C or Perl code, but you do need to tell MakeMaker to build and
install the appropriate files using L<FFI::Build::MM>:
use ExtUtils::MakeMaker;
use FFI::Build::MM;
my $fbmm = FFI::Build::MM->new;
WriteMakefile(
$fbmm->mm_args(
NAME => 'Foo',
DISTNAME => 'Foo',
VERSION => '1.00',
# ...
)
);
sub MY::postamble
{
$fbmm->mm_postamble;
}
And we can invoke all the normal MakeMaker style stuff and our C code will be compiled, linked
and installed at the appropriate steps.
% perl Makefile.PL
Generating a Unix-style Makefile
Writing Makefile for Foo
Writing MYMETA.yml and MYMETA.json
% make
cp lib/Foo.pm blib/lib/Foo.pm
"/Users/ollisg/perl5/perlbrew/perls/perl-5.30.0/bin/perl" -MFFI::Build::MM=cmd -e fbx_build
CC ffi/foo.c
LD blib/lib/auto/share/dist/Foo/lib/libFoo.dylib
% make test
"/Users/ollisg/perl5/perlbrew/perls/perl-5.30.0/bin/perl" -MFFI::Build::MM=cmd -e fbx_build
"/Users/ollisg/perl5/perlbrew/perls/perl-5.30.0/bin/perl" -MFFI::Build::MM=cmd -e fbx_test
PERL_DL_NONLAZY=1 "/Users/ollisg/perl5/perlbrew/perls/perl-5.30.0/bin/perl" "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness(0, 'blib/lib', 'blib/arch')" t/*.t
t/foo.t .. ok
All tests successful.
Files=1, Tests=3, 0 wallclock secs ( 0.01 usr 0.00 sys + 0.06 cusr 0.01 csys = 0.08 CPU)
Result: PASS
If the C<Makefile.PL> file above looks overly complicated, you can use the
L<Dist::Zilla::Plugin::FFI::Build> plugin to simplify your life if you are
using L<Dist::Zilla>:
[FFI::Build]
version = 1.04
Specifying version 1.04 will ensure that any C<.o> or C<.so> files are pruned
from your build tree and not distributed by mistake.
=head2 Initialization example
The bundle interface also gives you entry points which will be called automatically
when your code is loaded and unloaded if they are found.
=over 4
=item C<ffi_pl_bundle_init>
void ffi_pl_bundle_init(const char *package, int argc, void *argv[]);
Called when the dynamic library is loaded. C<package> is the Perl package
that called C<bundle> from Perl space. C<argc> and C<argv> represents an
array of opaque pointers that can be passed as an array to bundle as the
last argument. (the count C<argc> is a little redundant because C<argv>
is also NULL terminated).
=item C<ffi_pl_bundle_constant>
void ffi_pl_bundle_constant(const char *package, ffi_platypus_constant_t *c);
Called immediately after C<ffi_pl_bundle_init>, and is intended to allow
you to set Perl constants from C space. For details on how this works
and what methods you can call on the C<ffi_platypus_constant_t> instance,
see L<FFI::Platypus::Constant>.
=item C<ffi_pl_bundle_fini>
void ffi_pl_bundle_fini(const char *package);
Called when the dynamic library is unloaded. C<package> is the Perl
package that called C<bundle> from Perl space when the library was
loaded. B<CAVEAT>: if you attach any functions then this will
never be called, because attaching functions locks the Platypus
instance into memory along with the libraries which it is using.
=back
Here is an example that passes the version and a callback back into Perl
space that emulates the Perl 5.10 C<say> feature.
C<ffi/init.c>:
#include <ffi_platypus_bundle.h>
char buffer[512];
const char *version;
void (*say)(const char *);
void
ffi_pl_bundle_init(const char *package, int argc, void *argv[])
{
version = argv[0];
say = argv[1];
say("in init!");
snprintf(buffer, 512, "package = %s, version = %s", package, version);
say(buffer);
snprintf(buffer, 512, "args = %d", argc);
say(buffer);
}
void
ffi_pl_bundle_fini(const char *package)
{
say("in fini!");
}
C<lib/Init.pm>:
package Init;
use strict;
use warnings;
use FFI::Platypus;
our $VERSION = '1.00';
{
my $ffi = FFI::Platypus->new( api => 1 );
my $say = $ffi->closure(sub {
my $string = shift;
print "$string\n";
});
$ffi->bundle([
$ffi->cast( 'string' => 'opaque', $VERSION ),
$ffi->cast( '(string)->void' => 'opaque', $say ),
]);
undef $ffi;
undef $say;
}
1;
The deinitialization order for the C<$say> callback and the C<$ffi>
instance is essential here, so we do it manually with C<undef>:
undef $ffi;
undef $say;
First we deallocate C<$ffi> which calls C<ffi_pl_bundle_fini>,
which calls C<$say>, so we want to make sure the latter is still
allocated. Once C<ffi_pl_bundle_fini> is done, we can safely
deallocate C<$say>.
If C<ffi_pl_bundle_fini> didn't call back into Perl space like
this then we don't have to be as careful about deallocating
things in Perl space.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

189
database/perl/vendor/lib/FFI/Platypus/Closure.pm vendored Normal file
View File

@@ -0,0 +1,189 @@
package FFI::Platypus::Closure;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use Scalar::Util qw( refaddr);
use Carp qw( croak );
use overload '&{}' => sub {
my $self = shift;
sub { $self->{code}->(@_) };
}, bool => sub { 1 }, fallback => 1;
# ABSTRACT: Platypus closure object
our $VERSION = '1.34'; # VERSION
sub new
{
my($class, $coderef) = @_;
croak "not a coderef" unless ref($coderef) eq 'CODE';
my $self = bless { code => $coderef, cbdata => {}, sticky => 0 }, $class;
$self;
}
sub add_data
{
my($self, $payload, $type) = @_;
$self->{cbdata}{$type} = bless \$payload, 'FFI::Platypus::ClosureData';
}
sub get_data
{
my($self, $type) = @_;
if (exists $self->{cbdata}->{$type}) {
return ${$self->{cbdata}->{$type}};
}
return 0;
}
sub call
{
my $self = shift;
$self->{code}->(@_)
}
sub sticky
{
my($self) = @_;
return if $self->{sticky};
$self->{sticky} = 1;
$self->_sticky;
}
sub unstick
{
my($self) = @_;
return unless $self->{sticky};
$self->{sticky} = 0;
$self->_unstick;
}
package FFI::Platypus::ClosureData;
our $VERSION = '1.34'; # VERSION
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Closure - Platypus closure object
=head1 VERSION
version 1.34
=head1 SYNOPSIS
create closure with OO interface
use FFI::Platypus::Closure;
my $closure = FFI::Platypus::Closure->new(sub { print "hello world\n" });
create closure from Platypus object
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 1 );
my $closure = $ffi->closure(sub { print "hello world\n" });
use closure
$ffi->function(foo => ['()->void'] => 'void')->call($closure);
=head1 DESCRIPTION
This class represents a Perl code reference that can be called from compiled code.
When you create a closure object, you can pass it into any function that expects
a function pointer. Care needs to be taken with closures because compiled languages
typically have a different way of handling lifetimes of objects. You have to make
sure that if the compiled code is going to call a closure that the closure object
is still in scope somewhere, or has been made sticky, otherwise you may get a
segment violation or other mysterious crash.
=head1 CONSTRUCTOR
=head2 new
my $closure = FFI::Platypus::Closure->new($coderef);
Create a new closure object; C<$coderef> must be a subroutine code reference.
=head1 METHODS
=head2 call
$closure->call(@arguments);
$closure->(@arguments);
Call the closure from Perl space. May also be invoked by treating
the closure object as a code reference.
=head2 sticky
$closure->sticky;
Mark the closure sticky, meaning that it won't be free'd even if
all the reference of the object fall out of scope.
=head2 unstick
$closure->unstick;
Unmark the closure as sticky.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

236
database/perl/vendor/lib/FFI/Platypus/Constant.pm vendored Normal file
View File

@@ -0,0 +1,236 @@
package FFI::Platypus::Constant;
use strict;
use warnings;
use 5.008004;
use constant 1.32 ();
use FFI::Platypus;
# ABSTRACT: Define constants in C space for Perl
our $VERSION = '1.34'; # VERSION
{
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->bundle;
$ffi->type( 'opaque' => 'ffi_platypus_constant_t' );
$ffi->type( '(string,string)->void' => 'set_str_t' );
$ffi->type( '(string,sint64)->void' => 'set_sint_t' );
$ffi->type( '(string,uint64)->void' => 'set_uint_t' );
$ffi->type( '(string,double)->void' => 'set_double_t' );
$ffi->mangler(sub {
my($name) = @_;
$name =~ s/^/ffi_platypus_constant__/;
$name;
});
$ffi->attach( new => [ 'set_str_t', 'set_sint_t', 'set_uint_t', 'set_double_t' ] => 'ffi_platypus_constant_t' => sub {
my($xsub, $class, $default_package) = @_;
my $f = $ffi->closure(sub {
my($name, $value) = @_;
if($name !~ /::/)
{
$name = join('::', $default_package, $name);
}
constant->import($name, $value);
});
bless {
ptr => $xsub->($f, $f, $f, $f),
f => $f,
}, $class;
});
$ffi->attach( DESTROY => ['ffi_platypus_constant_t'] => 'void' => sub {
my($xsub, $self) = @_;
$xsub->($self->ptr);
});
sub ptr { shift->{ptr} }
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Constant - Define constants in C space for Perl
=head1 VERSION
version 1.34
=head1 SYNOPSIS
C<ffi/foo.c>:
#include <ffi_platypus_bundle.h>
void
ffi_pl_bundle_constant(const char *package, ffi_platypus_constant_t *c)
{
c->set_str("FOO", "BAR"); /* sets $package::FOO to "BAR" */
c->set_str("ABC::DEF", "GHI"); /* sets ABC::DEF to GHI */
}
C<lib/Foo.pm>:
package Foo;
use strict;
use warnings;
use FFI::Platypus;
use base qw( Exporter );
my $ffi = FFI::Platypus->new;
# sets constatns Foo::FOO and ABC::DEF from C
$ffi->bundle;
1;
=head1 DESCRIPTION
The Platypus bundle interface (see L<FFI::Platypus::Bundle>) has an entry point
C<ffi_pl_bundle_constant> that lets you define constants in Perl space from C.
void ffi_pl_bundle_constant(const char *package, ffi_platypus_constant_t *c);
The first argument C<package> is the name of the Perl package. The second argument
C<c> is a struct with function pointers that lets you define constants of different
types. The first argument for each function is the name of the constant and the
second is the value. If C<::> is included in the constant name then it will be
defined in that package space. If it isn't then the constant will be defined in
whichever package called C<bundle>.
=over 4
=item set_str
c->set_str(name, value);
Sets a string constant.
=item set_sint
c->set_sint(name, value);
Sets a 64-bit signed integer constant.
=item set_uint
c->set_uint(name, value);
Sets a 64-bit unsigned integer constant.
=item set_double
c->set_double(name, value);
Sets a double precision floating point constant.
=back
=head2 Example
Suppose you have a header file C<myheader.h>:
#ifndef MYHEADER_H
#define MYHEADER_H
#define MYVERSION_STRING "1.2.3"
#define MYVERSION_MAJOR 1
#define MYVERSION_MINOR 2
#define MYVERSION_PATCH 3
enum {
MYBAD = -1,
MYOK = 1
};
#define MYPI 3.14
#endif
You can define these constants from C:
#include <ffi_platypus_bundle.h>
#include "myheader.h"
void ffi_pl_bundle_constant(const char *package, ffi_platypus_constant_t *c)
{
c->set_str("MYVERSION_STRING", MYVERSION_STRING);
c->set_uint("MYVERSION_MAJOR", MYVERSION_MAJOR);
c->set_uint("MYVERSION_MINOR", MYVERSION_MINOR);
c->set_uint("MYVERSION_PATCH", MYVERSION_PATCH);
c->set_sint("MYBAD", MYBAD);
c->set_sint("MYOK", MYOK);
c->set_double("MYPI", MYPI);
}
Your Perl code doesn't have to do anything when calling bundle:
package Const;
use strict;
use warnings;
use FFI::Platypus;
{
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->bundle;
}
1;
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

221
database/perl/vendor/lib/FFI/Platypus/DL.pm vendored Normal file
View File

@@ -0,0 +1,221 @@
package FFI::Platypus::DL;
use strict;
use warnings;
use 5.008004;
use base qw( Exporter );
require FFI::Platypus;
our @EXPORT = qw( dlopen dlerror dlsym dlclose );
push @EXPORT, grep /RTLD_/, keys %FFI::Platypus::DL::;
# ABSTRACT: Slightly non-portable interface to libdl
our $VERSION = '1.34'; # VERSION
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::DL - Slightly non-portable interface to libdl
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Platypus;
use FFI::Platypus::DL;
my $handle = dlopen("./libfoo.so", RTLD_PLATYPUS_DEFAULT);
my $address = dlsym($handle, "my_function_named_foo");
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->function($address => [] => 'void')->call;
dlclose($handle);
=head1 DESCRIPTION
This module provides an interface to libdl, the dynamic loader on UNIX. The underlying interface
has always been used by L<FFI::Platypus>, but it wasn't a public interface until version 0.52. The
name was changed with that version when it became a public interface, so be sure to specify that
version if you are going to use it.
It is somewhat non-portable for these reasons:
=over 4
=item GNU extensions
It provides some GNU extensions to platforms such as Linux that support them.
=item Windows
It provides an emulation layer on Windows. The emulation layer only supports C<RTLD_PLATYPUS_DEFAULT>
as a flag. The emulation layer emulates the convention described below of passing C<undef> as
the dynamic library name to mean, use the currently running executable. I've used it without
any problems for years, but Windows is not my main development platform.
=back
=head1 FUNCTIONS
=head2 dlopen
my $handle = dlopen($filename, $flags);
This opens a dynamic library in the context of the dynamic loader. C<$filename> is the full or
relative path to a dynamic library (usually a C<.so> on Linux and some other UNIXen, a C<.dll> on
Windows and a C<.dylib> on OS X). C<$flags> are flags that can be used to alter the behavior
of the library and the symbols it contains. The return value is an opaque pointer or C<$handle>
which can be used to look up symbols with C<dlsym>. The handle should be closed with C<dlclose>
when you are done with it.
By convention if you pass in C<undef> for the filename, the currently loaded executable will be
used instead of a separate dynamic library. This is the easiest and most portable way to find
the address of symbols in the standard C library. This convention is baked into most UNIXen,
but this capability is emulated in Windows which doesn't come with the capability out of the box.
If there is an error in opening the library then C<undef> will be returned and the diagnostic
for the failure can be retrieved with C<dlerror> as described below.
Not all flags are supported on all platforms. You can test if a flag is available using can:
if(FFI::Platypus::DL->can('RTLD_LAZY'))
{
...
}
Typically where flags are not mutually exclusive, they can be or'd together:
my $handle = dlopen("libfoo.so", RTLD_LAZY | RTLD_GLOBAL);
Check your operating system documentation for detailed descriptions of these flags.
=over 4
=item RTLD_PLATYPUS_DEFAULT
This is the L<FFI::Platypus> default for C<dlopen> (NOTE: NOT the libdl default). This is the only
flag supported on Windows. For historical reasons, this is usually C<RTLD_LAZY> on Unix and C<0> on
Windows.
=item RTLD_LAZY
Perform lazy binding.
=item RTLD_NOW
Resolve all symbols before returning from C<dlopen>. Error if all symbols cannot resolve.
=item RTLD_GLOBAL
Symbols are shared.
=item RTLD_LOCAL
Symbols are NOT shared.
=item RTLD_NODELETE
glibc 2.2 extension.
=item RTLD_NOLOAD
glibc 2.2 extension.
=item RTLD_DEEPBIND
glibc 2.3.4 extension.
=back
=head2 dlsym
my $opaque = dlsym($handle, $symbol);
This looks up the given C<$symbol> in the library pointed to by C<$handle>. If the symbol is found,
the address for that symbol is returned as an opaque pointer. This pointer can be passed into
the L<FFI::Platypus> C<function> and C<attach> methods instead of a function name.
If the symbol cannot be found then C<undef> will be returned and the diagnostic for the failure can
be retrieved with C<dlerror> as described below.
=head2 dlclose
my $status = dlclose($handle);
On success, C<dlclose> returns 0; on error, it returns a nonzero value, and the diagnostic for the
failure can be retrieved with C<dlerror> as described below.
=head2 dlerror
my $error_string = dlerror;
Returns the human readable diagnostic for the reason for the failure for the most recent C<dl>
prefixed function call.
=head1 CAVEATS
Some flags for C<dlopen> are not portable. This module may not be supported platforms added to
L<FFI::Platypus> in the future. It does work as far as I know on all of the currently supported
platforms.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

219
database/perl/vendor/lib/FFI/Platypus/Function.pm vendored Normal file
View File

@@ -0,0 +1,219 @@
package FFI::Platypus::Function;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
# ABSTRACT: An FFI function object
our $VERSION = '1.34'; # VERSION
use overload '&{}' => sub {
my $ffi = shift;
sub { $ffi->call(@_) };
}, 'bool' => sub {
my $ffi = shift;
return $ffi;
}, fallback => 1;
package FFI::Platypus::Function::Function;
use base qw( FFI::Platypus::Function );
sub attach
{
my($self, $perl_name, $proto) = @_;
my $frame = -1;
my($caller, $filename, $line);
do {
($caller, $filename, $line) = caller(++$frame);
} while( $caller =~ /^FFI::Platypus(|::Function|::Function::Wrapper|::Declare)$/ );
$perl_name = join '::', $caller, $perl_name
unless $perl_name =~ /::/;
$self->_attach($perl_name, "$filename:$line", $proto);
$self;
}
sub sub_ref
{
my($self) = @_;
my $frame = -1;
my($caller, $filename, $line);
do {
($caller, $filename, $line) = caller(++$frame);
} while( $caller =~ /^FFI::Platypus(|::Function|::Function::Wrapper|::Declare)$/ );
$self->_sub_ref("$filename:$line");
}
package FFI::Platypus::Function::Wrapper;
use base qw( FFI::Platypus::Function );
sub new
{
my($class, $function, $wrapper) = @_;
bless [ $function, $wrapper ], $class;
}
sub call
{
my($function, $wrapper) = @{ shift() };
@_ = ($function, @_);
goto &$wrapper;
}
sub attach
{
my($self, $perl_name, $proto) = @_;
my($function, $wrapper) = @{ $self };
unless($perl_name =~ /::/)
{
my $caller;
my $frame = -1;
do { $caller = caller(++$frame) } while( $caller =~ /^FFI::Platypus(|::Declare)$/ );
$perl_name = join '::', $caller, $perl_name
}
my $xsub = $function->sub_ref;
{
my $code = sub {
unshift @_, $xsub;
goto &$wrapper;
};
if(defined $proto)
{
_set_prototype($proto, $code);
}
no strict 'refs';
*{$perl_name} = $code;
}
$self;
}
sub sub_ref
{
my($self) = @_;
my($function, $wrapper) = @{ $self };
my $xsub = $function->sub_ref;
return sub {
unshift @_, $xsub;
goto &$wrapper;
};
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Function - An FFI function object
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Platypus;
# call directly
my $ffi = FFI::Platypus->new( api => 1 );
my $f = $ffi->function(puts => ['string'] => 'int');
$f->call("hello there");
# attach as xsub and call (faster for repeated calls)
$f->attach('puts');
puts('hello there');
=head1 DESCRIPTION
This class represents an unattached platypus function. For more
context and better examples see L<FFI::Platypus>.
=head1 METHODS
=head2 attach
$f->attach($name);
$f->attach($name, $prototype);
Attaches the function as an xsub (similar to calling attach directly
from an L<FFI::Platypus> instance). You may optionally include a
prototype.
=head2 call
my $ret = $f->call(@arguments);
my $ret = $f->(@arguments);
Calls the function and returns the result. You can also use the
function object B<like> a code reference.
=head2 sub_ref
my $code = $f->sub_ref;
Returns an anonymous code reference. This will usually be faster
than using the C<call> method above.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

86
database/perl/vendor/lib/FFI/Platypus/Internal.pm vendored Normal file
View File

@@ -0,0 +1,86 @@
package FFI::Platypus::Internal;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use base qw( Exporter );
require FFI::Platypus;
_init();
our @EXPORT = grep /^FFI_PL/, keys %FFI::Platypus::Internal::;
# ABSTRACT: For internal use only
our $VERSION = '1.34'; # VERSION
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Internal - For internal use only
=head1 VERSION
version 1.34
=head1 SYNOPSIS
perldoc FFI::Platypus
=head1 DESCRIPTION
This module is for internal use only. Do not rely on it having any particular behavior, or even existing in future versions.
You have been warned.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

93
database/perl/vendor/lib/FFI/Platypus/Lang.pm vendored Normal file
View File

@@ -0,0 +1,93 @@
package FFI::Platypus::Lang;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: Language specific customizations
our $VERSION = '1.34'; # VERSION
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Lang - Language specific customizations
=head1 VERSION
version 1.34
=head1 SYNOPSIS
perldoc FFI::Platypus::Lang;
=head1 DESCRIPTION
This namespace is reserved for language specific customizations of L<FFI::Platypus>.
This usually involves providing native type maps. It can also involve computing
mangled names. The default language is C, and is defined in L<FFI::Platypus::Lang::C>.
This package itself doesn't do anything, it serves only as documentation.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
=item L<FFI::Platypus::Lang::C>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

112
database/perl/vendor/lib/FFI/Platypus/Lang/ASM.pm vendored Normal file
View File

@@ -0,0 +1,112 @@
package FFI::Platypus::Lang::ASM;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: Documentation and tools for using Platypus with the Assembly
our $VERSION = '1.34'; # VERSION
sub native_type_map
{
{}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Lang::ASM - Documentation and tools for using Platypus with the Assembly
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->lang('ASM');
=head1 DESCRIPTION
Setting your lang to C<ASM> includes no native type aliases, so types
like C<int> or C<unsigned long> will not work. You need to specify
instead C<sint32> or C<sint64>. Although intended for use with Assembly
it could also be used for other languages if you did not want to use
the normal C aliases for native types.
This document will one day include information on bundling Assembly
with your Perl / FFI / Platypus distribution. Pull requests welcome!
=head1 METHODS
=head2 native_type_map
my $hashref = FFI::Platypus::Lang::ASM->native_type_map;
This returns an empty hash reference. For other languages it returns
a hash reference that defines the aliases for the types normally used
for that language.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The Core Platypus documentation.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

109
database/perl/vendor/lib/FFI/Platypus/Lang/C.pm vendored Normal file
View File

@@ -0,0 +1,109 @@
package FFI::Platypus::Lang::C;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: Documentation and tools for using Platypus with the C programming language
our $VERSION = '1.34'; # VERSION
sub native_type_map
{
require FFI::Platypus::ShareConfig;
FFI::Platypus::ShareConfig->get('type_map');
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Lang::C - Documentation and tools for using Platypus with the C programming language
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->lang('C'); # the default
=head1 DESCRIPTION
This module provides some hooks for Platypus to interact with the C
programming language. It is generally used by default if you do not
specify another foreign programming language with the
L<FFI::Platypus#lang> attribute.
=head1 METHODS
=head2 native_type_map
my $hashref = FFI::Platypus::Lang::C->native_type_map;
This returns a hash reference containing the native aliases for the
C programming languages. That is the keys are native C types and the
values are libffi native types.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The Core Platypus documentation.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

272
database/perl/vendor/lib/FFI/Platypus/Lang/Win32.pm vendored Normal file
View File

@@ -0,0 +1,272 @@
package FFI::Platypus::Lang::Win32;
use strict;
use warnings;
use 5.008004;
use Config;
# ABSTRACT: Documentation and tools for using Platypus with the Windows API
our $VERSION = '1.34'; # VERSION
sub abi
{
$^O =~ /^(cygwin|MSWin32|msys)$/ && $Config{ptrsize} == 4
? 'stdcall'
: 'default_abi';
}
my %map;
sub native_type_map
{
unless(%map)
{
require FFI::Platypus::ShareConfig;
%map = %{ FFI::Platypus::ShareConfig->get('type_map') };
my %win32_map = qw(
BOOL int
BOOLEAN BYTE
BYTE uchar
CCHAR char
CHAR char
COLORREF DWORD
DWORD uint
DWORDLONG uint64
DWORD_PTR ULONG_PTR
DWORD32 uint32
DWORD64 uint64
FLOAT float
HACCEL HANDLE
HANDLE PVOID
HBITMAP HANDLE
HBRUSH HANDLE
HCOLORSPACE HANDLE
HCONV HANDLE
HCONVLIST HANDLE
HCURSOR HICON
HDC HANDLE
HDDEDATA HANDLE
HDESK HANDLE
HDROP HANDLE
HDWP HANDLE
HENHMETAFILE HANDLE
HFILE int
HFONT HANDLE
HGDIOBJ HANDLE
HGLOBAL HANDLE
HHOOK HANDLE
HICON HANDLE
HINSTANCE HANDLE
HKEY HANDLE
HKL HANDLE
HLOCAL HANDLE
HMENU HANDLE
HMETAFILE HANDLE
HMODULE HINSTANCE
HMONITOR HANDLE
HPALETTE HANDLE
HPEN HANDLE
HRESULT LONG
HRGN HANDLE
HRSRC HANDLE
HSZ HANDLE
HWINSTA HANDLE
HWND HANDLE
INT int
INT8 sint8
INT16 sint16
INT32 sint32
INT64 sint64
LANGID WORD
LCID DWORD
LCTYPE DWORD
LGRPID DWORD
LONG sint32
LONGLONG sint64
LONG32 sint32
LONG64 sint64
LPCSTR string
LPCVOID opaque
LPVOID opaque
LRESULT LONG_PTR
PSTR string
PVOID opaque
QWORD uint64
SC_HANDLE HANDLE
SC_LOCK LPVOID
SERVICE_STATUS_HANDLE HANDLE
SHORT sint16
SIZE_T ULONG_PTR
SSIZE_T LONG_PTR
UCHAR uint8
UINT8 uint8
UINT16 uint16
UINT32 uint32
UINT64 uint64
ULONG uint32
ULONGLONG uint64
ULONG32 uint32
ULONG64 uint64
USHORT uint16
USN LONGLONG
VOID void
WORD uint16
WPARAM UINT_PTR
);
if($Config{ptrsize} == 4)
{
$win32_map{HALF_PTR} = 'sint16';
$win32_map{INT_PTR} = 'sint32';
$win32_map{LONG_PTR} = 'sint16';
$win32_map{UHALF_PTR} = 'uint16';
$win32_map{UINT_PTR} = 'uint32';
$win32_map{ULONG_PTR} = 'uint16';
}
elsif($Config{ptrsize} == 8)
{
$win32_map{HALF_PTR} = 'sint16';
$win32_map{INT_PTR} = 'sint32';
$win32_map{LONG_PTR} = 'sint16';
$win32_map{UHALF_PTR} = 'uint16';
$win32_map{UINT_PTR} = 'uint32';
$win32_map{ULONG_PTR} = 'uint16';
}
else
{
die "interesting word size you have";
}
foreach my $alias (keys %win32_map)
{
my $type = $alias;
while(1)
{
if($type =~ /^(opaque|[us]int(8|16|32|64)|float|double|string|void)$/)
{
$map{$alias} = $type;
last;
}
if(defined $map{$type})
{
$map{$alias} = $map{$type};
last;
}
if(defined $win32_map{$type})
{
$type = $win32_map{$type};
next;
}
die "unable to resolve $alias => ... => $type";
}
}
# stuff we are not yet dealing with
# LPCTSTR is unicode string, not currently supported
# LPWSTR 16 bit unicode string
# TBYTE TCHAR UNICODE_STRING WCHAR
# Not supported: POINTER_32 POINTER_64 POINTER_SIGNED POINTER_UNSIGNED
}
\%map;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Lang::Win32 - Documentation and tools for using Platypus with the Windows API
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->lang('Win32');
=head1 DESCRIPTION
This module provides the Windows datatypes used by the Windows API.
This means that you can use things like C<DWORD> as an alias for
C<uint32>.
=head1 METHODS
=head2 abi
my $abi = FFI::Platypus::Lang::Win32->abi;
=head2 native_type_map
my $hashref = FFI::Platypus::Lang::Win32->native_type_map;
This returns a hash reference containing the native aliases for the
Windows API. That is the keys are native Windows API C types and the
values are libffi native types.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The Core Platypus documentation.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

130
database/perl/vendor/lib/FFI/Platypus/Legacy.pm vendored Normal file
View File

@@ -0,0 +1,130 @@
package FFI::Platypus::Legacy;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: Legacy Platypus interfaces
our $VERSION = '1.34'; # VERSION
package FFI::Platypus;
sub _package
{
my($self, $module, $modlibname) = @_;
($module, $modlibname) = caller unless defined $modlibname;
my @modparts = split /::/, $module;
my $modfname = $modparts[-1];
my $modpname = join('/',@modparts);
my $c = @modparts;
$modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
{
my @maybe = (
"$modlibname/auto/$modpname/$modfname.txt",
"$modlibname/../arch/auto/$modpname/$modfname.txt",
);
foreach my $file (@maybe)
{
if(-f $file)
{
open my $fh, '<', $file;
my $line = <$fh>;
close $fh;
if($line =~ /^FFI::Build\@(.*)$/)
{
$self->lib("$modlibname/$1");
return $self;
}
}
}
}
require FFI::Platypus::ShareConfig;
my @dlext = @{ FFI::Platypus::ShareConfig->get("config_dlext") };
foreach my $dlext (@dlext)
{
my $file = "$modlibname/auto/$modpname/$modfname.$dlext";
unless(-e $file)
{
$modlibname =~ s,[\\/][^\\/]+$,,;
$file = "$modlibname/arch/auto/$modpname/$modfname.$dlext";
}
if(-e $file)
{
$self->lib($file);
return $self;
}
}
$self;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Legacy - Legacy Platypus interfaces
=head1 VERSION
version 1.34
=head1 DESCRIPTION
This class is private to L<FFI::Platypus>.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

219
database/perl/vendor/lib/FFI/Platypus/Memory.pm vendored Normal file
View File

@@ -0,0 +1,219 @@
package FFI::Platypus::Memory;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use base qw( Exporter );
# ABSTRACT: Memory functions for FFI
our $VERSION = '1.34'; # VERSION
our @EXPORT = qw( malloc free calloc realloc memcpy memset strdup strndup strcpy );
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->lib(undef);
$ffi->bundle;
sub _ffi { $ffi }
$ffi->attach(malloc => ['size_t'] => 'opaque' => '$');
$ffi->attach(free => ['opaque'] => 'void' => '$');
$ffi->attach(calloc => ['size_t', 'size_t'] => 'opaque' => '$$');
$ffi->attach(realloc => ['opaque', 'size_t'] => 'opaque' => '$$');
$ffi->attach(memcpy => ['opaque', 'opaque', 'size_t'] => 'opaque' => '$$$');
$ffi->attach(memset => ['opaque', 'int', 'size_t'] => 'opaque' => '$$$');
$ffi->attach(strcpy => ['opaque', 'string'] => 'opaque' => '$$');
my $_strdup_impl = 'not-loaded';
sub _strdup_impl { $_strdup_impl }
eval {
die "do not use c impl" if ($ENV{FFI_PLATYPUS_MEMORY_STRDUP_IMPL}||'libc') eq 'ffi';
$ffi->attach(strdup => ['string'] => 'opaque' => '$');
$_strdup_impl = 'libc';
};
if($@)
{
$_strdup_impl = 'ffi';
$ffi->attach([ ffi_platypus_memory__strdup => 'strdup' ] => ['string'] => 'opaque' => '$');
}
my $_strndup_impl = 'not-loaded';
sub _strndup_impl { $_strndup_impl }
eval {
die "do not use c impl" if ($ENV{FFI_PLATYPUS_MEMORY_STRDUP_IMPL}||'libc') eq 'ffi';
$ffi->attach(strndup => ['string','size_t'] => 'opaque' => '$$');
$_strndup_impl = 'libc';
};
if($@)
{
$_strndup_impl = 'ffi';
$ffi->attach([ ffi_platypus_memory__strndup => 'strndup' ] => ['string','size_t'] => 'opaque' => '$$');
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Memory - Memory functions for FFI
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Platypus::Memory;
# allocate 64 bytes of memory using the
# libc malloc function.
my $pointer = malloc 64;
# use that memory wisely
...
# free the memory when you are done.
free $pointer;
=head1 DESCRIPTION
This module provides an interface to common memory functions provided by
the standard C library. They may be useful when constructing interfaces
to C libraries with FFI. It works mostly with the C<opaque> type and it
is worth reviewing the section on opaque pointers in L<FFI::Platypus::Type>.
=head1 FUNCTIONS
=head2 calloc
my $pointer = calloc $count, $size;
The C<calloc> function contiguously allocates enough space for I<$count>
objects that are I<$size> bytes of memory each.
=head2 free
free $pointer;
The C<free> function frees the memory allocated by C<malloc>, C<calloc>,
C<realloc> or C<strdup>. It is important to only free memory that you
yourself have allocated. A good way to crash your program is to try and
free a pointer that some C library has returned to you.
=head2 malloc
my $pointer = malloc $size;
The C<malloc> function allocates I<$size> bytes of memory.
=head2 memcpy
memcpy $dst_pointer, $src_pointer, $size;
The C<memcpy> function copies I<$size> bytes from I<$src_pointer> to
I<$dst_pointer>. It also returns I<$dst_pointer>.
=head2 memset
memset $buffer, $value, $length;
The C<memset> function writes I<$length> bytes of I<$value> to the address
specified by I<$buffer>.
=head2 realloc
my $new_pointer = realloc $old_pointer, $size;
The C<realloc> function reallocates enough memory to fit I<$size> bytes.
It copies the existing data and frees I<$old_pointer>.
If you pass C<undef> in as I<$old_pointer>, then it behaves exactly like
C<malloc>:
my $pointer = realloc undef, 64; # same as malloc 64
=head2 strcpy
strcpy $opaque, $string;
Copies the string to the memory location pointed to by C<$opaque>.
=head2 strdup
my $pointer = strdup $string;
The C<strdup> function allocates enough memory to contain I<$string> and
then copies it to that newly allocated memory. This version of
C<strdup> returns an opaque pointer type, not a string type. This may
seem a little strange, but returning a string type would not be very
useful in Perl.
=head2 strndup
my $pointer = strndup $string, $max;
The same as C<strdup> above, except at most C<$max> characters will be
copied in the new string.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
Main Platypus documentation.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

557
database/perl/vendor/lib/FFI/Platypus/Record.pm vendored Normal file
View File

@@ -0,0 +1,557 @@
package FFI::Platypus::Record;
use strict;
use warnings;
use 5.008004;
use Carp qw( croak );
use FFI::Platypus;
use base qw( Exporter );
use constant 1.32 ();
our @EXPORT = qw( record_layout record_layout_1 );
# ABSTRACT: FFI support for structured records data
our $VERSION = '1.34'; # VERSION
sub record_layout_1
{
if(@_ % 2 == 0)
{
my $ffi = FFI::Platypus->new( api => 1 );
unshift @_, $ffi;
goto &record_layout;
}
elsif(defined $_[0] && ref($_[0]) eq 'ARRAY')
{
my @args = @{ shift @_ };
unshift @args, api => 1;
unshift @_, \@args;
goto &record_layout;
}
elsif(defined $_[0] && eval { $_[0]->isa('FFI::Platypus') })
{
goto &record_layout;
}
else
{
croak "odd number of arguments, but first argument is not either an array reference or Platypus instance";
}
}
sub record_layout
{
my $ffi;
if(defined $_[0])
{
if(ref($_[0]) eq 'ARRAY')
{
my @args = @{ shift() };
$ffi = FFI::Platypus->new(@args);
}
elsif(eval { $_[0]->isa('FFI::Platypus') })
{
$ffi = shift;
}
}
$ffi ||= FFI::Platypus->new;
my $offset = 0;
my $record_align = 0;
croak "uneven number of arguments!" if scalar(@_) % 2;
my($caller, $filename, $line) = caller;
if($caller->can("_ffi_record_size")
|| $caller->can("ffi_record_size"))
{
croak "record already defined for the class $caller";
}
my @destroy;
my @ffi_types;
while(@_)
{
my $spec = shift;
my $name = shift;
my $type = $ffi->{tp}->parse( $spec, { member => 1 } );
croak "illegal name $name"
unless $name =~ /^[A-Za-z_][A-Za-z_0-9]*$/
|| $name eq ':';
croak "accessor/method $name already exists"
if $caller->can($name);
my $size = $type->sizeof;
my $align = $type->alignof;
$record_align = $align if $align > $record_align;
my $meta = $type->meta;
$offset++ while $offset % $align;
{
my $count;
my $ffi_type;
if($meta->{type} eq 'record') # this means fixed string atm
{
$ffi_type = 'sint8';
$count = $size;
}
else
{
$ffi_type = $meta->{ffi_type};
$count = $meta->{element_count};
$count = 1 unless defined $count;
}
push @ffi_types, $ffi_type for 1..$count;
}
if($name ne ':')
{
if($meta->{type} eq 'string'
&& $meta->{access} eq 'rw')
{
push @destroy, eval '# line '. __LINE__ . ' "' . __FILE__ . qq("\n) .qq{
sub {
shift->$name(undef);
};
};
die $@ if $@;
}
my $full_name = join '::', $caller, $name;
my $error_str = _accessor
$full_name,
"$filename:$line",
$type,
$offset;
croak("$error_str ($spec $name)") if $error_str;
};
$offset += $size;
}
my $size = $offset;
no strict 'refs';
constant->import("${caller}::_ffi_record_size", $size);
constant->import("${caller}::_ffi_record_align", $record_align);
*{join '::', $caller, '_ffi_record_ro'} = \&_ffi_record_ro;
*{join '::', $caller, 'new'} = sub {
my $class = shift;
my $args = ref($_[0]) ? [%{$_[0]}] : \@_;
croak "uneven number of arguments to record constructor"
if @$args % 2;
my $record = "\0" x $class->_ffi_record_size;
my $self = bless \$record, $class;
while(@$args)
{
my $key = shift @$args;
my $value = shift @$args;
$self->$key($value);
}
$self;
};
{
require FFI::Platypus::Record::Meta;
my $ffi_meta = FFI::Platypus::Record::Meta->new(
\@ffi_types,
);
*{join '::', $caller, '_ffi_meta'} = sub { $ffi_meta };
}
my $destroy_sub = sub {};
if(@destroy)
{
$destroy_sub = sub {
return if _ffi_record_ro($_[0]);
$_->($_[0]) for @destroy;
};
}
do {
no strict 'refs';
*{"${caller}::DESTROY"} = $destroy_sub;
};
();
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Record - FFI support for structured records data
=head1 VERSION
version 1.34
=head1 SYNOPSIS
C:
struct my_person {
int age;
const char title[3];
const char *name
};
void process_person(struct my_person *person)
{
/* ... */
}
Perl:
package MyPerson;
use FFI::Platypus::Record;
record_layout_1(qw(
int age
string(3) title
string_rw name
));
package main;
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->lib("myperson.so");
$ffi->type("record(MyPerson)" => 'MyPerson');
my $person = MyPerson->new(
age => 40,
title => "Mr.",
name => "John Smith",
);
$ffi->attach( process_person => [ 'MyPerson*' ] => 'void' );
process_person($person);
$person->age($person->age + 1); # another year older
process_person($person);
=head1 DESCRIPTION
[version 0.21]
This module provides a mechanism for building classes that can be used
to mange structured data records (known as C as "structs" and in some
languages as "records"). A structured record is a series of bytes that
have structure understood by the C or other foreign language library
that you are interfacing with. It is designed for use with FFI and
L<FFI::Platypus>, though it may have other applications.
Before you get to deep into using this class you should also consider
the L<FFI::C>, which provides some overlapping functionality. Briefly,
it comes down to this:
=over 4
=item L<FFI::Platypus::Record>
Supports:
=over 4
=item C pointers to C<struct> types
=item Passing C <struct>s by-value.
=back
Does not support:
=over 4
=item C C<union> types.
=item C arrays of C<struct> and C<union> types.
=back
=item L<FFI::C>
Supports:
=over 4
=item C C<struct> andC<union> types
=item C arrays of C<struct> and C<union> types.
=back
Does not support:
=over 4
=item Passing C C<struct>s by-value.
=back
String members are as of this writing a TODO for L<FFI::C>, but
should be coming soon!
=back
=head1 FUNCTIONS
=head2 record_layout_1
record_layout_1($ffi, $type => $name, ... );
record_layout_1(\@ffi_args, $type => $name, ... );
record_layout_1($type => $name, ... );
Define the layout of the record. You may optionally provide an instance
of L<FFI::Platypus> as the first argument in order to use its type
aliases. Alternatively you may provide constructor arguments that will
be passed to the internal platypus instance. Thus this is the same:
my $ffi = FFI::Platypus->new( lang => 'Rust', api => 1 );
record_layout_1( $ffi, ... );
# same as:
record_layout_1( [ lang => 'Rust' ], ... );
and this is the same:
my $ffi = FFI::Platypus->new( api => 1 );
record_layout_1( $ffi, ... );
# same as:
record_layout_1( ... );
Then you provide members as type/name pairs.
For each member you declare, C<record_layout_1> will create an accessor
which can be used to read and write its value. For example imagine a
class C<Foo>:
package Foo;
use FFI::Platypus::Record;
record_layout_1(
int => 'bar', # int bar;
'string(10)' => 'baz', # char baz[10];
);
You can get and set its fields with like named C<bar> and C<baz>
accessors:
my $foo = Foo->new;
$foo->bar(22);
my $value = $foo->bar;
$foo->baz("grimlock\0\0"); # should be 10 characters long
my $string_value = $foo->baz; # includes the trailing \0\0
You can also pass initial values in to the constructor, either passing
as a list of key value pairs or by passing a hash reference:
$foo = Foo->new(
bar => 22,
baz => "grimlock\0\0",
);
# same as:
$foo = Foo->new( {
bar => 22,
baz => "grimlock\0\0",
} );
If there are members of a record that you need to account for in terms
of size and alignment, but do not want to have an accessor for, you can
use C<:> as a place holder for its name:
record_layout_1(
'int' => ':',
'string(10)' => 'baz',
);
=head3 strings
So far I've shown fixed length strings. These are declared with the
word C<string> followed by the length of the string in parentheticals.
Fixed length strings are included inside the record itself and do not
need to be allocated or deallocated separately from the record.
Variable length strings must be allocated on the heap, and thus require
a sense of "ownership", that is whomever allocates variable length
strings should be responsible for also free'ing them. To handle this,
you can add a C<ro> or C<rw> trait to a string field. The default is
C<ro>, means that you can get, but not set its value:
package Foo;
record_layout_1(
'string ro' => 'bar', # same type as 'string' and 'string_ro'
);
package main;
my $foo = Foo->new;
my $string = $foo->bar; # GOOD
$foo->bar("starscream"); # BAD
If you specify a field is C<rw>, then you can set its value:
package Foo;
record_layout_1(
'string rw' => 'bar', # same type as 'string_rw'
);
package main;
my $foo = Foo->new;
my $string = $foo->bar; # GOOD
$foo->bar("starscream"); # GOOD
Any string value that is pointed to by the record will be free'd when it
falls out of scope, so you must be very careful that any C<string rw>
fields are not set or modified by C code. You should also take care not
to copy any record that has a C<rw> string in it because its values will
be free'd twice!
use Clone qw( clone );
my $foo2 = clone $foo; # BAD bar will be free'd twice
=head3 arrays
Arrays of integer, floating points and opaque pointers are supported.
package Foo;
record_layout_1(
'int[10]' => 'bar',
);
my $foo = Foo->new;
$foo->bar([1,2,3,4,5,6,7,8,9,10]); # sets the values for the array
my $list = $foo->bar; # returns a list reference
$foo->bar(5, -6); # sets the 5th element in the array to -6
my $item = $foo->bar(5); gets the 5th element in the array
=head2 record_layout
record_layout($ffi, $type => $name, ... );
record_layout(\@ffi_args, $type => $name, ... );
record_layout($type => $name, ... );
This function works like C<record_layout> except that
C<api =E<gt> 0> is used instead of C<api =E<gt> 1>.
All new code should use C<record_layout_1> instead.
=head1 CAVEATS
These useful features (and probably more) are missing, and unlikely to be added.
=over 4
=item Unions
=item Nested records
=back
If you need these features, consider using L<FFI::C> instead.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The main platypus documentation.
=item L<FFI::C>
Another interface for constructing structured data. It includes support for
C<union> and array types (which this module does not), but lacks support for
passing records by-value.
=item L<FFI::Platypus::Record::TieArray>
Tied array interface for record array members.
=item L<Convert::Binary::C>
Another method for constructing and dissecting structured data records.
=item L<pack and unpack|perlpacktut>
Built-in Perl functions for constructing and dissecting structured data
records.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

136
database/perl/vendor/lib/FFI/Platypus/Record/Meta.pm vendored Normal file
View File

@@ -0,0 +1,136 @@
package FFI::Platypus::Record::Meta;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: FFI support for structured records data
our $VERSION = '1.34'; # VERSION
{
require FFI::Platypus;
my $ffi = FFI::Platypus->new(
api => 1,
);
$ffi->bundle;
$ffi->mangler(sub {
my($name) = @_;
$name =~ s/^/ffi_platypus_record_meta__/;
$name;
});
$ffi->type('opaque' => 'ffi_type');
$ffi->custom_type('meta_t' => {
native_type => 'opaque',
perl_to_native => sub {
${ $_[0] };
},
});
$ffi->attach( _find_symbol => ['string'] => 'ffi_type');
$ffi->attach( new => ['ffi_type[]'] => 'meta_t', sub {
my($xsub, $class, $elements) = @_;
if(ref($elements) ne 'ARRAY')
{
require Carp;
Carp::croak("passed something other than a array ref to @{[ __PACKAGE__ ]}");
}
my @element_type_pointers;
foreach my $element_type (@$elements)
{
my $ptr = _find_symbol($element_type);
if($ptr)
{
push @element_type_pointers, $ptr;
}
else
{
require Carp;
Carp::croak("unknown type: $element_type");
}
}
push @element_type_pointers, undef;
my $ptr = $xsub->(\@element_type_pointers);
bless \$ptr, $class;
});
$ffi->attach( ffi_type => ['meta_t'] => 'ffi_type' );
$ffi->attach( size => ['meta_t'] => 'size_t' );
$ffi->attach( alignment => ['meta_t'] => 'ushort' );
$ffi->attach( element_pointers => ['meta_t'] => 'ffi_type[]' );
$ffi->attach( DESTROY => ['meta_t'] => 'void' );
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Record::Meta - FFI support for structured records data
=head1 VERSION
version 1.34
=head1 DESCRIPTION
This class is private to FFI::Platypus. See L<FFI::Platypus::Record> for
the public interface to Platypus records.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

164
database/perl/vendor/lib/FFI/Platypus/Record/TieArray.pm vendored Normal file
View File

@@ -0,0 +1,164 @@
package FFI::Platypus::Record::TieArray;
use strict;
use warnings;
use 5.008004;
use Carp qw( croak );
# ABSTRACT: Tied array interface for record array members
our $VERSION = '1.34'; # VERSION
sub TIEARRAY
{
my $class = shift;
bless [ @_ ], $class;
}
sub FETCH
{
my($self, $key) = @_;
my($obj, $member) = @$self;
$obj->$member($key);
}
sub STORE
{
my($self, $key, $value) = @_;
my($obj, $member) = @$self;
$obj->$member($key, $value);
}
sub FETCHSIZE
{
my($self) = @_;
$self->[2];
}
sub CLEAR
{
my($self) = @_;
my($obj, $member) = @$self;
$obj->$member([]);
}
sub EXTEND
{
my($self, $count) = @_;
croak "tried to extend a fixed length array" if $count > $self->[2];
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Record::TieArray - Tied array interface for record array members
=head1 VERSION
version 1.34
=head1 SYNOPSIS
package Foo;
use FFI::Platypus::Record;
use FFI::Platypus::Record::TieArray;
record_layout(qw(
int[20] _bar
));
sub bar
{
my($self, $arg) = @_;
$self->_bar($arg) if ref($arg) eq ' ARRAY';
tie my @list, 'FFI::Platypus::Record::TieArray',
$self, '_bar', 20;
}
package main;
my $foo = Foo->new;
my $bar5 = $foo->bar->[5]; # get the 5th element of the bar array
$foo->bar->[5] = 10; # set the 5th element of the bar array
@{ $foo->bar } = (); # set all elements in bar to 0
@{ $foo->bar } = (1..5); # set the first five elements of the bar array
=head1 DESCRIPTION
B<WARNING>: This module is considered EXPERIMENTAL. It may go away or
be changed in incompatible ways, possibly without notice, but not
without a good reason.
This class provides a tie interface for record array members.
In the future a short cut for using this with L<FFI::Platypus::Record>
directly may be provided.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The main Platypus documentation.
=item L<FFI::Platypus::Record>
Documentation on Platypus records.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

112
database/perl/vendor/lib/FFI/Platypus/ShareConfig.pm vendored Normal file
View File

@@ -0,0 +1,112 @@
package FFI::Platypus::ShareConfig;
use strict;
use warnings;
use 5.008004;
use File::Spec;
our $VERSION = '1.34'; # VERSION
sub dist_dir ($)
{
my($dist_name) = @_;
my @pm = split /-/, $dist_name;
$pm[-1] .= ".pm";
foreach my $inc (@INC)
{
if(-f File::Spec->catfile($inc, @pm))
{
my $share = File::Spec->catdir($inc, qw( auto share dist ), $dist_name );
if(-d $share)
{
return File::Spec->rel2abs($share);
}
last;
}
}
Carp::croak("unable to find dist share directory for $dist_name");
}
sub get
{
my(undef, $name) = @_;
my $config;
unless($config)
{
my $fn = File::Spec->catfile(dist_dir('FFI-Platypus'), 'config.pl');
$fn = File::Spec->rel2abs($fn) unless File::Spec->file_name_is_absolute($fn);
local $@;
unless($config = do $fn)
{
die "couldn't parse configuration $fn $@" if $@;
die "couldn't do $fn $!" if $!;
die "bad or missing config file $fn";
};
}
defined $name ? $config->{$name} : $config;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::ShareConfig
=head1 VERSION
version 1.34
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

1384
database/perl/vendor/lib/FFI/Platypus/Type.pm vendored Normal file
View File

File diff suppressed because it is too large Load Diff

152
database/perl/vendor/lib/FFI/Platypus/Type/PointerSizeBuffer.pm vendored Normal file
View File

@@ -0,0 +1,152 @@
package FFI::Platypus::Type::PointerSizeBuffer;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use FFI::Platypus::API qw(
arguments_set_pointer
arguments_set_uint32
arguments_set_uint64
);
use FFI::Platypus::Buffer qw( scalar_to_buffer );
use FFI::Platypus::Buffer qw( buffer_to_scalar );
# ABSTRACT: Convert string scalar to a buffer as a pointer / size_t combination
our $VERSION = '1.34'; # VERSION
my @stack;
*arguments_set_size_t
= FFI::Platypus->new( api => 1 )->sizeof('size_t') == 4
? \&arguments_set_uint32
: \&arguments_set_uint64;
sub perl_to_native
{
my($pointer, $size) = scalar_to_buffer($_[0]);
push @stack, [ $pointer, $size ];
arguments_set_pointer $_[1], $pointer;
arguments_set_size_t($_[1]+1, $size);
}
sub perl_to_native_post
{
my($pointer, $size) = @{ pop @stack };
$_[0] = buffer_to_scalar($pointer, $size);
}
sub ffi_custom_type_api_1
{
{
native_type => 'opaque',
perl_to_native => \&perl_to_native,
perl_to_native_post => \&perl_to_native_post,
argument_count => 2,
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Type::PointerSizeBuffer - Convert string scalar to a buffer as a pointer / size_t combination
=head1 VERSION
version 1.34
=head1 SYNOPSIS
In your C code:
void
function_with_buffer(void *pointer, size_t size)
{
...
}
In your Platypus::FFI code:
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->load_custom_type('::PointerSizeBuffer' => 'buffer');
$ffi->attach(function_with_buffer => ['buffer'] => 'void');
my $string = "content of buffer";
function_with_buffer($string);
=head1 DESCRIPTION
A common pattern in C code is to pass in a region of memory as a buffer,
consisting of a pointer and a size of the memory region. In Perl,
string scalars also point to a contiguous series of bytes that has a
size, so when interfacing with C libraries it is handy to be able to
pass in a string scalar as a pointer / size buffer pair.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
Main Platypus documentation.
=item L<FFI::Platypus::Type>
Platypus types documentation.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

262
database/perl/vendor/lib/FFI/Platypus/Type/StringArray.pm vendored Normal file
View File

@@ -0,0 +1,262 @@
package FFI::Platypus::Type::StringArray;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
# ABSTRACT: Platypus custom type for arrays of strings
our $VERSION = '1.34'; # VERSION
use constant _incantation =>
$^O eq 'MSWin32' && do { require Config; $Config::Config{archname} =~ /MSWin32-x64/ }
? 'Q'
: 'L!';
use constant _size_of_pointer => FFI::Platypus->new( api => 1 )->sizeof('opaque');
use constant _pointer_buffer => "P" . _size_of_pointer;
my @stack;
sub perl_to_native
{
# this is the variable length version
# and is actually simpler than the
# fixed length version
my $count = scalar @{ $_[0] };
my $pointers = pack(('P' x $count)._incantation, @{ $_[0] }, 0);
my $array_pointer = unpack _incantation, pack 'P', $pointers;
push @stack, [ \$_[0], \$pointers ];
$array_pointer;
}
sub perl_to_native_post
{
pop @stack;
();
}
sub native_to_perl
{
return unless defined $_[0];
my @list;
my $i=0;
while(1)
{
my $pointer_pointer = unpack(
_incantation,
unpack(
_pointer_buffer,
pack(
_incantation, $_[0]+_size_of_pointer*$i
)
)
);
last unless $pointer_pointer;
push @list, unpack('p', pack(_incantation, $pointer_pointer));
$i++;
}
\@list;
}
sub ffi_custom_type_api_1
{
# arg0 = class
# arg1 = FFI::Platypus instance
# arg2 = array size
# arg3 = default value
my(undef, undef, $count, $default) = @_;
my $config = {
native_type => 'opaque',
perl_to_native => \&perl_to_native,
perl_to_native_post => \&perl_to_native_post,
native_to_perl => \&native_to_perl,
};
if(defined $count)
{
my $end = $count-1;
$config->{perl_to_native} = sub {
my $incantation = '';
my @list = ((map {
defined $_
? do { $incantation .= 'P'; $_ }
: defined $default
? do { $incantation .= 'P'; $default }
: do { $incantation .= _incantation; 0 };
} @{ $_[0] }[0..$end]), 0);
$incantation .= _incantation;
my $pointers = pack $incantation, @list;
my $array_pointer = unpack _incantation, pack 'P', $pointers;
push @stack, [ \@list, $pointers ];
$array_pointer;
};
my $pointer_buffer = "P@{[ FFI::Platypus->new( api => 1 )->sizeof('opaque') * $count ]}";
my $incantation_count = _incantation.$count;
$config->{native_to_perl} = sub {
return unless defined $_[0];
my @pointer_pointer = unpack($incantation_count, unpack($pointer_buffer, pack(_incantation, $_[0])));
[map { $_ ? unpack('p', pack(_incantation, $_)) : $default } @pointer_pointer];
};
}
$config;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Type::StringArray - Platypus custom type for arrays of strings
=head1 VERSION
version 1.34
=head1 SYNOPSIS
In your C code:
void
takes_string_array(const char **array)
{
...
}
void
takes_fixed_string_array(const char *array[5])
{
...
}
In your L<Platypus::FFI> code:
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->load_custom_type('::StringArray' => 'string_array');
$ffi->load_custom_type('::StringArray' => 'string_5' => 5);
$ffi->attach(takes_string_array => ['string_array'] => 'void');
$ffi->attach(takes_fixed_string_array => ['string_5'] => 'void');
my @list = qw( foo bar baz );
takes_string_array(\@list);
takes_fixed_string_array([qw( s1 s2 s3 s4 s5 )]);
=head1 DESCRIPTION
B<NOTE>: The primary motivation for this custom type was originally to
fill the void left by the fact that L<FFI::Platypus> did not support arrays
of strings by itself. Since 0.62 this support has been added, and that is
probably what you want to use, but the semantics and feature set are
slightly different, so there are cases where you might want to use this
custom type.
This module provides a L<FFI::Platypus> custom type for arrays of
strings. The array is always NULL terminated. Return types are supported!
This custom type takes two optional arguments. The first is the size of
arrays and the second is a default value to fill in any values that
aren't provided when the function is called. If not default is provided
then C<NULL> will be passed in for those values.
=head1 SUPPORT
If something does not work the way you think it should, or if you have a
feature request, please open an issue on this project's GitHub Issue
tracker:
L<https://github.com/plicease/FFI-Platypus-Type-StringArray/issues>
=head1 CONTRIBUTING
If you have implemented a new feature or fixed a bug then you may make a
pull request on this project's GitHub repository:
L<https://github.com/plicease/FFI-Platypus-Type-StringArray/pulls>
This project's GitHub issue tracker listed above is not Write-Only. If
you want to contribute then feel free to browse through the existing
issues and see if there is something you feel you might be good at and
take a whack at the problem. I frequently open issues myself that I
hope will be accomplished by someone in the future but do not have time
to immediately implement myself.
Another good area to help out in is documentation. I try to make sure
that there is good document coverage, that is there should be
documentation describing all the public features and warnings about
common pitfalls, but an outsider's or alternate view point on such
things would be welcome; if you see something confusing or lacks
sufficient detail I encourage documentation only pull requests to
improve things.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
=item L<FFI::Platypus::Type::StringPointer>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

180
database/perl/vendor/lib/FFI/Platypus/Type/StringPointer.pm vendored Normal file
View File

@@ -0,0 +1,180 @@
package FFI::Platypus::Type::StringPointer;
use strict;
use warnings;
use 5.008004;
use FFI::Platypus;
use Scalar::Util qw( readonly );
# ABSTRACT: Convert a pointer to a string and back
our $VERSION = '1.34'; # VERSION
use constant _incantation =>
$^O eq 'MSWin32' && do { require Config; $Config::Config{archname} =~ /MSWin32-x64/ }
? 'Q'
: 'L!';
use constant _pointer_buffer => "P" . FFI::Platypus->new( api => 1 )->sizeof('opaque');
my @stack;
sub perl_to_native
{
if(defined $_[0])
{
my $packed = pack 'P', ${$_[0]};
my $pointer_pointer = pack 'P', $packed;
my $unpacked = unpack _incantation, $pointer_pointer;
push @stack, [ \$packed, \$pointer_pointer ];
return $unpacked;
}
else
{
push @stack, [];
return undef;
}
}
sub perl_to_native_post
{
my($packed) = @{ pop @stack };
return unless defined $packed;
unless(readonly(${$_[0]}))
{
${$_[0]} = unpack 'p', $$packed;
}
}
sub native_to_perl
{
return unless defined $_[0];
my $pointer_pointer = unpack(_incantation, unpack(_pointer_buffer, pack(_incantation, $_[0])));
$pointer_pointer ? \unpack('p', pack(_incantation, $pointer_pointer)) : \undef;
}
sub ffi_custom_type_api_1
{
return {
native_type => 'opaque',
perl_to_native => \&perl_to_native,
perl_to_native_post => \&perl_to_native_post,
native_to_perl => \&native_to_perl,
}
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::Type::StringPointer - Convert a pointer to a string and back
=head1 VERSION
version 1.34
=head1 SYNOPSIS
In your C code:
void
string_pointer_argument(const char **string)
{
...
}
const char **
string_pointer_return(void)
{
...
}
In your Platypus::FFI code:
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->load_custom_type('::StringPointer' => 'string_pointer');
$ffi->attach(string_pointer_argument => ['string_pointer'] => 'void');
$ffi->attach(string_pointer_return => [] => 'string_pointer');
my $string = "foo";
string_pointer_argument(\$string); # $string may be modified
$ref = string_pointer_return();
print $$ref; # print the string pointed to by $ref
=head1 DESCRIPTION
B<NOTE>: As of version 0.61, this custom type is now deprecated since
pointers to strings are supported in the L<FFI::Platypus> directly
without custom types.
This module provides a L<FFI::Platypus> custom type for pointers to
strings.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
Main Platypus documentation.
=item L<FFI::Platypus::Type>
Platypus types documentation.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

165
database/perl/vendor/lib/FFI/Platypus/TypeParser.pm vendored Normal file
View File

@@ -0,0 +1,165 @@
package FFI::Platypus::TypeParser;
use strict;
use warnings;
use 5.008004;
use List::Util 1.45 qw( uniqstr );
use Carp qw( croak );
# ABSTRACT: FFI Type Parser
our $VERSION = '1.34'; # VERSION
# The TypeParser and Type classes are used internally ONLY and
# are not to be exposed to the user. External users should
# not under any circumstances rely on the implementation of
# these classes.
sub new
{
my($class) = @_;
my $self = bless { types => {}, type_map => {} }, $class;
$self->build;
$self;
}
sub build {}
our %basic_type;
# this just checks if the underlying libffi/platypus implementation
# has the basic type. It is used mainly to verify that exotic types
# like longdouble and complex_float are available before the test
# suite tries to use them.
sub have_type
{
my(undef, $name) = @_;
!!$basic_type{$name};
}
sub create_type_custom
{
my($self, $name, @rest) = @_;
$name = 'opaque' unless defined $name;
my $type = $self->parse($name);
unless($type->is_customizable)
{
croak "$name is not a legal basis for a custom type"
}
$self->_create_type_custom($type, @rest);
}
# this is the type map provided by the language plugin, if any
# in addition to the basic types (which map to themselves).
sub type_map
{
my($self, $new) = @_;
if(defined $new)
{
$self->{type_map} = $new;
}
$self->{type_map};
}
# this stores the types that have been mentioned so far. It also
# usually includes aliases.
sub types
{
shift->{types};
}
{
my %store;
foreach my $name (keys %basic_type)
{
my $type_code = $basic_type{$name};
$store{basic}->{$name} = __PACKAGE__->create_type_basic($type_code);
$store{ptr}->{$name} = __PACKAGE__->create_type_pointer($type_code);
$store{rev}->{$type_code} = $name;
}
sub global_types
{
\%store;
}
}
# list all the types that this type parser knows about, including
# those provided by the language plugin (if any), those defined
# by the user, and the basic types that everyone gets.
sub list_types
{
my($self) = @_;
uniqstr( ( keys %{ $self->type_map } ), ( keys %{ $self->types } ) );
}
our @CARP_NOT = qw( FFI::Platypus );
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::TypeParser - FFI Type Parser
=head1 VERSION
version 1.34
=head1 DESCRIPTION
This class is private to FFI::Platypus. See L<FFI::Platypus> for
the public interface to Platypus types.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

275
database/perl/vendor/lib/FFI/Platypus/TypeParser/Version0.pm vendored Normal file
View File

@@ -0,0 +1,275 @@
package FFI::Platypus::TypeParser::Version0;
use strict;
use warnings;
use 5.008004;
use Carp qw( croak );
use base qw( FFI::Platypus::TypeParser );
# ABSTRACT: FFI Type Parser Version Zero
our $VERSION = '1.34'; # VERSION
our @CARP_NOT = qw( FFI::Platypus FFI::Platypus::TypeParser );
# The type parser is responsible for deciding if something is a legal
# alias name. Since this needs to be checked before the type is parsed
# it is separate from set_alias below.
sub check_alias
{
my($self, $alias) = @_;
croak "spaces not allowed in alias" if $alias =~ /\s/;
croak "allowed characters for alias: [A-Za-z0-9_]" if $alias !~ /^[A-Za-z0-9_]+$/;
croak "alias \"$alias\" conflicts with existing type"
if defined $self->type_map->{$alias}
|| $self->types->{$alias};
return 1;
}
sub set_alias
{
my($self, $alias, $type) = @_;
$self->types->{$alias} = $type;
}
# This method takes a string representation of the a type and
# returns the internal platypus type representation.
sub parse
{
my($self, $name) = @_;
return $self->types->{$name} if defined $self->types->{$name};
# Darmock and Legacy Code at Tanagra
unless($name =~ /-\>/ || $name =~ /^record\s*\([0-9A-Z:a-z_]+\)$/
|| $name =~ /^string(_rw|_ro|\s+rw|\s+ro|\s*\([0-9]+\))$/)
{
my $basic = $name;
my $extra = '';
if($basic =~ s/\s*((\*|\[|\<).*)$//)
{
$extra = " $1";
}
if(defined $self->type_map->{$basic})
{
my $new_name = $self->type_map->{$basic} . $extra;
if($new_name ne $name)
{
# hopefully no recursion here.
return $self->types->{$name} = $self->parse($new_name);
}
}
}
if($name =~ m/^ \( (.*) \) \s* -\> \s* (.*) \s* $/x)
{
my @argument_types = map { $self->parse($_) } map { my $t = $_; $t =~ s/^\s+//; $t =~ s/\s+$//; $t } split /,/, $1;
my $return_type = $self->parse($2);
return $self->types->{$name} = $self->create_type_closure($return_type, @argument_types);
}
if($name =~ /^ string \s* \( ([0-9]+) \) $/x)
{
return $self->types->{$name} = $self->create_type_record(
0,
$1, # size
);
}
if($name =~ /^ string ( _rw | _ro | \s+ro | \s+rw | ) $/x)
{
return $self->types->{$name} = $self->create_type_string(
defined $1 && $1 =~ /rw/ ? 1 : 0, # rw
);
}
if($name =~ /^ record \s* \( ([0-9]+) \) $/x)
{
return $self->types->{$name} = $self->create_type_record(
0,
$1, # size
);
}
if($name =~ /^ record \s* \( ([0-9:A-Za-z_]+) \) $/x)
{
my $size;
my $classname = $1;
unless($classname->can('ffi_record_size') || $classname->can('_ffi_record_size'))
{
my $pm = "$classname.pm";
$pm =~ s/\//::/g;
require $pm;
}
if($classname->can('ffi_record_size'))
{
$size = $classname->ffi_record_size;
}
elsif($classname->can('_ffi_record_size'))
{
$size = $classname->_ffi_record_size;
}
else
{
croak "$classname has not ffi_record_size or _ffi_record_size method";
}
return $self->global_types->{record}->{$classname} ||= $self->create_type_record(
0,
$size, # size
$classname, # record_class
);
}
# array types
if($name =~ /^([\S]+)\s+ \[ ([0-9]*) \] $/x)
{
my $size = $2 || '';
my $basic = $self->global_types->{basic}->{$1} || croak("unknown ffi/platypus type $name [$size]");
if($size)
{
return $self->types->{$name} = $self->create_type_array(
$basic->type_code,
$size,
);
}
else
{
return $self->global_types->{array}->{$name} ||= $self->create_type_array(
$basic->type_code,
0
);
}
}
# pointer types
if($name =~ s/\s+\*$//)
{
return $self->global_types->{ptr}->{$name} || croak("unknown ffi/platypus type $name *");
}
# basic types
return $self->global_types->{basic}->{$name} || croak("unknown ffi/platypus type $name");
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::TypeParser::Version0 - FFI Type Parser Version Zero
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 0 );
$ffi->type('record(Foo::Bar)' => 'foo_bar_t');
$ffi->type('opaque' => 'baz_t');
$ffi->type('opaque*' => 'baz_ptr');
=head1 DESCRIPTION
This documents the original L<FFI::Platypus> type parser. It was the default and only
type parser used by L<FFI::Platypus> starting with version C<0.02>. Starting with
version C<1.00> L<FFI::Platypus> comes with a new type parser with design fixes that
are not backward compatibility.
=head2 Interface differences
=over
=item Pass-by-value records are not allowed
Originally L<FFI::Platypus> only supported passing records as a pointer. The type
C<record(Foo::Bar)> actually passes a pointer to the record. In the version 1.00 parser
allows C<record(Foo::Bar)> which is pass-by-value (the contents of the record is copied
onto the stack) and C<record(Foo::Bar)*> which is pass-by-reference or pointer (a pointer
to the record is passed to the callee so that it can make modifications to the record).
TL;DR C<record(Foo::Bar)> in version 0 is equivalent to C<record(Foo::Bar)*> in the
version 1 API. There is no equivalent to C<record(Foo::Bar)*> in the version 0 API.
=item decorate aliases of basic types
This is not allowed in the version 0 API:
$ffi->type('opaque' => 'foo_t'); # ok!
$ffi->type('foo_t*' => 'foo_ptr'); # not ok! in version 0, ok! in version 1
Instead you need to use the basic type in the second type definition:
$ffi->type('opaque' => 'foo_t'); # ok!
$ffi->type('opaque*' => 'foo_ptr'); # ok!
=item object types are not allowed
$ffi->type('object(Foo::Bar)'); # not ok! in version 0, ok! in version 1
=back
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The core L<FFI::Platypus> documentation.
=item L<FFI::Platypus::TypeParser::Version1>
The API C<1.00> type parser.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

371
database/perl/vendor/lib/FFI/Platypus/TypeParser/Version1.pm vendored Normal file
View File

@@ -0,0 +1,371 @@
package FFI::Platypus::TypeParser::Version1;
use strict;
use warnings;
use 5.008004;
use Carp qw( croak );
use base qw( FFI::Platypus::TypeParser );
# ABSTRACT: FFI Type Parser Version One
our $VERSION = '1.34'; # VERSION
our @CARP_NOT = qw( FFI::Platypus FFI::Platypus::TypeParser );
my %reserved = map { $_ => 1 } qw(
string
object
type
role
union
class
struct
record
array
senum
enum
);
# The type parser is responsible for deciding if something is a legal
# alias name. Since this needs to be checked before the type is parsed
# it is separate from set_alias below.
sub check_alias
{
my($self, $alias) = @_;
croak "spaces not allowed in alias" if $alias =~ /\s/;
croak "allowed characters for alias: [A-Za-z0-9_]" if $alias !~ /^[A-Za-z0-9_]+$/;
croak "reserved world \"$alias\" cannot be used as an alias"
if $reserved{$alias};
croak "alias \"$alias\" conflicts with existing type"
if defined $self->type_map->{$alias}
|| $self->types->{$alias}
|| $self->global_types->{basic}->{$alias};
return 1;
}
sub set_alias
{
my($self, $alias, $type) = @_;
$self->types->{$alias} = $type;
}
use constant type_regex =>
qr/^ #
#
\s* # prefix white space
#
(?: #
#
\( ([^)]*) \) -> (.*) # closure $1 argument types, $2 return type
| #
(?: string | record ) \s* \( \s* ([0-9]+) \s* \) (?: \s* (\*) | ) # fixed record, fixed string $3, ponter $4
| #
record \s* \( ( \s* (?: [A-Za-z_] [A-Za-z_0-9]* :: )* [A-Za-z_] [A-Za-z_0-9]* ) \s* \) (?: \s* (\*) | ) # record class $5, pointer $6
| #
( (?: [A-Za-z_] [A-Za-z_0-9]* \s+ )* [A-Za-z_] [A-Za-z_0-9]* ) \s* # unit type name $7
#
(?: (\*) | \[ ([0-9]*) \] | ) # pointer $8, array $9
| #
object \s* \( \s* ( (?: [A-Za-z_] [A-Za-z_0-9]* :: )* [A-Za-z_] [A-Za-z_0-9]* ) # object class $10
(?: \s*,\s* ( (?: [A-Za-z_] [A-Za-z_0-9]* \s+ )* [A-Za-z_] [A-Za-z_0-9]* ) )? # type $11
\s* \) #
) #
#
\s* # trailing white space
#
$/x; #
sub parse
{
my($self, $name, $opt) = @_;
$opt ||= {};
return $self->types->{$name} if $self->types->{$name};
$name =~ type_regex or croak "bad type name: $name";
if(defined (my $at = $1)) # closure
{
my $rt = $2;
return $self->types->{$name} = $self->create_type_closure(
$self->parse($rt, $opt),
map { $self->parse($_, $opt) } map { my $t = $_; $t =~ s/^\s+//; $t =~ s/\s+$//; $t } split /,/, $at,
);
}
if(defined (my $size = $3)) # fixed record / fixed string
{
croak "fixed record / fixed string size must be larger than 0"
unless $size > 0;
if(my $pointer = $4)
{
return $self->types->{$name} = $self->create_type_record(
0,
$size,
);
}
elsif($opt->{member})
{
return $self->types->{"$name *"} = $self->create_type_record(
0,
$size,
);
}
else
{
croak "fixed string / classless record not allowed as value type";
}
}
if(defined (my $class = $5)) # class record
{
my $size_method = $class->can('ffi_record_size') || $class->can('_ffi_record_size') || croak "$class has no ffi_record_size or _ffi_record_size method";
if(my $pointer = $6)
{
return $self->types->{$name} = $self->create_type_record(
0,
$class->$size_method,
$class,
);
}
else
{
return $self->types->{$name} = $self->create_type_record(
1,
$class->$size_method,
$class,
$class->_ffi_meta->ffi_type,
);
}
}
if(defined (my $unit_name = $7)) # basic type
{
if($self->global_types->{basic}->{$unit_name})
{
if(my $pointer = $8)
{
croak "void pointer not allowed" if $unit_name eq 'void';
return $self->types->{$name} = $self->global_types->{ptr}->{$unit_name};
}
if(defined (my $size = $9)) # array
{
croak "void array not allowed" if $unit_name eq 'void';
if($size ne '')
{
croak "array size must be larger than 0" if $size < 1;
return $self->types->{$name} = $self->create_type_array(
$self->global_types->{basic}->{$unit_name}->type_code,
$size,
);
}
else
{
return $self->global_types->{array}->{$unit_name} ||= $self->create_type_array(
$self->global_types->{basic}->{$unit_name}->type_code,
0,
);
}
}
# basic type with no decorations
return $self->global_types->{basic}->{$unit_name};
}
if(my $map_name = $self->type_map->{$unit_name})
{
if(my $pointer = $8)
{
return $self->types->{$name} = $self->parse("$map_name *", $opt);
}
if(defined (my $size = $9))
{
if($size ne '')
{
croak "array size must be larger than 0" if $size < 1;
return $self->types->{$name} = $self->parse("$map_name [$size]", $opt);
}
else
{
return $self->types->{$name} = $self->parse("$map_name []", $opt);
}
}
return $self->types->{$name} = $self->parse("$map_name", $opt);
}
if(my $pointer = $8)
{
my $unit_type = $self->parse($unit_name, $opt);
if($unit_type->is_record_value)
{
my $meta = $unit_type->meta;
return $self->types->{$name} = $self->create_type_record(
0,
$meta->{size},
$meta->{class},
);
}
my $basic_name = $self->global_types->{rev}->{$unit_type->type_code};
if($basic_name)
{
return $self->types->{$name} = $self->parse("$basic_name *", $opt);
}
else
{
croak "cannot make a pointer to $unit_name";
}
}
if(defined (my $size = $9))
{
my $unit_type = $self->parse($unit_name, $opt);
my $basic_name = $self->global_types->{rev}->{$unit_type->type_code};
if($basic_name)
{
if($size ne '')
{
croak "array size must be larger than 0" if $size < 1;
return $self->types->{$name} = $self->parse("$basic_name [$size]", $opt);
}
else
{
return $self->types->{$name} = $self->parse("$basic_name []", $opt);
}
}
else
{
croak "cannot make an array of $unit_name";
}
}
if($name eq 'string ro')
{
return $self->global_types->{basic}->{string};
}
elsif($name eq 'string rw')
{
return $self->global_types->{v2}->{string_rw} ||= $self->create_type_string(1);
}
return $self->types->{$name} || croak "unknown type: $unit_name";
}
if(defined (my $class = $10)) # object type
{
my $basic_name = $11 || 'opaque';
my $basic_type = $self->parse($basic_name);
if($basic_type->is_object_ok)
{
return $self->types->{$name} = $self->create_type_object(
$basic_type->type_code,
$class,
);
}
else
{
croak "cannot make an object of $basic_name";
}
}
croak "internal error parsing: $name";
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Platypus::TypeParser::Version1 - FFI Type Parser Version One
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Platypus;
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->type('record(Foo::Bar)' => 'foo_bar_t');
$ffi->type('record(Foo::Bar)*' => 'foo_bar_ptr');
$ffi->type('opaque' => 'baz_t');
$ffi->type('bar_t*' => 'baz_ptr');
=head1 DESCRIPTION
This documents the second (version 1) type parser for L<FFI::Platypus>.
This type parser was included with L<FFI::Platypus> starting with version
C<0.91> in an experimental capability, and C<1.00> as a stable interface.
Starting with version C<1.00> the main L<FFI::Platypus> documentation
describes the version 1 API and you can refer to
L<FFI::Platypus::TypeParser::Version0> for details on the version0 API.
=head1 SEE ALSO
=over 4
=item L<FFI::Platypus>
The core L<FFI::Platypus> documentation.
=item L<FFI::Platypus::TypeParser::Version0>
The API C<0.02> type parser.
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

705
database/perl/vendor/lib/FFI/Probe.pm vendored Normal file
View File

@@ -0,0 +1,705 @@
package FFI::Probe;
use strict;
use warnings;
use 5.008004;
use File::Basename qw( dirname );
use Data::Dumper ();
use FFI::Probe::Runner;
use FFI::Build;
use FFI::Build::File::C;
use Capture::Tiny qw( capture_merged capture );
use FFI::Temp;
# ABSTRACT: System detection and probing for FFI extensions.
our $VERSION = '1.34'; # VERSION
sub new
{
my($class, %args) = @_;
$args{log} ||= "ffi-probe.log";
$args{data_filename} ||= "ffi-probe.pl";
unless(ref $args{log})
{
my $fn = $args{log};
my $fh;
open $fh, '>>', $fn;
$args{log} = $fh;
}
my $data;
if(-r $args{data_filename})
{
my $fn = $args{data_filename};
unless($data = do $fn)
{
die "couldn't parse configuration $fn $@" if $@;
die "couldn't do $fn $!" if $!;
die "bad or missing config file $fn";
}
}
$data ||= {};
my $self = bless {
headers => [],
log => $args{log},
data_filename => $args{data_filename},
data => $data,
dir => FFI::Temp->newdir( TEMPLATE => 'ffi-probe-XXXXXX' ),
counter => 0,
runner => $args{runner},
alien => $args{alien} || [],
cflags => $args{cflags},
libs => $args{libs},
}, $class;
$self;
}
sub _runner
{
my($self) = @_;
$self->{runner} ||= FFI::Probe::Runner->new;
}
sub check_header
{
my($self, $header) = @_;
return if defined $self->{data}->{header}->{$header};
my $code = '';
$code .= "#include <$_>\n" for @{ $self->{headers} }, $header;
my $build = FFI::Build->new("hcheck@{[ ++$self->{counter} ]}",
verbose => 2,
dir => $self->{dir},
alien => $self->{alien},
cflags => $self->{cflags},
libs => $self->{libs},
);
my $file = FFI::Build::File::C->new(
\$code,
dir => $self->{dir},
build => $build,
);
my($out, $o) = capture_merged {
eval { $file->build_item };
};
$self->log_code($code);
$self->log($out);
if($o)
{
$self->set('header', $header => 1);
push @{ $self->{headers} }, $header;
return 1;
}
else
{
$self->set('header', $header => 0);
return;
}
}
sub check_cpp
{
my($self, $code) = @_;
my $build = FFI::Build->new("hcheck@{[ ++$self->{counter} ]}",
verbose => 2,
dir => $self->{dir},
alien => $self->{alien},
cflags => $self->{cflags},
libs => $self->{libs},
);
my $file = FFI::Build::File::C->new(
\$code,
dir => $self->{dir},
build => $build,
);
my($out, $i) = capture_merged {
eval { $file->build_item_cpp };
};
$self->log_code($code);
$self->log($out);
if($i && -f $i->path)
{
return $i->slurp;
}
else
{
return;
}
}
sub check_eval
{
my($self, %args) = @_;
my $code = $args{_template} || $self->template;
my $headers = join "", map { "#include <$_>\n" } (@{ $self->{headers} }, @{ $args{headers} || [] });
my @decl = @{ $args{decl} || [] };
my @stmt = @{ $args{stmt} || [] };
my %eval = %{ $args{eval} || {} };
$code =~ s/##HEADERS##/$headers/;
$code =~ s/##DECL##/join "\n", @decl/e;
$code =~ s/##STMT##/join "\n", @stmt/e;
my $eval = '';
my $i=0;
my %map;
foreach my $key (sort keys %eval)
{
$i++;
$map{$key} = "eval$i";
my($format,$expression) = @{ $eval{$key} };
$eval .= " printf(\"eval$i=<<<$format>>>\\n\", $expression);\n";
}
$code =~ s/##EVAL##/$eval/;
my $build = FFI::Build->new("eval@{[ ++$self->{counter} ]}",
verbose => 2,
dir => $self->{dir},
alien => $self->{alien},
cflags => $self->{cflags},
libs => $self->{libs},
export => ['dlmain'],
);
$build->source(
FFI::Build::File::C->new(
\$code,
dir => $self->{dir},
build => $build,
),
);
my $lib = do {
my($out, $lib, $error) = capture_merged {
my $lib = eval {
$build->build;
};
($lib, $@);
};
$self->log_code($code);
$self->log("[build]");
$self->log($out);
if($error)
{
$self->log("exception: $error");
return;
}
elsif(!$lib)
{
$self->log("failed");
return;
}
$lib;
};
my $result = $self->_runner->run($lib->path);
$self->log("[stdout]");
$self->log($result->stdout);
$self->log("[stderr]");
$self->log($result->stderr);
$self->log("rv = @{[ $result->rv ]}");
$self->log("sig = @{[ $result->signal ]}") if $result->signal;
if($result->pass)
{
foreach my $key (sort keys %eval)
{
my $eval = $map{$key};
if($result->stdout =~ /$eval=<<<(.*?)>>>/)
{
my $value = $1;
my @key = split /\./, $key;
$self->set(@key, $value);
}
}
return 1;
}
else
{
return;
}
}
sub check
{
my($self, $name, $code) = @_;
if($self->check_eval(_template => $code))
{
$self->set('probe', $name, 1);
return 1;
}
else
{
$self->set('probe', $name, 0);
return;
}
}
sub check_type_int
{
my($self, $type) = @_;
$self->check_header('stddef.h');
my $ret = $self->check_eval(
decl => [
'#define signed(type) (((type)-1) < 0) ? "signed" : "unsigned"',
"struct align { char a; $type b; };",
],
eval => {
"type.$type.size" => [ '%d' => "(int)sizeof($type)" ],
"type.$type.sign" => [ '%s' => "signed($type)" ],
"type.$type.align" => [ '%d' => '(int)offsetof(struct align, b)' ],
},
);
return unless $ret;
my $size = $self->data->{type}->{$type}->{size};
my $sign = $self->data->{type}->{$type}->{sign};
sprintf("%sint%d", $sign eq 'signed' ? 's' : 'u', $size*8);
}
sub check_type_enum
{
my($self) = @_;
$self->check_header('stddef.h');
my $ret = $self->check_eval(
decl => [
'#define signed(type) (((type)-1) < 0) ? "signed" : "unsigned"',
"typedef enum { ONE, TWO } myenum;",
"struct align { char a; myenum b; };",
],
eval => {
"type.enum.size" => [ '%d' => '(int)sizeof(myenum)' ],
"type.enum.sign" => [ '%s' => 'signed(myenum)' ],
"type.enum.align" => [ '%d' => '(int)offsetof(struct align, b)' ],
},
);
return unless $ret;
my $size = $self->data->{type}->{enum}->{size};
my $sign = $self->data->{type}->{enum}->{sign};
sprintf("%sint%d", $sign eq 'signed' ? 's' : 'u', $size*8);
}
sub check_type_signed_enum
{
my($self) = @_;
$self->check_header('stddef.h');
my $ret = $self->check_eval(
decl => [
'#define signed(type) (((type)-1) < 0) ? "signed" : "unsigned"',
"typedef enum { NEG = -1, ONE = 1, TWO = 2 } myenum;",
"struct align { char a; myenum b; };",
],
eval => {
"type.senum.size" => [ '%d' => '(int)sizeof(myenum)' ],
"type.senum.sign" => [ '%s' => 'signed(myenum)' ],
"type.senum.align" => [ '%d' => '(int)offsetof(struct align, b)' ],
},
);
return unless $ret;
my $size = $self->data->{type}->{senum}->{size};
my $sign = $self->data->{type}->{senum}->{sign};
sprintf("%sint%d", $sign eq 'signed' ? 's' : 'u', $size*8);
}
sub check_type_float
{
my($self, $type) = @_;
$self->check_header('stddef.h');
my $ret = $self->check_eval(
decl => [
"struct align { char a; $type b; };",
],
eval => {
"type.$type.size" => [ '%d' => "(int)sizeof($type)" ],
"type.$type.align" => [ '%d' => '(int)offsetof(struct align, b)' ],
},
);
return unless $ret;
my $size = $self->data->{type}->{$type}->{size};
my $complex = !!$type =~ /complex/;
if($complex) {
$size /= 2;
}
my $t;
if($size == 4)
{ $t = 'float' }
elsif($size == 8)
{ $t = 'double' }
elsif($size > 9)
{ $t = 'longdouble' }
$t = "complex_$t" if $complex;
$t;
}
sub check_type_pointer
{
my($self) = @_;
$self->check_header('stddef.h');
my $ret = $self->check_eval(
decl => [
"struct align { char a; void* b; };",
],
eval => {
"type.pointer.size" => [ '%d' => '(int)sizeof(void *)' ],
"type.pointer.align" => [ '%d' => '(int)offsetof(struct align, b)' ],
},
);
return unless $ret;
'pointer';
}
sub _set
{
my($data, $value, @key) = @_;
my $key = shift @key;
if(@key > 0)
{
_set($data->{$key} ||= {}, $value, @key);
}
else
{
$data->{$key} = $value;
}
}
sub set
{
my $self = shift;
my $value = pop;
my @key = @_;
my $print_value = $value;
if(ref $print_value)
{
my $d = Data::Dumper->new([$value], [qw($value)]);
$d->Indent(0);
$d->Terse(1);
$print_value = $d->Dump;
}
my $key = join ".", map { /\./ ? "\"$_\"" : $_ } @key;
print "PR $key=$print_value\n";
$self->log("$key=$print_value");
_set($self->{data}, $value, @key);
}
sub save
{
my($self) = @_;
my $dir = dirname($self->{data_filename});
my $dd = Data::Dumper->new([$self->{data}],['x'])
->Indent(1)
->Terse(0)
->Purity(1)
->Sortkeys(1)
->Dump;
mkpath( $dir, 0, oct(755) ) unless -d $dir;
my $fh;
open($fh, '>', $self->{data_filename}) || die "error writing @{[ $self->{data_filename} ]}";
print $fh 'do { my ';
print $fh $dd;
print $fh '$x;}';
close $fh;
}
sub data { shift->{data} }
sub log
{
my($self, $string) = @_;
my $fh = $self->{log};
chomp $string;
print $fh $string, "\n";
}
sub log_code
{
my($self, $code) = @_;
my @code = split /\n/, $code;
chomp for @code;
$self->log("code: $_") for @code;
}
sub DESTROY
{
my($self) = @_;
$self->save;
my $fh = $self->{log};
return unless defined $fh;
close $fh;
}
my $template;
sub template
{
unless(defined $template)
{
local $/;
$template = <DATA>;
}
$template;
}
1;
=pod
=encoding UTF-8
=head1 NAME
FFI::Probe - System detection and probing for FFI extensions.
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Probe;
my $probe = FFI::Probe->new;
$probe->check_header('foo.h');
...
=head1 DESCRIPTION
This class provides an interface for probing for system
capabilities. It is used internally as part of the
L<FFI::Platypus> build process, but it may also be useful
for extensions that use Platypus as well.
=head1 CONSTRUCTOR
=head2 new
my $probe = FFI::Probe->new(%args);
Creates a new instance.
=over 4
=item log
Path to a log or file handle to write to.
=item data_filename
Path to a file which will be used to store/cache results.
=back
=head1 METHODS
=head2 check_header
my $bool = $probe->check_header($header);
Checks that the given C header file is available.
Stores the result, and returns a true/false value.
=head2 check_cpp
=head2 check_eval
my $bool = $probe>check_eval(%args);
=over 4
=item headers
Any additional headers.
=item decl
Any C declarations that need to be made before the C<dlmain> function.
=item stmt
Any C statements that should be made before the evaluation.
=item eval
Any evaluations that should be returned.
=back
=head2 check
=head2 check_type_int
my $type = $probe->check_type_int($type);
=head2 check_type_enum
my $type = $probe->check_type_enum;
=head2 check_type_enum
my $type = $probe->check_type_enum;
=head2 check_type_float
my $type = $probe->check_type_float($type);
=head2 check_type_pointer
my $type = $probe->check_type_pointer;
=head2 set
$probe->set(@key, $value);
Used internally to store a value.
=head2 save
$probe->save;
Saves the values already detected.
=head2 data
my $data = $probe->data;
Returns a hashref of the data already detected.
=head2 log
$probe->log($string);
Sends the given string to the log.
=head2 log_code
$prbe->log_code($string);
Sends the given multi-line code block to the log.
=head2 template
my $template = $probe->template;
Returns the C code template used for C<check_eval> and other
C<check_> methods.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__DATA__
#include <stdio.h>
##HEADERS##
##DECL##
int
dlmain(int argc, char *argv[])
{
##STMT##
##EVAL##
return 0;
}

194
database/perl/vendor/lib/FFI/Probe/Runner.pm vendored Normal file
View File

@@ -0,0 +1,194 @@
package FFI::Probe::Runner;
use strict;
use warnings;
use 5.008004;
use Capture::Tiny qw( capture );
use FFI::Probe::Runner::Result;
# ABSTRACT: Probe runner for FFI
our $VERSION = '1.34'; # VERSION
sub new
{
my($class, %args) = @_;
$args{exe} ||= do {
require FFI::Platypus::ShareConfig;
require File::Spec;
require Config;
File::Spec->catfile(FFI::Platypus::ShareConfig::dist_dir('FFI::Platypus'), 'probe', 'bin', "dlrun$Config::Config{exe_ext}");
};
defined $args{flags} or $args{flags} = '-';
die "probe runner executable not found at: $args{exe}" unless -f $args{exe};
my $self = bless {
exe => $args{exe},
flags => $args{flags},
}, $class;
$self;
}
sub exe { shift->{exe} }
sub flags { shift->{flags} }
sub verify
{
my($self) = @_;
my $exe = $self->exe;
my($out, $err, $ret) = capture {
$! = 0;
system $exe, 'verify', 'self';
};
return 1 if $ret == 0 && $out =~ /dlrun verify self ok/;
print $out;
print STDERR $err;
die "verify failed";
}
sub run
{
my($self, $dll, @args) = @_;
my $exe = $self->exe;
my $flags = $self->flags;
my($out, $err, $ret) = capture {
my @cmd = ($exe, $dll, $flags, @args);
$! = 0;
system @cmd;
$?;
};
FFI::Probe::Runner::Result->new(
stdout => $out,
stderr => $err,
rv => $ret >> 8,
signal => $ret & 127,
);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Probe::Runner - Probe runner for FFI
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Probe::Runner;
my $runner = FFI::Probe::Runner->new;
$runner->run('foo.so');
=head1 DESCRIPTION
This class executes code in a dynamic library for probing and detecting platform
properties.
=head1 CONSTRUCTOR
=head2 new
my $runner = FFI::Probe::Runner->new(%args);
Creates a new instance.
=over 4
=item exe
The path to the dlrun wrapper. The default is usually correct.
=item flags
The flags to pass into C<dlopen>. The default is C<RTLD_LAZY> on Unix
and C<0> on windows..
=back
=head1 METHODS
=head2 exe
my $exe = $runner->exe;
The path to the dlrun wrapper.
=head2 flags
my $flags = $runner->flags;
The flags to pass into C<dlopen>.
=head2 verify
$runner->verify;
Verifies the dlrun wrapper is working. Throws an exception in the event of failure.
=head2 run
$runner->run($dll, @args);
Runs the C<dlmain> function in the given dynamic library, passing in the
given arguments. Returns a L<FFI::Probe::Runner::Result> object which
contains the results.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

528
database/perl/vendor/lib/FFI/Probe/Runner/Builder.pm vendored Normal file
View File

@@ -0,0 +1,528 @@
package FFI::Probe::Runner::Builder;
use strict;
use warnings;
use 5.008004;
use Config;
use Capture::Tiny qw( capture_merged );
use Text::ParseWords ();
use FFI::Build::Platform;
# ABSTRACT: Probe runner builder for FFI
our $VERSION = '1.34'; # VERSION
sub new
{
my($class, %args) = @_;
$args{dir} ||= 'blib/lib/auto/share/dist/FFI-Platypus/probe';
my $platform = FFI::Build::Platform->new;
my $self = bless {
dir => $args{dir},
platform => $platform,
# we don't use the platform ccflags, etc because they are geared
# for building dynamic libs not exes
cc => [$platform->shellwords($Config{cc})],
ld => [$platform->shellwords($Config{ld})],
ccflags => [$platform->shellwords($Config{ccflags})],
optimize => [$platform->shellwords($Config{optimize})],
ldflags => [$platform->shellwords($Config{ldflags})],
libs =>
$^O eq 'MSWin32'
? [[]]
: [['-ldl'], [], map { [$_] } grep !/^-ldl/, $platform->shellwords($Config{perllibs})],
}, $class;
$self;
}
sub dir
{
my($self, @subdirs) = @_;
my $dir = $self->{dir};
if(@subdirs)
{
require File::Spec;
$dir = File::Spec->catdir($dir, @subdirs);
}
unless(-d $dir)
{
require File::Path;
File::Path::mkpath($dir, 0, oct(755));
}
$dir;
}
sub cc { shift->{cc} }
sub ccflags { shift->{ccflags} }
sub optimize { shift->{optimize} }
sub ld { shift->{ld} }
sub ldflags { shift->{ldflags} }
sub libs { shift->{libs} }
sub file
{
my($self, @sub) = @_;
@sub >= 1 or die 'usage: $builder->file([@subdirs], $filename)';
my $filename = pop @sub;
require File::Spec;
File::Spec->catfile($self->dir(@sub), $filename);
}
my $source;
sub exe
{
my($self) = @_;
my $xfn = $self->file('bin', "dlrun$Config{exe_ext}");
}
sub source
{
unless($source)
{
local $/;
$source = <DATA>;
}
$source;
}
our $VERBOSE = !!$ENV{V};
sub extract
{
my($self) = @_;
# the source src/dlrun.c
{
print "XX src/dlrun.c\n" unless $VERBOSE;
my $fh;
my $fn = $self->file('src', 'dlrun.c');
my $source = $self->source;
open $fh, '>', $fn or die "unable to write $fn $!";
print $fh $source;
close $fh;
}
# the bin directory bin
{
print "XX bin/\n" unless $VERBOSE;
$self->dir('bin');
}
}
sub run
{
my($self, $type, @cmd) = @_;
@cmd = map { ref $_ ? @$_ : $_ } @cmd;
my($out, $ret) = capture_merged {
$self->{platform}->run(@cmd);
};
if($ret)
{
print STDERR $out;
die "$type failed";
}
print $out if $VERBOSE;
$out;
}
sub run_list
{
my($self, $type, @commands) = @_;
my $log = '';
foreach my $cmd (@commands)
{
my($out, $ret) = capture_merged {
$self->{platform}->run(@$cmd);
};
if($VERBOSE)
{
print $out;
}
else
{
$log .= $out;
}
return if !$ret;
}
print $log;
die "$type failed";
}
sub build
{
my($self) = @_;
$self->extract;
# this should really be done in `new` but the build
# scripts for FFI-Platypus edit the ldfalgs from there
# so. Also this may actually belong in FFI::Build::Platform
# which would resolve the problem.
if($^O eq 'MSWin32' && $Config{ccname} eq 'cl')
{
$self->{ldflags} = [
grep !/^-nodefaultlib$/i,
@{ $self->{ldflags} }
];
}
my $cfn = $self->file('src', 'dlrun.c');
my $ofn = $self->file('src', "dlrun$Config{obj_ext}");
my $xfn = $self->exe;
# compile
print "CC src/dlrun.c\n" unless $VERBOSE;
$self->run(
compile =>
$self->cc,
$self->ccflags,
$self->optimize,
'-c',
$self->{platform}->flag_object_output($ofn),
$cfn,
);
# link
print "LD src/dlrun$Config{obj_ext}\n" unless $VERBOSE;
$self->run_list(link =>
map { [
$self->ld,
$self->ldflags,
$self->{platform}->flag_exe_output($xfn),
$ofn,
@$_
] } @{ $self->libs },
);
## FIXME
if($^O eq 'MSWin32' && $Config{ccname} eq 'cl')
{
if(-f 'dlrun.exe' && ! -f $xfn)
{
rename 'dlrun.exe', $xfn;
}
}
# verify
print "VV bin/dlrun$Config{exe_ext}\n" unless $VERBOSE;
my $out = $self->run(verify => $xfn, 'verify', 'self');
if($out !~ /dlrun verify self ok/)
{
print $out;
die "verify failed string match";
}
# remove object
print "UN src/dlrun$Config{obj_ext}\n" unless $VERBOSE;
unlink $ofn;
$xfn;
}
1;
=pod
=encoding UTF-8
=head1 NAME
FFI::Probe::Runner::Builder - Probe runner builder for FFI
=head1 VERSION
version 1.34
=head1 SYNOPSIS
use FFI::Probe::Runner::Builder;
my $builder = FFI::Probe::Runner::Builder->new
dir => "/foo/bar",
);
my $exe = $builder->build;
=head1 DESCRIPTION
This is a builder class for the FFI probe runner. It is mostly only of
interest if you are hacking on L<FFI::Platypus> itself.
The interface may and will change over time without notice. Use in
external dependencies at your own peril.
=head1 CONSTRUCTORS
=head2 new
my $builder = FFI::Probe::Runner::Builder->new(%args);
Create a new instance.
=over 4
=item dir
The root directory for where to place the probe runner files.
Will be created if it doesn't already exist. The default
makes sense for when L<FFI::Platypus> is being built.
=back
=head1 METHODS
=head2 dir
my $dir = $builder->dir(@subdirs);
Returns a subdirectory from the builder root. Directory
will be created if it doesn't already exist.
=head2 cc
my @cc = @{ $builder->cc };
The C compiler to use. Returned as an array reference so that it may be modified.
=head2 ccflags
my @ccflags = @{ $builder->ccflags };
The C compiler flags to use. Returned as an array reference so that it may be modified.
=head2 optimize
The C optimize flags to use. Returned as an array reference so that it may be modified.
=head2 ld
my @ld = @{ $builder->ld };
The linker to use. Returned as an array reference so that it may be modified.
=head2 ldflags
my @ldflags = @{ $builder->ldflags };
The linker flags to use. Returned as an array reference so that it may be modified.
=head2 libs
my @libs = @{ $builder->libs };
The library flags to use. Returned as an array reference so that it may be modified.
=head2 file
my $file = $builder->file(@subdirs, $filename);
Returns a file in a subdirectory from the builder root.
Directory will be created if it doesn't already exist.
File will not be created.
=head2 exe
my $exe = $builder->exe;
The name of the executable, once it is built.
=head2 source
my $source = $builder->source;
The C source for the probe runner.
=head2 extract
$builder->extract;
Extract the source for the probe runner.
=head2 run
$builder->run($type, @command);
Runs the given command. Dies if the command fails.
=head2 run_list
$builder->run($type, \@command, \@command, ...);
Runs the given commands in order until one succeeds.
Dies if they all fail.
=head2 build
my $exe = $builder->build;
Builds the probe runner. Returns the path to the executable.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__DATA__
#if defined __CYGWIN__
#include <dlfcn.h>
#elif defined _WIN32
#include <windows.h>
#else
#include <dlfcn.h>
#endif
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#if defined __CYGWIN__
typedef void * dlib;
#elif defined _WIN32
#define RTLD_LAZY 0
typedef HMODULE dlib;
dlib
dlopen(const char *filename, int flags)
{
(void)flags;
return LoadLibrary(filename);
}
void *
dlsym(dlib handle, const char *symbol_name)
{
return GetProcAddress(handle, symbol_name);
}
int
dlclose(dlib handle)
{
FreeLibrary(handle);
return 0;
}
const char *
dlerror()
{
return "an error";
}
#else
typedef void * dlib;
#endif
int
main(int argc, char **argv)
{
char *filename;
int flags;
int (*dlmain)(int, char **);
char **dlargv;
dlib handle;
int n;
int ret;
if(argc < 3)
{
fprintf(stderr, "usage: %s dlfilename dlflags [ ... ]\n", argv[0]);
return 1;
}
if(!strcmp(argv[1], "verify") && !strcmp(argv[2], "self"))
{
printf("dlrun verify self ok\n");
return 0;
}
#if defined WIN32
SetErrorMode(SetErrorMode(0) | SEM_NOGPFAULTERRORBOX);
#endif
dlargv = malloc(sizeof(char*)*(argc-2));
dlargv[0] = argv[0];
filename = argv[1];
flags = !strcmp(argv[2], "-") ? RTLD_LAZY : atoi(argv[2]);
for(n=3; n<argc; n++)
dlargv[n-2] = argv[n];
handle = dlopen(filename, flags);
if(handle == NULL)
{
fprintf(stderr, "error loading %s (%d|%s): %s", filename, flags, argv[2], dlerror());
return 1;
}
dlmain = dlsym(handle, "dlmain");
if(dlmain == NULL)
{
fprintf(stderr, "no dlmain symbol");
return 1;
}
ret = dlmain(argc-2, dlargv);
dlclose(handle);
return ret;
}

124
database/perl/vendor/lib/FFI/Probe/Runner/Result.pm vendored Normal file
View File

@@ -0,0 +1,124 @@
package FFI::Probe::Runner::Result;
use strict;
use warnings;
use 5.008004;
# ABSTRACT: The results from a probe run.
our $VERSION = '1.34'; # VERSION
sub new
{
my($class, %args) = @_;
my $self = bless \%args, $class;
$self;
}
sub stdout { shift->{stdout} }
sub stderr { shift->{stderr} }
sub rv { shift->{rv} }
sub signal { shift->{signal} }
sub pass
{
my($self) = @_;
$self->rv == 0 && $self->signal == 0;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Probe::Runner::Result - The results from a probe run.
=head1 VERSION
version 1.34
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 CONSTRUCTOR
=head2 new
my $result = FFI::Probe::Runner::Result->new(%args);
Creates a new instance of the class.
=head1 METHODS
=head2 stdout
my $stdout = $result->stdout;
=head2 stderr
my $stderr = $result->stderr;
=head2 rv
my $rv = $result->rv;
=head2 signal
my $signal = $result->signal;
=head2 pass
my $pass = $result->pass;
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

258
database/perl/vendor/lib/FFI/Raw.pm vendored Normal file
View File

@@ -0,0 +1,258 @@
package FFI::Raw;
$FFI::Raw::VERSION = '0.32';
use strict;
use warnings;
require XSLoader;
XSLoader::load('FFI::Raw', $FFI::Raw::VERSION);
require FFI::Raw::Ptr;
use overload
'&{}' => \&coderef,
'bool' => \&_bool;
sub _bool {
my $ffi = shift;
return $ffi;
}
=head1 NAME
FFI::Raw - Perl bindings to the portable FFI library (libffi)
=head1 VERSION
version 0.32
=head1 SYNOPSIS
use FFI::Raw;
my $cos = FFI::Raw -> new(
'libm.so', 'cos',
FFI::Raw::double, # return value
FFI::Raw::double # arg #1
);
say $cos -> call(2.0);
=head1 DESCRIPTION
B<FFI::Raw> provides a low-level foreign function interface (FFI) for Perl based
on L<libffi|http://sourceware.org/libffi/>. In essence, it can access and call
functions exported by shared libraries without the need to write C/XS code.
Dynamic symbols can be automatically resolved at runtime so that the only
information needed to use B<FFI::Raw> is the name (or path) of the target
library, the name of the function to call and its signature (though it is also
possible to pass a function pointer obtained, for example, using L<DynaLoader>).
Note that this module has nothing to do with L<FFI>.
=head1 METHODS
=head2 new( $library, $function, $return_type [, $arg_type ...] )
Create a new C<FFI::Raw> object. It loads C<$library>, finds the function
C<$function> with return type C<$return_type> and creates a calling interface.
If C<$library> is C<undef> then the function is searched in the main program.
This method also takes a variable number of types, representing the arguments
of the wanted function.
=head2 new_from_ptr( $function_ptr, $return_type [, $arg_type ...] )
Create a new C<FFI::Raw> object from the C<$function_ptr> function pointer.
This method also takes a variable number of types, representing the arguments
of the wanted function.
=head2 call( [$arg ...] )
Execute the C<FFI::Raw> function. This methoed also takes a variable number of
arguments, which are passed to the called function. The argument types must
match the types passed to C<new> (or C<new_from_ptr>).
The C<FFI::Raw> object can be used as a CODE reference as well. Dereferencing
the object will work just like call():
$cos -> call(2.0); # normal call() call
$cos -> (2.0); # dereference as CODE ref
This works because FFI::Raw overloads the C<&{}> operator.
=head2 coderef( )
Return a code reference of a given C<FFI::Raw>.
=cut
sub coderef {
my $ffi = shift;
return sub { $ffi -> call(@_) };
}
=head1 SUBROUTINES
=head2 memptr( $length )
Create a L<FFI::Raw::MemPtr>. This is a shortcut for C<FFI::Raw::MemPtr-E<gt>new(...)>.
=cut
sub memptr { FFI::Raw::MemPtr -> new(@_) }
=head2 callback( $coderef, $ret_type [, $arg_type ...] )
Create a L<FFI::Raw::Callback>. This is a shortcut for C<FFI::Raw::Callback-E<gt>new(...)>.
=cut
sub callback { FFI::Raw::Callback -> new(@_) }
=head1 TYPES
=head2 FFI::Raw::void
Return a C<FFI::Raw> void type.
=cut
sub void () { ord 'v' }
=head2 FFI::Raw::int
Return a C<FFI::Raw> integer type.
=cut
sub int () { ord 'i' }
=head2 FFI::Raw::uint
Return a C<FFI::Raw> unsigned integer type.
=cut
sub uint () { ord 'I' }
=head2 FFI::Raw::short
Return a C<FFI::Raw> short integer type.
=cut
sub short () { ord 'z' }
=head2 FFI::Raw::ushort
Return a C<FFI::Raw> unsigned short integer type.
=cut
sub ushort () { ord 'Z' }
=head2 FFI::Raw::long
Return a C<FFI::Raw> long integer type.
=cut
sub long () { ord 'l' }
=head2 FFI::Raw::ulong
Return a C<FFI::Raw> unsigned long integer type.
=cut
sub ulong () { ord 'L' }
=head2 FFI::Raw::int64
Return a C<FFI::Raw> 64 bit integer type. This requires L<Math::Int64> to work.
=cut
sub int64 () { ord 'x' }
=head2 FFI::Raw::uint64
Return a C<FFI::Raw> unsigned 64 bit integer type. This requires L<Math::Int64>
to work.
=cut
sub uint64 () { ord 'X' }
=head2 FFI::Raw::char
Return a C<FFI::Raw> char type.
=cut
sub char () { ord 'c' }
=head2 FFI::Raw::uchar
Return a C<FFI::Raw> unsigned char type.
=cut
sub uchar () { ord 'C' }
=head2 FFI::Raw::float
Return a C<FFI::Raw> float type.
=cut
sub float () { ord 'f' }
=head2 FFI::Raw::double
Return a C<FFI::Raw> double type.
=cut
sub double () { ord 'd' }
=head2 FFI::Raw::str
Return a C<FFI::Raw> string type.
=cut
sub str () { ord 's' }
=head2 FFI::Raw::ptr
Return a C<FFI::Raw> pointer type.
=cut
sub ptr () { ord 'p' }
=head1 AUTHOR
Alessandro Ghedini <alexbio@cpan.org>
=head1 SEE ALSO
L<FFI>, L<Ctypes|http://gitorious.org/perl-ctypes>
=head1 LICENSE AND COPYRIGHT
Copyright 2012 Alessandro Ghedini.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1; # End of FFI::Raw

50
database/perl/vendor/lib/FFI/Raw/Callback.pm vendored Normal file
View File

@@ -0,0 +1,50 @@
package FFI::Raw::Callback;
$FFI::Raw::Callback::VERSION = '0.32';
use strict;
use warnings;
=head1 NAME
FFI::Raw::Callback - FFI::Raw function pointer type
=head1 VERSION
version 0.32
=head1 DESCRIPTION
A B<FFI::Raw::Callback> represents a function pointer to a Perl routine. It can
be passed to functions taking a C<FFI::Raw::ptr> type.
=head1 METHODS
=head2 new( $coderef, $ret_type [, $arg_type ...] )
Create a C<FFI::Raw::Callback> using the code reference C<$coderef> as body. The
signature (return and arguments types) must also be passed.
=head1 CAVEATS
For callbacks with a C<FFI::Raw::str> return type, the string value will be copied
to a private field on the callback object. The memory for this value will be
freed the next time the callback is called, or when the callback itself is freed.
For more exact control over when the return value is freed, you can instead
use C<FFI::Raw::ptr> type and return a L<FFI::Raw::MemPtr> object.
=head1 AUTHOR
Alessandro Ghedini <alexbio@cpan.org>
=head1 LICENSE AND COPYRIGHT
Copyright 2013 Alessandro Ghedini.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1; # End of FFI::Raw::Callback

91
database/perl/vendor/lib/FFI/Raw/MemPtr.pm vendored Normal file
View File

@@ -0,0 +1,91 @@
package FFI::Raw::MemPtr;
$FFI::Raw::MemPtr::VERSION = '0.32';
use strict;
use warnings;
=head1 NAME
FFI::Raw::MemPtr - FFI::Raw memory pointer type
=head1 VERSION
version 0.32
=head1 DESCRIPTION
A B<FFI::Raw::MemPtr> represents a memory pointer which can be passed to
functions taking a C<FFI::Raw::ptr> argument.
The allocated memory is automatically deallocated once the object is not in use
anymore.
=head1 METHODS
=head2 new( $length )
Allocate a new C<FFI::Raw::MemPtr> of size C<$length> bytes.
=head2 new_from_buf( $buffer, $length )
Allocate a new C<FFI::Raw::MemPtr> of size C<$length> bytes and copy C<$buffer>
into it. This can be used, for example, to pass a pointer to a function that
takes a C struct pointer, by using C<pack()> or the L<Convert::Binary::C> module
to create the actual struct content.
For example, consider the following C code
struct some_struct {
int some_int;
char some_str[];
};
extern void take_one_struct(struct some_struct *arg) {
if (arg -> some_int == 42)
puts(arg -> some_str);
}
It can be called using FFI::Raw as follows:
use FFI::Raw;
my $packed = pack('ix![p]p', 42, 'hello');
my $arg = FFI::Raw::MemPtr -> new_from_buf($packed, length $packed);
my $take_one_struct = FFI::Raw -> new(
$shared, 'take_one_struct',
FFI::Raw::void, FFI::Raw::ptr
);
$take_one_struct -> ($arg);
Which would print C<hello>.
=head2 new_from_ptr( $ptr )
Allocate a new C<FFI::Raw::MemPtr> pointing to the C<$ptr>, which can be either
a C<FFI::Raw::MemPtr> or a pointer returned by another function.
This is the C<FFI::Raw> equivalent of a pointer to a pointer.
=head2 tostr( [$length] )
Convert a C<FFI::Raw::MemPtr> to a Perl string. If C<$length> is not provided,
the length of the string will be computed using C<strlen()>.
=head1 AUTHOR
Alessandro Ghedini <alexbio@cpan.org>
=head1 LICENSE AND COPYRIGHT
Copyright 2013 Alessandro Ghedini.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1; # End of FFI::Raw::MemPtr

98
database/perl/vendor/lib/FFI/Raw/Ptr.pm vendored Normal file
View File

@@ -0,0 +1,98 @@
package FFI::Raw::Ptr;
$FFI::Raw::Ptr::VERSION = '0.32';
use strict;
use warnings;
=head1 NAME
FFI::Raw::Ptr - Base FFI::Raw pointer type
=head1 VERSION
version 0.32
=head1 SYNOPSIS
package Foo;
use FFI::Raw;
use base qw(FFI::Raw::Ptr);
*_foo_new = FFI::Raw -> new(
$shared, 'foo_new',
FFI::Raw::ptr
) -> coderef;
sub new {
bless shift -> SUPER::new(_foo_new());
}
*get_bar = FFI::Raw -> new(
$shared, 'foo_get_bar',
FFI::Raw::int,
FFI::Raw::ptr
) -> coderef;
*set_bar = FFI::Raw -> new(
$shared, 'foo_set_bar',
FFI::Raw::void,
FFI::Raw::ptr,
FFI::Raw::int
) -> coderef;
*DESTROY = FFI::Raw -> new(
$shared, 'foo_free',
FFI::Raw::void,
FFI::Raw::ptr
) -> coderef;
1;
package main;
my $foo = Foo -> new;
$foo -> set_bar(42);
=head1 DESCRIPTION
A B<FFI::Raw::Ptr> represents a pointer to memory which can be passed to
functions taking a C<FFI::Raw::ptr> argument.
Note that differently from L<FFI::Raw::MemPtr>, C<FFI::Raw::Ptr> pointers are
not automatically deallocated once not in use anymore.
=head1 METHODS
=head2 new( $ptr )
Create a new C<FFI::Raw::Ptr> pointing to C<$ptr>, which can be either a
C<FFI::Raw::MemPtr> or a pointer returned by a C function.
=cut
sub new {
my($class, $ptr) = @_;
bless \$ptr, $class;
}
=head1 AUTHOR
Graham Ollis <plicease@cpan.org>
Alessandro Ghedini <alexbio@cpan.org>
=head1 LICENSE AND COPYRIGHT
Copyright 2014 Alessandro Ghedini.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1; # End of FFI::Raw::Ptr

132
database/perl/vendor/lib/FFI/Temp.pm vendored Normal file
View File

@@ -0,0 +1,132 @@
package FFI::Temp;
use strict;
use warnings;
use 5.008004;
use Carp qw( croak );
use File::Spec;
use File::Temp qw( tempdir );
# ABSTRACT: Temp Dir support for FFI::Platypus
our $VERSION = '1.34'; # VERSION
# problem with vanilla File::Temp is that is often uses
# as /tmp that has noexec turned on. Workaround is to
# create a temp directory in the build directory, but
# we have to be careful about cleanup. This puts all that
# (attempted) carefulness in one place so that when we
# later discover it isn't so careful we can fix it in
# one place rather thabn alllll the places that we need
# temp directories.
my %root;
sub _root
{
my $root = File::Spec->rel2abs(File::Spec->catdir(".tmp"));
unless(-d $root)
{
mkdir $root or die "unable to create temp root $!";
}
# TODO: doesn't account for fork...
my $lock = File::Spec->catfile($root, "l$$");
unless(-f $lock)
{
open my $fh, '>', $lock;
close $fh;
}
$root{$root} = 1;
$root;
}
END {
foreach my $root (keys %root)
{
my $lock = File::Spec->catfile($root, "l$$");
unlink $lock;
# try to delete if possible.
# if not possible then punt
rmdir $root if -d $root;
}
}
sub newdir
{
my $class = shift;
croak "uneven" if @_ % 2;
File::Temp->newdir(DIR => _root, @_);
}
sub new
{
my $class = shift;
croak "uneven" if @_ % 2;
File::Temp->new(DIR => _root, @_);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
FFI::Temp - Temp Dir support for FFI::Platypus
=head1 VERSION
version 1.34
=head1 DESCRIPTION
This class is private to L<FFI::Platypus>.
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
Contributors:
Bakkiaraj Murugesan (bakkiaraj)
Dylan Cali (calid)
pipcet
Zaki Mughal (zmughal)
Fitz Elliott (felliott)
Vickenty Fesunov (vyf)
Gregor Herrmann (gregoa)
Shlomi Fish (shlomif)
Damyan Ivanov
Ilya Pavlov (Ilya33)
Petr Pisar (ppisar)
Mohammad S Anwar (MANWAR)
Håkon Hægland (hakonhagland, HAKONH)
Meredith (merrilymeredith, MHOWARD)
Diab Jerius (DJERIUS)
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015,2016,2017,2018,2019,2020 by Graham Ollis.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

46
database/perl/vendor/lib/FFI/typemap vendored Normal file
View File

@@ -0,0 +1,46 @@
ffi_pl_string T_FFI_PL_STRING
ffi_pl_type* T_FFI_PL_TYPE
ffi_pl_function* T_FFI_PL_FUNCTION
ffi_pl_closure* T_FFI_PL_CLOSURE_DATA
ffi_pl_arguments* T_FFI_PL_ARGUMENTS
OUTPUT
T_FFI_PL_STRING
$var != NULL ? sv_setpv((SV*)$arg, $var) : sv_setsv((SV*)$arg, &PL_sv_undef);
T_FFI_PL_TYPE
sv_setref_pv($arg, \"FFI::Platypus::Type\", (void *) $var);
T_FFI_PL_FUNCTION
sv_setref_pv($arg, \"FFI::Platypus::Function::Function\", (void *) $var);
T_FFI_PL_CLOSURE_DATA
sv_setref_pv($arg, \"FFI::Platypus::ClosureData\", (void *) $var);
INPUT
T_FFI_PL_STRING
$var = SvOK($arg) ? ($type)SvPV_nolen($arg) : NULL;
T_FFI_PL_TYPE
if(sv_isobject($arg) && sv_derived_from($arg, \"FFI::Platypus::Type\"))
$var = INT2PTR($type, SvIV((SV *) SvRV($arg)));
else
Perl_croak(aTHX_ \"$var is not of type FFI::Platypus::Type\");
T_FFI_PL_FUNCTION
if(sv_isobject($arg) && sv_derived_from($arg, \"FFI::Platypus::Function::Function\"))
$var = INT2PTR($type, SvIV((SV *) SvRV($arg)));
else
Perl_croak(aTHX_ \"$var is not of type FFI::Platypus::Function::Function\");
T_FFI_PL_CLOSURE_DATA
if(sv_isobject($arg) && sv_derived_from($arg, \"FFI::Platypus::ClosureData\"))
$var = INT2PTR($type, SvIV((SV *) SvRV($arg)));
else
Perl_croak(aTHX_ \"$var is not of type FFI::Platypus::ClosureData\");
T_FFI_PL_ARGUMENTS
if(sv_isobject($arg) && sv_derived_from($arg, \"FFI::Platypus::API::ARGV\"))
$var = INT2PTR($type, SvIV((SV *) SvRV($arg)));
else
Perl_croak(aTHX_ \"$var is not of type FFI::Platypus::API::ARGV\");