EU::Typemaps: Helper module for easy typemap inclusion in XS

In order to be able to deprecate certain typemaps from the core and send
them to a peaceful retirement on the CPAN, it's necessary to make it
easy to share and include these typemaps in case they're used despite
CPAN greps claiming the opposite. This helper module facilitates
non-copy-and-paste sharing of typemaps by adding a dependency and
including a single line of code in the XS.

5 files changed, 294 insertions, 0 deletions

diff --git a/MANIFEST b/MANIFEST
index 346a87e0d4..8948eb99f2 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3114,6 +3114,7 @@ dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm	ExtUtils::ParseXS guts
 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
@@ -3145,6 +3146,7 @@ dist/ExtUtils-ParseXS/t/511-t-whitespace.t			ExtUtils::Typemaps tests
 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
@@ -3154,8 +3156,10 @@ dist/ExtUtils-ParseXS/t/data/confl_skip.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
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm
new file mode 100644
index 0000000000..3c4e8c623b
--- /dev/null
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm
@@ -0,0 +1,167 @@
+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;
+
diff --git a/dist/ExtUtils-ParseXS/t/515-t-cmd.t b/dist/ExtUtils-ParseXS/t/515-t-cmd.t
new file mode 100644
index 0000000000..d5e862b7e6
--- /dev/null
+++ b/dist/ExtUtils-ParseXS/t/515-t-cmd.t
@@ -0,0 +1,93 @@
+#!/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.
diff --git a/dist/ExtUtils-ParseXS/t/lib/ExtUtils/Typemaps/Test.pm b/dist/ExtUtils-ParseXS/t/lib/ExtUtils/Typemaps/Test.pm
new file mode 100644
index 0000000000..453a44b95e
--- /dev/null
+++ b/dist/ExtUtils-ParseXS/t/lib/ExtUtils/Typemaps/Test.pm
@@ -0,0 +1,15 @@
+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;
diff --git a/dist/ExtUtils-ParseXS/t/lib/TypemapTest/Foo.pm b/dist/ExtUtils-ParseXS/t/lib/TypemapTest/Foo.pm
new file mode 100644
index 0000000000..d15f4653cf
--- /dev/null
+++ b/dist/ExtUtils-ParseXS/t/lib/TypemapTest/Foo.pm
@@ -0,0 +1,15 @@
+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;