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