dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm converts Perl XS code into C code
dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pod ExtUtils::ParseXS documentation
dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm ExtUtils::ParseXS guts
+dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm ExtUtils::Typemaps helper module
dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm ExtUtils::Typemaps guts
dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm ExtUtils::Typemaps guts
dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm ExtUtils::Typemaps, a PXS helper
dist/ExtUtils-ParseXS/t/512-t-file.t ExtUtils::Typemaps tests
dist/ExtUtils-ParseXS/t/513-t-merge.t ExtUtils::Typemaps tests
dist/ExtUtils-ParseXS/t/514-t-embed.t ExtUtils::Typemaps tests
+dist/ExtUtils-ParseXS/t/515-t-cmd.t ExtUtils::Typemaps tests
dist/ExtUtils-ParseXS/t/600-t-compat.t ExtUtils::Typemaps tests
dist/ExtUtils-ParseXS/t/data/b.typemap ExtUtils::Typemaps test data
dist/ExtUtils-ParseXS/t/data/combined.typemap ExtUtils::Typemaps test data
dist/ExtUtils-ParseXS/t/data/other.typemap ExtUtils::Typemaps test data
dist/ExtUtils-ParseXS/t/data/perl.typemap ExtUtils::Typemaps test data
dist/ExtUtils-ParseXS/t/data/simple.typemap ExtUtils::Typemaps test data
+dist/ExtUtils-ParseXS/t/lib/ExtUtils/Typemaps/Test.pm ExtUtils::Typemaps tests
dist/ExtUtils-ParseXS/t/lib/IncludeTester.pm ExtUtils::ParseXS testing utility
dist/ExtUtils-ParseXS/t/lib/PrimitiveCapture.pm Primitive STDOUT/ERR capturing for tests
+dist/ExtUtils-ParseXS/t/lib/TypemapTest/Foo.pm ExtUtils::Typemaps tests
dist/ExtUtils-ParseXS/t/pseudotypemap1 A test-typemap
dist/ExtUtils-ParseXS/t/typemap Standard typemap for controlled testing
dist/ExtUtils-ParseXS/t/XSInclude.xsh Test file for ExtUtils::ParseXS tests
--- /dev/null
+package ExtUtils::Typemaps::Cmd;
+use 5.006001;
+use strict;
+use warnings;
+
+use ExtUtils::Typemaps;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(embeddable_typemap);
+our %EXPORT_TAGS = (all => \@EXPORT);
+
+sub embeddable_typemap {
+ my @tms = @_;
+
+ # Get typemap objects
+ my @tm_objs = map [$_, _intuit_typemap_source($_)], @tms;
+
+ # merge or short-circuit
+ my $final_tm;
+ if (@tm_objs == 1) {
+ # just one, merge would be pointless
+ $final_tm = shift(@tm_objs)->[1];
+ }
+ else {
+ # multiple, need merge
+ $final_tm = ExtUtils::Typemaps->new;
+ foreach my $other_tm (@tm_objs) {
+ my ($tm_ident, $tm_obj) = @$other_tm;
+ eval {
+ $final_tm->merge(typemap => $tm_obj);
+ 1
+ } or do {
+ my $err = $@ || 'Zombie error';
+ die "Failed to merge typ";
+ }
+ }
+ }
+
+ # stringify for embedding
+ return $final_tm->as_embedded_typemap();
+}
+
+sub _load_module {
+ my $name = shift;
+ return eval "require $name; 1";
+}
+
+SCOPE: {
+ my %sources = (
+ module => sub {
+ my $ident = shift;
+ my $tm;
+ if (/::/) { # looks like FQ module name, try that first
+ foreach my $module ($ident, "ExtUtils::Typemaps::$ident") {
+ if (_load_module($module)) {
+ eval { $tm = $module->new }
+ and return $tm;
+ }
+ }
+ }
+ else {
+ foreach my $module ("ExtUtils::Typemaps::$ident", "$ident") {
+ if (_load_module($module)) {
+ eval { $tm = $module->new }
+ and return $tm;
+ }
+ }
+ }
+ return();
+ },
+ file => sub {
+ my $ident = shift;
+ return unless -e $ident and -r _;
+ return ExtUtils::Typemaps->new(file => $ident);
+ },
+ );
+ # Try to find typemap either from module or file
+ sub _intuit_typemap_source {
+ my $identifier = shift;
+
+ my @locate_attempts;
+ if ($identifier =~ /::/ || $identifier !~ /[^\w_]/) {
+ @locate_attempts = qw(module file);
+ }
+ else {
+ @locate_attempts = qw(file module);
+ }
+
+ foreach my $source (@locate_attempts) {
+ my $tm = $sources{$source}->($identifier);
+ return $tm if defined $tm;
+ }
+
+ die "Unable to find typemap for '$identifier': "
+ . "Tried to load both as file or module and failed.\n";
+ }
+} # end SCOPE
+
+=head1 NAME
+
+ExtUtils::Typemaps::Cmd - Quick commands for handling typemaps
+
+=head1 SYNOPSIS
+
+From XS:
+
+ INCLUDE_COMMAND: $^X -MExtUtils::Typemaps::Cmd \
+ -e 'print embeddable_typemap("Excommunicated")'
+
+Loads C<ExtUtils::Typemaps::Excommunicated>, instantiates an object,
+and dumps it as an embeddable typemap for use directly in your XS file.
+
+=head1 DESCRIPTION
+
+This is a helper module for L<ExtUtils::Typemaps> for quick
+one-liners, specifically for inclusion of shared typemaps
+that live on CPAN into an XS file (see SYNOPSIS).
+
+For this reason, the following functions are exported by default:
+
+=head1 EXPORTED FUNCTIONS
+
+=head2 embeddable_typemap
+
+Given a list of identifiers, C<embeddable_typemap>
+tries to load typemaps from a file of the given name(s),
+or from a module that is an C<ExtUtils::Typemaps> subclass.
+
+Returns a string representation of the merged typemaps that can
+be included verbatim into XS. Example:
+
+ print embeddable_typemap(
+ "Excommunicated", "ExtUtils::Typemaps::Basic", "./typemap"
+ );
+
+This will try to load a module C<ExtUtils::Typemaps::Excommunicated>
+and use it as an C<ExtUtils::Typemaps> subclass. If that fails, it'll
+try loading C<Excommunicated> as a module, if that fails, it'll try to
+read a file called F<Excommunicated>. It'll work similarly for the
+second argument, but the third will be loaded as a file first.
+
+After loading all typemap files or modules, it will merge them in the
+specified order and dump the result as an embeddable typemap.
+
+=head1 SEE ALSO
+
+L<ExtUtils::Typemaps>
+
+L<perlxs>
+
+=head1 AUTHOR
+
+Steffen Mueller C<<smueller@cpan.org>>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2012 Steffen Mueller
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
+1;
+
--- /dev/null
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+# tests for the quick-n-dirty interface for XS inclusion
+
+use Test::More tests => 6;
+use File::Spec;
+use ExtUtils::Typemaps::Cmd;
+
+my $datadir = -d 't' ? File::Spec->catdir(qw/t data/) : 'data';
+my $libdir = -d 't' ? File::Spec->catdir(qw/t lib/) : 'lib';
+
+unshift @INC, $libdir;
+
+sub slurp {
+ my $file = shift;
+ open my $fh, '<', $file
+ or die "Cannot open file '$file' for reading: $!";
+ local $/ = undef;
+ return <$fh>;
+}
+
+sub permute (&@) {
+ my $code = shift;
+ my @idx = 0..$#_;
+ while ( $code->(@_[@idx]) ) {
+ my $p = $#idx;
+ --$p while $idx[$p-1] > $idx[$p];
+ my $q = $p or return;
+ push @idx, reverse splice @idx, $p;
+ ++$q while $idx[$p-1] > $idx[$q];
+ @idx[$p-1,$q]=@idx[$q,$p-1];
+ }
+}
+
+
+SCOPE: {
+ no warnings 'once';
+ ok(defined(*embeddable_typemap{CODE}), "function exported");
+}
+
+my $start = "TYPEMAP: <<END_TYPEMAP;\n";
+my $end = "\nEND_TYPEMAP\n";
+is(
+ embeddable_typemap(),
+ "${start}TYPEMAP\n$end",
+ "empty call to embeddable_typemap"
+);
+
+my $typemap_file = File::Spec->catfile($datadir, "simple.typemap");
+is(
+ embeddable_typemap($typemap_file),
+ $start . slurp($typemap_file) . $end,
+ "embeddable typemap from file"
+);
+
+my $foo_content = <<HERE;
+TYPEMAP
+myfoo* T_PV
+HERE
+is(
+ embeddable_typemap("TypemapTest::Foo"),
+ "$start$foo_content$end",
+ "embeddable typemap from full module name"
+);
+
+
+my $test_content = <<HERE;
+TYPEMAP
+mytype* T_SV
+HERE
+is(
+ embeddable_typemap("Test"),
+ "$start$test_content$end",
+ "embeddable typemap from relative module name"
+);
+
+SCOPE: {
+ my $combined = embeddable_typemap("Test", "TypemapTest::Foo");
+ my @lines = (
+ 'myfoo* T_PV',
+ 'mytype* T_SV',
+ );
+ my @exp = map {"TYPEMAP\n" . join("\n", @$_) . "\n"}
+ (\@lines, [reverse @lines]);
+ ok(scalar(grep "$start$_$end" eq $combined, @exp), "combined both modules")
+ or note("Actual output: '$combined'");
+}
+
+# in theory, we should test
+# embeddable_typemap($typemap_file, "Test", "TypemapTest::Foo"),
+# but I can't be bothered.
--- /dev/null
+package # hide from indexers
+ ExtUtils::Typemaps::Test;
+use strict;
+use warnings;
+require ExtUtils::Typemaps;
+our @ISA = qw(ExtUtils::Typemaps);
+
+sub new {
+ my $class = shift;
+ my $obj = $class->SUPER::new(@_);
+ $obj->add_typemap(ctype => 'mytype*', xstype => 'T_SV');
+ return $obj;
+}
+
+1;
--- /dev/null
+package # hide from indexers
+ TypemapTest::Foo;
+use strict;
+use warnings;
+require ExtUtils::Typemaps;
+our @ISA = qw(ExtUtils::Typemaps);
+
+sub new {
+ my $class = shift;
+ my $obj = $class->SUPER::new(@_);
+ $obj->add_typemap(ctype => 'myfoo*', xstype => 'T_PV');
+ return $obj;
+}
+
+1;
projects / platform / upstream / perl.git / commitdiff