This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Allow merging typemaps from file
[perl5.git] / dist / ExtUtils-ParseXS / lib / ExtUtils / Typemaps.pm
1 package ExtUtils::Typemaps;
2 use 5.006001;
3 use strict;
4 use warnings;
5 our $VERSION = '1.00';
6 use Carp qw(croak);
7
8 require ExtUtils::ParseXS;
9 require ExtUtils::ParseXS::Constants;
10 require ExtUtils::Typemaps::InputMap;
11 require ExtUtils::Typemaps::OutputMap;
12 require ExtUtils::Typemaps::Type;
13
14 =head1 NAME
15
16 ExtUtils::Typemaps - Read/Write/Modify Perl/XS typemap files
17
18 =head1 SYNOPSIS
19
20   # read/create file
21   my $typemap = ExtUtils::Typemaps->new(file => 'typemap');
22   # alternatively create an in-memory typemap
23   # $typemap = ExtUtils::Typemaps->new();
24   # alternatively create an in-memory typemap by parsing a string
25   # $typemap = ExtUtils::Typemaps->new(string => $sometypemap);
26   
27   # add a mapping
28   $typemap->add_typemap(ctype => 'NV', xstype => 'T_NV');
29   $typemap->add_inputmap (xstype => 'T_NV', code => '$var = ($type)SvNV($arg);');
30   $typemap->add_outputmap(xstype => 'T_NV', code => 'sv_setnv($arg, (NV)$var);');
31   $typemap->add_string(string => $typemapstring); # will be parsed and merged
32   
33   # remove a mapping (same for remove_typemap and remove_outputmap...)
34   $typemap->remove_inputmap(xstype => 'SomeType');
35   
36   # save a typemap to a file
37   $typemap->write(file => 'anotherfile.map');
38   
39   # merge the other typemap into this one
40   $typemap->merge(typemap => $another_typemap);
41
42 =head1 DESCRIPTION
43
44 This module can read, modify, create and write Perl XS typemap files. If you don't know
45 what a typemap is, please confer the L<perlxstut> and L<perlxs> manuals.
46
47 The module is not entirely round-trip safe: For example it currently simply strips all comments.
48 The order of entries in the maps is, however, preserved.
49
50 We check for duplicate entries in the typemap, but do not check for missing
51 C<TYPEMAP> entries for C<INPUTMAP> or C<OUTPUTMAP> entries since these might be hidden
52 in a different typemap.
53
54 =head1 METHODS
55
56 =cut
57
58 =head2 new
59
60 Returns a new typemap object. Takes an optional C<file> parameter.
61 If set, the given file will be read. If the file doesn't exist, an empty typemap
62 is returned.
63
64 Alternatively, if the C<string> parameter is given, the supplied
65 string will be parsed instead of a file.
66
67 =cut
68
69 sub new {
70   my $class = shift;
71   my %args = @_;
72
73   if (defined $args{file} and defined $args{string}) {
74     croak("Cannot handle both 'file' and 'string' arguments to constructor");
75   }
76
77   my $self = bless {
78     file            => undef,
79     %args,
80     typemap_section => [],
81     typemap_lookup  => {},
82     input_section   => [],
83     input_lookup    => {},
84     output_section  => [],
85     output_lookup   => {},
86   } => $class;
87
88   $self->_init();
89
90   return $self;
91 }
92
93 sub _init {
94   my $self = shift;
95   if (defined $self->{string}) {
96     $self->_parse(\($self->{string}));
97     delete $self->{string};
98   }
99   elsif (defined $self->{file} and -e $self->{file}) {
100     open my $fh, '<', $self->{file}
101       or die "Cannot open typemap file '"
102              . $self->{file} . "' for reading: $!";
103     local $/ = undef;
104     my $string = <$fh>;
105     $self->_parse(\$string, $self->{file});
106   }
107 }
108
109 =head2 file
110
111 Get/set the file that the typemap is written to when the
112 C<write> method is called.
113
114 =cut
115
116 sub file {
117   $_[0]->{file} = $_[1] if @_ > 1;
118   $_[0]->{file}
119 }
120
121 =head2 add_typemap
122
123 Add a C<TYPEMAP> entry to the typemap.
124
125 Required named arguments: The C<ctype> (e.g. C<ctype =E<gt> 'double'>)
126 and the C<xstype> (e.g. C<xstype =E<gt> 'T_NV'>).
127
128 Optional named arguments: C<replace =E<gt> 1> forces removal/replacement of
129 existing C<TYPEMAP> entries of the same C<ctype>.
130
131 As an alternative to the named parameters usage, you may pass in
132 an C<ExtUtils::Typemaps::Type> object, a copy of which will be
133 added to the typemap.
134
135 =cut
136
137 sub add_typemap {
138   my $self = shift;
139   my $type;
140   my $replace = 0;
141   if (@_ == 1) {
142     my $orig = shift;
143     $type = $orig->new(@_);
144   }
145   else {
146     my %args = @_;
147     my $ctype = $args{ctype};
148     croak("Need ctype argument") if not defined $ctype;
149     my $xstype = $args{xstype};
150     croak("Need xstype argument") if not defined $xstype;
151
152     $type = ExtUtils::Typemaps::Type->new(
153       xstype      => $xstype,
154       'prototype' => $args{'prototype'},
155       ctype       => $ctype,
156     );
157     $replace = $args{replace};
158   }
159
160   if ($replace) {
161     $self->remove_typemap(ctype => $type->ctype);
162   } else {
163     $self->validate(typemap_xstype => $type->xstype, ctype => $type->ctype);
164   }
165
166   # store
167   push @{$self->{typemap_section}}, $type;
168   # remember type for lookup, too.
169   $self->{typemap_lookup}{$type->tidy_ctype} = $#{$self->{typemap_section}};
170
171   return 1;
172 }
173
174 =head2 add_inputmap
175
176 Add an C<INPUT> entry to the typemap.
177
178 Required named arguments:
179 The C<xstype> (e.g. C<xstype =E<gt> 'T_NV'>)
180 and the C<code> to associate with it for input.
181
182 Optional named arguments: C<replace =E<gt> 1> forces removal/replacement of
183 existing C<INPUT> entries of the same C<xstype>.
184
185 You may pass in a single C<ExtUtils::Typemaps::InputMap> object instead,
186 a copy of which will be added to the typemap.
187
188 =cut
189
190 sub add_inputmap {
191   my $self = shift;
192   my $input;
193   my $replace = 0;
194   if (@_ == 1) {
195     my $orig = shift;
196     $input = $orig->new(@_);
197   }
198   else {
199     my %args = @_;
200     my $xstype = $args{xstype};
201     croak("Need xstype argument") if not defined $xstype;
202     my $code = $args{code};
203     croak("Need code argument") if not defined $code;
204
205     $input = ExtUtils::Typemaps::InputMap->new(
206       xstype => $xstype,
207       code   => $code,
208     );
209     $replace = $args{replace};
210   }
211   if ($replace) {
212     $self->remove_inputmap(xstype => $input->xstype);
213   } else {
214     $self->validate(inputmap_xstype => $input->xstype);
215   }
216
217   # store
218   push @{$self->{input_section}}, $input;
219   # remember type for lookup, too.
220   $self->{input_lookup}{$input->xstype} = $#{$self->{input_section}};
221
222   return 1;
223 }
224
225 =head2 add_outputmap
226
227 Add an C<OUTPUT> entry to the typemap.
228 Works exactly the same as C<add_inputmap>.
229
230 =cut
231
232 sub add_outputmap {
233   my $self = shift;
234   my $output;
235   my $replace = 0;
236   if (@_ == 1) {
237     my $orig = shift;
238     $output = $orig->new(@_);
239   }
240   else {
241     my %args = @_;
242     my $xstype = $args{xstype};
243     croak("Need xstype argument") if not defined $xstype;
244     my $code = $args{code};
245     croak("Need code argument") if not defined $code;
246
247     $output = ExtUtils::Typemaps::OutputMap->new(
248       xstype => $xstype,
249       code   => $code,
250     );
251     $replace = $args{replace};
252   }
253   if ($replace) {
254     $self->remove_outputmap(xstype => $output->xstype);
255   } else {
256     $self->validate(outputmap_xstype => $output->xstype);
257   }
258
259   # store
260   push @{$self->{output_section}}, $output;
261   # remember type for lookup, too.
262   $self->{output_lookup}{$output->xstype} = $#{$self->{output_section}};
263
264   return 1;
265 }
266
267 =head2 add_string
268
269 Parses a string as a typemap and merge it into the typemap object.
270
271 Required named argument: C<string> to specify the string to parse.
272
273 =cut
274
275 sub add_string {
276   my $self = shift;
277   my %args = @_;
278   croak("Need 'string' argument") if not defined $args{string};
279
280   # no, this is not elegant.
281   my $other = ExtUtils::Typemaps->new(string => $args{string});
282   $self->merge(typemap => $other);
283 }
284
285 =head2 remove_typemap
286
287 Removes a C<TYPEMAP> entry from the typemap.
288
289 Required named argument: C<ctype> to specify the entry to remove from the typemap.
290
291 Alternatively, you may pass a single C<ExtUtils::Typemaps::Type> object.
292
293 =cut
294
295 sub remove_typemap {
296   my $self = shift;
297   my $ctype;
298   if (@_ > 1) {
299     my %args = @_;
300     $ctype = $args{ctype};
301     croak("Need ctype argument") if not defined $ctype;
302     $ctype = _tidy_type($ctype);
303   }
304   else {
305     $ctype = $_[0]->tidy_ctype;
306   }
307
308   return $self->_remove($ctype, $self->{typemap_section}, $self->{typemap_lookup});
309 }
310
311 =head2 remove_inputmap
312
313 Removes an C<INPUT> entry from the typemap.
314
315 Required named argument: C<xstype> to specify the entry to remove from the typemap.
316
317 Alternatively, you may pass a single C<ExtUtils::Typemaps::InputMap> object.
318
319 =cut
320
321 sub remove_inputmap {
322   my $self = shift;
323   my $xstype;
324   if (@_ > 1) {
325     my %args = @_;
326     $xstype = $args{xstype};
327     croak("Need xstype argument") if not defined $xstype;
328   }
329   else {
330     $xstype = $_[0]->xstype;
331   }
332   
333   return $self->_remove($xstype, $self->{input_section}, $self->{input_lookup});
334 }
335
336 =head2 remove_inputmap
337
338 Removes an C<OUTPUT> entry from the typemap.
339
340 Required named argument: C<xstype> to specify the entry to remove from the typemap.
341
342 Alternatively, you may pass a single C<ExtUtils::Typemaps::OutputMap> object.
343
344 =cut
345
346 sub remove_outputmap {
347   my $self = shift;
348   my $xstype;
349   if (@_ > 1) {
350     my %args = @_;
351     $xstype = $args{xstype};
352     croak("Need xstype argument") if not defined $xstype;
353   }
354   else {
355     $xstype = $_[0]->xstype;
356   }
357   
358   return $self->_remove($xstype, $self->{output_section}, $self->{output_lookup});
359 }
360
361 sub _remove {
362   my $self   = shift;
363   my $rm     = shift;
364   my $array  = shift;
365   my $lookup = shift;
366
367   # Just fetch the index of the item from the lookup table
368   my $index = $lookup->{$rm};
369   return() if not defined $index;
370
371   # Nuke the item from storage
372   splice(@$array, $index, 1);
373
374   # Decrement the storage position of all items thereafter
375   foreach my $key (keys %$lookup) {
376     if ($lookup->{$key} > $index) {
377       $lookup->{$key}--;
378     }
379   }
380   return();
381 }
382
383 =head2 get_typemap
384
385 Fetches an entry of the TYPEMAP section of the typemap.
386
387 Mandatory named arguments: The C<ctype> of the entry.
388
389 Returns the C<ExtUtils::Typemaps::Type>
390 object for the entry if found.
391
392 =cut
393
394 sub get_typemap {
395   my $self = shift;
396   my %args = @_;
397   my $ctype = $args{ctype};
398   croak("Need ctype argument") if not defined $ctype;
399   $ctype = _tidy_type($ctype);
400
401   my $index = $self->{typemap_lookup}{$ctype};
402   return() if not defined $index;
403   return $self->{typemap_section}[$index];
404 }
405
406 =head2 get_inputmap
407
408 Fetches an entry of the INPUT section of the
409 typemap.
410
411 Mandatory named arguments: The C<xstype> of the
412 entry.
413
414 Returns the C<ExtUtils::Typemaps::InputMap>
415 object for the entry if found.
416
417 =cut
418
419 sub get_inputmap {
420   my $self = shift;
421   my %args = @_;
422   my $xstype = $args{xstype};
423   croak("Need xstype argument") if not defined $xstype;
424
425   my $index = $self->{input_lookup}{$xstype};
426   return() if not defined $index;
427   return $self->{input_section}[$index];
428 }
429
430 =head2 get_outputmap
431
432 Fetches an entry of the OUTPUT section of the
433 typemap.
434
435 Mandatory named arguments: The C<xstype> of the
436 entry.
437
438 Returns the C<ExtUtils::Typemaps::InputMap>
439 object for the entry if found.
440
441 =cut
442
443 sub get_outputmap {
444   my $self = shift;
445   my %args = @_;
446   my $xstype = $args{xstype};
447   croak("Need xstype argument") if not defined $xstype;
448
449   my $index = $self->{output_lookup}{$xstype};
450   return() if not defined $index;
451   return $self->{output_section}[$index];
452 }
453
454 =head2 write
455
456 Write the typemap to a file. Optionally takes a C<file> argument. If given, the
457 typemap will be written to the specified file. If not, the typemap is written
458 to the currently stored file name (see C<-E<gt>file> above, this defaults to the file
459 it was read from if any).
460
461 =cut
462
463 sub write {
464   my $self = shift;
465   my %args = @_;
466   my $file = defined $args{file} ? $args{file} : $self->file();
467   croak("write() needs a file argument (or set the file name of the typemap using the 'file' method)")
468     if not defined $file;
469
470   open my $fh, '>', $file
471     or die "Cannot open typemap file '$file' for writing: $!";
472   print $fh $self->as_string();
473   close $fh;
474 }
475
476 =head2 as_string
477
478 Generates and returns the string form of the typemap.
479
480 =cut
481
482 sub as_string {
483   my $self = shift;
484   my $typemap = $self->{typemap_section};
485   my @code;
486   push @code, "TYPEMAP\n";
487   foreach my $entry (@$typemap) {
488     # type kind proto
489     # /^(.*?\S)\s+(\S+)\s*($ExtUtils::ParseXS::Constants::PrototypeRegexp*)$/o
490     push @code, $entry->ctype . "\t" . $entry->xstype
491               . ($entry->proto ne '' ? "\t".$entry->proto : '') . "\n";
492   }
493
494   my $input = $self->{input_section};
495   if (@$input) {
496     push @code, "\nINPUT\n";
497     foreach my $entry (@$input) {
498       push @code, $entry->xstype, "\n", $entry->code, "\n";
499     }
500   }
501
502   my $output = $self->{output_section};
503   if (@$output) {
504     push @code, "\nOUTPUT\n";
505     foreach my $entry (@$output) {
506       push @code, $entry->xstype, "\n", $entry->code, "\n";
507     }
508   }
509   return join '', @code;
510 }
511
512 =head2 merge
513
514 Merges a given typemap into the object. Note that a failed merge
515 operation leaves the object in an inconsistent state so clone it if necessary.
516
517 Mandatory named arguments: Either C<typemap =E<gt> $another_typemap_obj>
518 or C<file =E<gt> $path_to_typemap_file> but not both.
519
520 Optional argument: C<replace =E<gt> 1> to force replacement
521 of existing typemap entries without warning.
522
523 =cut
524
525 sub merge {
526   my $self = shift;
527   my %args = @_;
528
529   if (exists $args{typemap} and exists $args{file}) {
530     croak("Need {file} OR {typemap} argument. Not both!");
531   }
532   elsif (not exists $args{typemap} and not exists $args{file}) {
533     croak("Need {file} or {typemap} argument!");
534   }
535
536   my $typemap = $args{typemap};
537   if (not defined $typemap) {
538     $typemap = ref($self)->new(file => $args{file});
539   }
540
541   my $replace = $args{replace};
542
543   # FIXME breaking encapsulation. Add accessor code.
544   #
545   foreach my $entry (@{$typemap->{typemap_section}}) {
546     $self->add_typemap( $entry );
547   }
548
549   foreach my $entry (@{$typemap->{input_section}}) {
550     $self->add_inputmap( $entry );
551   }
552
553   foreach my $entry (@{$typemap->{output_section}}) {
554     $self->add_outputmap( $entry );
555   }
556
557   return 1;
558 }
559
560
561 =head2 _get_typemap_hash
562
563 Returns a hash mapping the C types to the XS types:
564
565   {
566     'char **' => 'T_PACKEDARRAY',
567     'bool_t' => 'T_IV',
568     'AV *' => 'T_AVREF',
569     'InputStream' => 'T_IN',
570     'double' => 'T_DOUBLE',
571     # ...
572   }
573
574 This is documented because it is used by C<ExtUtils::ParseXS>,
575 but it's not intended for general consumption. May be removed
576 at any time.
577
578 =cut
579
580 sub _get_typemap_hash {
581   my $self = shift;
582   my $lookup  = $self->{typemap_lookup};
583   my $storage = $self->{typemap_section};
584
585   my %rv;
586   foreach my $ctype (keys %$lookup) {
587     $rv{$ctype} = $storage->[ $lookup->{$ctype} ]->xstype;
588   }
589
590   return \%rv;
591 }
592
593 =head2 _get_inputmap_hash
594
595 Returns a hash mapping the XS types (identifiers) to the
596 corresponding INPUT code:
597
598   {
599     'T_CALLBACK' => '   $var = make_perl_cb_$type($arg)
600   ',
601     'T_OUT' => '    $var = IoOFP(sv_2io($arg))
602   ',
603     'T_REF_IV_PTR' => '   if (sv_isa($arg, \\"${ntype}\\")) {
604     # ...
605   }
606
607 This is documented because it is used by C<ExtUtils::ParseXS>,
608 but it's not intended for general consumption. May be removed
609 at any time.
610
611 =cut
612
613 sub _get_inputmap_hash {
614   my $self = shift;
615   my $lookup  = $self->{input_lookup};
616   my $storage = $self->{input_section};
617
618   my %rv;
619   foreach my $xstype (keys %$lookup) {
620     $rv{$xstype} = $storage->[ $lookup->{$xstype} ]->code;
621   }
622
623   return \%rv;
624 }
625
626
627 =head2 _get_outputmap_hash
628
629 Returns a hash mapping the XS types (identifiers) to the
630 corresponding OUTPUT code:
631
632   {
633     'T_CALLBACK' => '   sv_setpvn($arg, $var.context.value().chp(),
634                 $var.context.value().size());
635   ',
636     'T_OUT' => '    {
637             GV *gv = newGVgen("$Package");
638             if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
639                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
640             else
641                 $arg = &PL_sv_undef;
642          }
643   ',
644     # ...
645   }
646
647 This is documented because it is used by C<ExtUtils::ParseXS>,
648 but it's not intended for general consumption. May be removed
649 at any time.
650
651 =cut
652
653 sub _get_outputmap_hash {
654   my $self = shift;
655   my $lookup  = $self->{output_lookup};
656   my $storage = $self->{output_section};
657
658   my %rv;
659   foreach my $xstype (keys %$lookup) {
660     $rv{$xstype} = $storage->[ $lookup->{$xstype} ]->code;
661   }
662
663   return \%rv;
664 }
665
666 =head2 _get_prototype_hash
667
668 Returns a hash mapping the C types of the typemap to their
669 corresponding prototypes.
670
671   {
672     'char **' => '$',
673     'bool_t' => '$',
674     'AV *' => '$',
675     'InputStream' => '$',
676     'double' => '$',
677     # ...
678   }
679
680 This is documented because it is used by C<ExtUtils::ParseXS>,
681 but it's not intended for general consumption. May be removed
682 at any time.
683
684 =cut
685
686 sub _get_prototype_hash {
687   my $self = shift;
688   my $lookup  = $self->{typemap_lookup};
689   my $storage = $self->{typemap_section};
690
691   my %rv;
692   foreach my $ctype (keys %$lookup) {
693     $rv{$ctype} = $storage->[ $lookup->{$ctype} ]->proto || '$';
694   }
695
696   return \%rv;
697 }
698
699
700
701 # make sure that the provided types wouldn't collide with what's
702 # in the object already.
703 sub validate {
704   my $self = shift;
705   my %args = @_;
706
707   if ( exists $args{ctype}
708        and exists $self->{typemap_lookup}{_tidy_type($args{ctype})} )
709   {
710     croak("Multiple definition of ctype '$args{ctype}' in TYPEMAP section");
711   }
712
713   if ( exists $args{inputmap_xstype}
714        and exists $self->{input_lookup}{$args{inputmap_xstype}} )
715   {
716     croak("Multiple definition of xstype '$args{inputmap_xstype}' in INPUTMAP section");
717   }
718
719   if ( exists $args{outputmap_xstype}
720        and exists $self->{output_lookup}{$args{outputmap_xstype}} )
721   {
722     croak("Multiple definition of xstype '$args{outputmap_xstype}' in OUTPUTMAP section");
723   }
724
725   return 1;
726 }
727
728 sub _parse {
729   my $self = shift;
730   my $stringref = shift;
731   my $filename = shift;
732   $filename = '<string>' if not defined $filename;
733
734   # TODO comments should round-trip, currently ignoring
735   # TODO order of sections, multiple sections of same type
736   # Heavily influenced by ExtUtils::ParseXS
737   my $section = 'typemap';
738   my $lineno = 0;
739   my $junk = "";
740   my $current = \$junk;
741   my @input_expr;
742   my @output_expr;
743   while ($$stringref =~ /^(.*)$/gcm) {
744     local $_ = $1;
745     ++$lineno;
746     chomp;
747     next if /^\s*#/;
748     if (/^INPUT\s*$/) {
749       $section = 'input';
750       $current = \$junk;
751       next;
752     }
753     elsif (/^OUTPUT\s*$/) {
754       $section = 'output';
755       $current = \$junk;
756       next;
757     }
758     elsif (/^TYPEMAP\s*$/) {
759       $section = 'typemap';
760       $current = \$junk;
761       next;
762     }
763     
764     if ($section eq 'typemap') {
765       my $line = $_;
766       s/^\s+//; s/\s+$//;
767       next if /^#/ or /^$/;
768       my($type, $kind, $proto) = /^(.*?\S)\s+(\S+)\s*($ExtUtils::ParseXS::Constants::PrototypeRegexp*)$/o
769         or warn("Warning: File '$filename' Line $lineno '$line' TYPEMAP entry needs 2 or 3 columns\n"),
770            next;
771       #$proto = '' if not $proto;
772       # prototype defaults to '$'
773       #$proto = '$' unless $proto;
774       #warn("Warning: File '$filename' Line $lineno '$line' Invalid prototype '$proto'\n")
775       #  unless _valid_proto_string($proto);
776       $self->add_typemap(
777         ExtUtils::Typemaps::Type->new(
778           xstype => $kind, proto => $proto, ctype => $type
779         )
780       );
781     } elsif (/^\s/) {
782       $$current .= $$current eq '' ? $_ : "\n".$_;
783     } elsif (/^$/) {
784       next;
785     } elsif ($section eq 'input') {
786       s/\s+$//;
787       push @input_expr, {xstype => $_, code => ''};
788       $current = \$input_expr[-1]{code};
789     } else { # output section
790       s/\s+$//;
791       push @output_expr, {xstype => $_, code => ''};
792       $current = \$output_expr[-1]{code};
793     }
794
795   } # end while lines
796
797   foreach my $inexpr (@input_expr) {
798     $self->add_inputmap( ExtUtils::Typemaps::InputMap->new(%$inexpr) );
799   }
800   foreach my $outexpr (@output_expr) {
801     $self->add_outputmap( ExtUtils::Typemaps::OutputMap->new(%$outexpr) );
802   }
803
804   return 1;
805 }
806
807 # taken from ExtUtils::ParseXS
808 sub _tidy_type {
809   local $_ = shift;
810
811   # rationalise any '*' by joining them into bunches and removing whitespace
812   s#\s*(\*+)\s*#$1#g;
813   s#(\*+)# $1 #g ;
814
815   # trim leading & trailing whitespace
816   s/^\s+//; s/\s+$//;
817
818   # change multiple whitespace into a single space
819   s/\s+/ /g;
820
821   $_;
822 }
823
824
825 # taken from ExtUtils::ParseXS
826 sub _valid_proto_string {
827   my $string = shift;
828   if ($string =~ /^$ExtUtils::ParseXS::Constants::PrototypeRegexp+$/o) {
829     return $string;
830   }
831
832   return 0 ;
833 }
834
835 # taken from ExtUtils::ParseXS (C_string)
836 sub _escape_backslashes {
837   my $string = shift;
838   $string =~ s[\\][\\\\]g;
839   $string;
840 }
841
842 =head1 CAVEATS
843
844 Inherits some evil code from C<ExtUtils::ParseXS>.
845
846 =head1 SEE ALSO
847
848 The parser is heavily inspired from the one in L<ExtUtils::ParseXS>.
849
850 For details on typemaps: L<perlxstut>, L<perlxs>.
851
852 =head1 AUTHOR
853
854 Steffen Mueller C<<smueller@cpan.org>>
855
856 =head1 COPYRIGHT & LICENSE
857
858 Copyright 2009-2011 Steffen Mueller
859
860 This program is free software; you can redistribute it and/or
861 modify it under the same terms as Perl itself.
862
863 =cut
864
865 1;
866