NativeCall-0.006/0000755000076400007640000000000013040260104012255 5ustar useruserNativeCall-0.006/META.json0000644000076400007640000000270113040260104013676 0ustar useruser{ "abstract" : "Perl 5 interface to foreign functions in Perl code without XS", "author" : [ "Ed J " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150001", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "NativeCall", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "FFI::CheckLib" : "0.06", "FFI::Platypus" : "0", "Sub::Util" : "0", "parent" : "0", "perl" : "5.016" } }, "test" : { "requires" : { "FFI::CheckLib" : "0.06", "FFI::Platypus" : "0", "Sub::Util" : "0", "Test::More" : "0", "parent" : "0", "perl" : "5.016" } } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "git://github.com/mohawk2/nativecall", "web" : "https://github.com/mohawk2/nativecall" } }, "version" : "0.006" } NativeCall-0.006/MANIFEST0000644000076400007640000000041213040260104013403 0ustar useruserChanges MANIFEST Makefile.PL examples/troll.pl lib/NativeCall.pm t/basic.t t/closure.t t/symbol.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) NativeCall-0.006/examples/0000755000076400007640000000000013040260104014073 5ustar useruserNativeCall-0.006/examples/troll.pl0000644000076400007640000000064212720436537015611 0ustar useruser#!/usr/bin/env perl use strict; use warnings; use parent qw(NativeCall); use feature 'say'; sub cdio_eject_media_drive :Args(string) :Native(cdio) {} sub cdio_close_tray :Args(string, int) :Native(cdio) {} say "Gimme a CD!"; cdio_eject_media_drive undef; sleep 1; say "Ha! Too slow!"; cdio_close_tray undef, 0; sub fmax :Args(double, double) :Native :Returns(double) {} say "fmax(2.0, 3.0) = " . fmax(2.0, 3.0); NativeCall-0.006/META.yml0000644000076400007640000000137213040260104013531 0ustar useruser--- abstract: 'Perl 5 interface to foreign functions in Perl code without XS' author: - 'Ed J ' build_requires: ExtUtils::MakeMaker: '0' FFI::CheckLib: '0.06' FFI::Platypus: '0' Sub::Util: '0' Test::More: '0' parent: '0' perl: '5.016' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150001' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: NativeCall no_index: directory: - t - inc requires: FFI::CheckLib: '0.06' FFI::Platypus: '0' Sub::Util: '0' parent: '0' perl: '5.016' resources: repository: git://github.com/mohawk2/nativecall version: '0.006' NativeCall-0.006/Changes0000644000076400007640000000073713040260034013561 0ustar useruser0.006 2017-01-20 - allow closure types (thanks to plicease for all of these) 0.005 2017-01-16 - allow Symbol attribute (thanks to plicease for all of these) - require 5.16 because of attribute.pm bug - strcmp not fmax for tests for better ubiquity 0.004 2016-06-08 - add Changes - add minimal test 0.003 2016-05-23 - credit plicease - remove debug from example - avoid uninit warning 0.002 2016-05-22 - credit Zoffix 0.001 2016-05-22 - initial version NativeCall-0.006/lib/0000755000076400007640000000000013040260104013023 5ustar useruserNativeCall-0.006/lib/NativeCall.pm0000644000076400007640000000561713040257766015440 0ustar useruserpackage NativeCall; use strict; use warnings; use 5.016; use Sub::Util qw(subname); use FFI::Platypus; use FFI::CheckLib 0.06; our $VERSION = '0.006'; my %attr21 = ( Native => 1, Args => 1, Returns => 1, Symbol => 1, ); sub _attr_parse { my ($attr) = @_; my ($attribute, $args) = ($attr =~ / (\w+) (?: \( (.*) \) )? /x); return ($attribute, [ map { s/;/,/gr; } split /,\s*/, ($args//'') =~ s/(\([^)]*\))/$1 =~ s{,}{;}rg /ger ]); } sub MODIFY_CODE_ATTRIBUTES { my ($package, $subref, @attrs) = @_; my @bad; my %attr2args; for my $attr (@attrs) { my ($attribute, $args) = _attr_parse($attr); if (!$attr21{$attribute}) { push @bad, $attribute; next; } else { $attr2args{$attribute} ||= []; push @{ $attr2args{$attribute} }, @$args; } } my $subname = subname $subref; my $sub_base = $attr2args{Symbol}->[0] // (split /::/, $subname)[-1]; my $ffi = FFI::Platypus->new; my $lib = $attr2args{Native}->[0] || undef; # undef means standard library $ffi->lib($lib ? find_lib_or_die lib => $lib : undef); my $argtypes = $attr2args{Args}; my $returntype = $attr2args{Returns}->[0] || 'void'; no warnings qw(redefine); undef &{ $subname }; # avoid "redefine" warning in Platypus $ffi->attach([ $sub_base => $subname ] => $argtypes => $returntype); return @bad; } 1; __END__ =head1 NAME NativeCall - Perl 5 interface to foreign functions in Perl code without XS =head1 SYNOPSIS use parent qw(NativeCall); use feature 'say'; sub cdio_eject_media_drive :Args(string) :Native(cdio) {} sub cdio_close_tray :Args(string, int) :Native(cdio) {} say "Gimme a CD!"; cdio_eject_media_drive undef; sleep 1; say "Ha! Too slow!"; cdio_close_tray undef, 0; sub fmax :Args(double, double) :Native :Returns(double) {} say "fmax(2.0, 3.0) = " . fmax(2.0, 3.0); # avoid Perl built in also called "abs" sub myabs :Args(int) :Native :Returns(int) :Symbol(abs) {} say "abs(-3) = " . abs(-3); =head1 DESCRIPTION Mimics the C module and interface from Perl 6. Uses L, by the mighty Graham Ollis, for the actual hard work. Uses inheritance and L. See F for the example given above in SYNOPSIS. =head2 ATTRIBUTES =over =item Native If an argument is given, try to load from that library. If none given, use what is already loaded. =item Args A comma-separated list of Ls. All types are supported, including L. =item Returns A single L. =item Symbol The native symbol name, if different from the Perl sub name. =back =head1 INSPIRATION This module is entirely inspired by the article about Perl 6 NativeCall at L. All credit for clear explanation to Zoffix. All brickbats to me. NativeCall-0.006/Makefile.PL0000644000076400007640000000140013037252340014233 0ustar useruseruse ExtUtils::MakeMaker; use strict; use warnings; my %runtime_reqs = ( 'perl' => '5.016', 'parent' => 0, 'FFI::Platypus' => 0, 'FFI::CheckLib' => 0.06, 'Sub::Util' => 0, ); WriteMakefile( NAME => 'NativeCall', VERSION_FROM => 'lib/NativeCall.pm', ABSTRACT_FROM => 'lib/NativeCall.pm', AUTHOR => 'Ed J ', LICENSE => 'perl', META_MERGE => { "meta-spec" => { version => 2 }, resources => { repository => { type => 'git', url => 'git://github.com/mohawk2/nativecall', web => 'https://github.com/mohawk2/nativecall', }, }, }, CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => 0 }, TEST_REQUIRES => { 'Test::More' => 0, %runtime_reqs, }, PREREQ_PM => \%runtime_reqs, ); NativeCall-0.006/t/0000755000076400007640000000000013040260104012520 5ustar useruserNativeCall-0.006/t/symbol.t0000644000076400007640000000057713037252340014234 0ustar useruseruse strict; use warnings; use Test::More; use FFI::Platypus; my %sym; no warnings 'redefine'; sub FFI::Platypus::attach { my($self, $name, $args, $ret) = @_; $sym{$name->[1]} = $name->[0]; $self; } use parent qw( NativeCall ); sub foo1 :Returns(void) :Symbol(bar1) {} is $sym{'main::foo1'}, 'bar1'; sub foo2 :Returns(void) {} is $sym{'main::foo2'}, 'foo2'; done_testing; NativeCall-0.006/t/basic.t0000644000076400007640000000030313037252340013773 0ustar useruseruse strict; use warnings; use Test::More tests => 2; use parent qw(NativeCall); sub strcmp :Args(string,string) :Native :Returns(int) {} is strcmp("abc","abc"), 0; isnt strcmp("abc","def"), 0; NativeCall-0.006/t/closure.t0000644000076400007640000000125113040257746014402 0ustar useruseruse strict; use warnings; use Test::More; use FFI::Platypus; my %args; no warnings 'redefine'; sub FFI::Platypus::attach { my($self, $name, $args, $ret) = @_; $args{$name->[0]} = $args; $self; } use parent qw( NativeCall ); sub foo1 :Args((int)->int) :Returns(void) {} is_deeply $args{foo1}, [ '(int)->int' ]; sub foo2 :Args((int)->int,int) :Returns(void) {} is_deeply $args{foo2}, [ '(int)->int', 'int' ]; sub foo3 :Args((int,int)->int) :Returns(void) {} is_deeply $args{foo3}, [ '(int,int)->int' ]; sub foo4 :Args((int,int)->int,int,(string,int,int)->int) :Returns(void) {} is_deeply $args{foo4}, [ '(int,int)->int', 'int', '(string,int,int)->int' ]; done_testing;