File Coverage

blib/lib/ExtUtils/Typemaps/Cmd.pm
Criterion Covered Total %
statement 33 36 91.6
branch 6 8 75.0
condition 3 5 60.0
subroutine 7 7 100.0
pod 1 1 100.0
total 50 57 87.7


line stmt bran cond sub pod time code
1             package ExtUtils::Typemaps::Cmd;
2 1     1   56311 use 5.006001;
  1         11  
3 1     1   5 use strict;
  1         1  
  1         28  
4 1     1   5 use warnings;
  1         2  
  1         43  
5             our $VERSION = '3.44';
6              
7 1     1   395 use ExtUtils::Typemaps;
  1         3  
  1         535  
8              
9             require Exporter;
10              
11             our @ISA = qw(Exporter);
12             our @EXPORT = qw(embeddable_typemap);
13             our %EXPORT_TAGS = (all => \@EXPORT);
14              
15             sub embeddable_typemap {
16 5     5 1 1514 my @tms = @_;
17              
18             # Get typemap objects
19 5         12 my @tm_objs = map [$_, _intuit_typemap_source($_)], @tms;
20              
21             # merge or short-circuit
22 5         7 my $final_tm;
23 5 100       12 if (@tm_objs == 1) {
24             # just one, merge would be pointless
25 3         6 $final_tm = shift(@tm_objs)->[1];
26             }
27             else {
28             # multiple, need merge
29 2         8 $final_tm = ExtUtils::Typemaps->new;
30 2         5 foreach my $other_tm (@tm_objs) {
31 2         5 my ($tm_ident, $tm_obj) = @$other_tm;
32             eval {
33 2         5 $final_tm->merge(typemap => $tm_obj);
34 2         5 1
35 2 50       3 } or do {
36 0   0     0 my $err = $@ || 'Zombie error';
37 0         0 die "Failed to merge typ";
38             }
39             }
40             }
41              
42             # stringify for embedding
43 5         19 return $final_tm->as_embedded_typemap();
44             }
45              
46             sub _load_module {
47 4     4   5 my $name = shift;
48 4         194 return eval "require $name; 1";
49             }
50              
51             SCOPE: {
52             my %sources = (
53             module => sub {
54             my $ident = shift;
55             my $tm;
56             if (/::/) { # looks like FQ module name, try that first
57             foreach my $module ($ident, "ExtUtils::Typemaps::$ident") {
58             if (_load_module($module)) {
59             eval { $tm = $module->new }
60             and return $tm;
61             }
62             }
63             }
64             else {
65             foreach my $module ("ExtUtils::Typemaps::$ident", "$ident") {
66             if (_load_module($module)) {
67             eval { $tm = $module->new }
68             and return $tm;
69             }
70             }
71             }
72             return();
73             },
74             file => sub {
75             my $ident = shift;
76             return unless -e $ident and -r _;
77             return ExtUtils::Typemaps->new(file => $ident);
78             },
79             );
80             # Try to find typemap either from module or file
81             sub _intuit_typemap_source {
82 5     5   9 my $identifier = shift;
83              
84 5         5 my @locate_attempts;
85 5 100 100     30 if ($identifier =~ /::/ || $identifier !~ /[^\w_]/) {
86 4         7 @locate_attempts = qw(module file);
87             }
88             else {
89 1         2 @locate_attempts = qw(file module);
90             }
91              
92 5         11 foreach my $source (@locate_attempts) {
93 5         11 my $tm = $sources{$source}->($identifier);
94 5 50       42 return $tm if defined $tm;
95             }
96              
97 0           die "Unable to find typemap for '$identifier': "
98             . "Tried to load both as file or module and failed.\n";
99             }
100             } # end SCOPE
101              
102             =head1 NAME
103              
104             ExtUtils::Typemaps::Cmd - Quick commands for handling typemaps
105              
106             =head1 SYNOPSIS
107              
108             From XS:
109              
110             INCLUDE_COMMAND: $^X -MExtUtils::Typemaps::Cmd \
111             -e "print embeddable_typemap(q{Excommunicated})"
112              
113             Loads C, instantiates an object,
114             and dumps it as an embeddable typemap for use directly in your XS file.
115              
116             =head1 DESCRIPTION
117              
118             This is a helper module for L for quick
119             one-liners, specifically for inclusion of shared typemaps
120             that live on CPAN into an XS file (see SYNOPSIS).
121              
122             For this reason, the following functions are exported by default:
123              
124             =head1 EXPORTED FUNCTIONS
125              
126             =head2 embeddable_typemap
127              
128             Given a list of identifiers, C
129             tries to load typemaps from a file of the given name(s),
130             or from a module that is an C subclass.
131              
132             Returns a string representation of the merged typemaps that can
133             be included verbatim into XS. Example:
134              
135             print embeddable_typemap(
136             "Excommunicated", "ExtUtils::Typemaps::Basic", "./typemap"
137             );
138              
139             This will try to load a module C
140             and use it as an C subclass. If that fails, it'll
141             try loading C as a module, if that fails, it'll try to
142             read a file called F. It'll work similarly for the
143             second argument, but the third will be loaded as a file first.
144              
145             After loading all typemap files or modules, it will merge them in the
146             specified order and dump the result as an embeddable typemap.
147              
148             =head1 SEE ALSO
149              
150             L
151              
152             L
153              
154             =head1 AUTHOR
155              
156             Steffen Mueller C<>
157              
158             =head1 COPYRIGHT & LICENSE
159              
160             Copyright 2012 Steffen Mueller
161              
162             This program is free software; you can redistribute it and/or
163             modify it under the same terms as Perl itself.
164              
165             =cut
166              
167             1;
168