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