This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Reinstate prototype default and warning about invalid prototypes
[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
665   return \%rv;
666 }
667
668
669 =head2 _get_outputmap_hash
670
671 Returns a hash mapping the XS types (identifiers) to the
672 corresponding OUTPUT code:
673
674   {
675     'T_CALLBACK' => '   sv_setpvn($arg, $var.context.value().chp(),
676                 $var.context.value().size());
677   ',
678     'T_OUT' => '    {
679             GV *gv = newGVgen("$Package");
680             if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
681                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
682             else
683                 $arg = &PL_sv_undef;
684          }
685   ',
686     # ...
687   }
688
689 This is documented because it is used by C<ExtUtils::ParseXS>,
690 but it's not intended for general consumption. May be removed
691 at any time.
692
693 =cut
694
695 sub _get_outputmap_hash {
696   my $self = shift;
697   my $lookup  = $self->{output_lookup};
698   my $storage = $self->{output_section};
699
700   my %rv;
701   foreach my $xstype (keys %$lookup) {
702     $rv{$xstype} = $storage->[ $lookup->{$xstype} ]->code;
703   }
704
705   return \%rv;
706 }
707
708 =head2 _get_prototype_hash
709
710 Returns a hash mapping the C types of the typemap to their
711 corresponding prototypes.
712
713   {
714     'char **' => '$',
715     'bool_t' => '$',
716     'AV *' => '$',
717     'InputStream' => '$',
718     'double' => '$',
719     # ...
720   }
721
722 This is documented because it is used by C<ExtUtils::ParseXS>,
723 but it's not intended for general consumption. May be removed
724 at any time.
725
726 =cut
727
728 sub _get_prototype_hash {
729   my $self = shift;
730   my $lookup  = $self->{typemap_lookup};
731   my $storage = $self->{typemap_section};
732
733   my %rv;
734   foreach my $ctype (keys %$lookup) {
735     $rv{$ctype} = $storage->[ $lookup->{$ctype} ]->proto || '$';
736   }
737
738   return \%rv;
739 }
740
741
742
743 # make sure that the provided types wouldn't collide with what's
744 # in the object already.
745 sub validate {
746   my $self = shift;
747   my %args = @_;
748
749   if ( exists $args{ctype}
750        and exists $self->{typemap_lookup}{_tidy_type($args{ctype})} )
751   {
752     croak("Multiple definition of ctype '$args{ctype}' in TYPEMAP section");
753   }
754
755   if ( exists $args{inputmap_xstype}
756        and exists $self->{input_lookup}{$args{inputmap_xstype}} )
757   {
758     croak("Multiple definition of xstype '$args{inputmap_xstype}' in INPUTMAP section");
759   }
760
761   if ( exists $args{outputmap_xstype}
762        and exists $self->{output_lookup}{$args{outputmap_xstype}} )
763   {
764     croak("Multiple definition of xstype '$args{outputmap_xstype}' in OUTPUTMAP section");
765   }
766
767   return 1;
768 }
769
770 sub _parse {
771   my $self = shift;
772   my $stringref = shift;
773   my $filename = shift;
774   $filename = '<string>' if not defined $filename;
775
776   # TODO comments should round-trip, currently ignoring
777   # TODO order of sections, multiple sections of same type
778   # Heavily influenced by ExtUtils::ParseXS
779   my $section = 'typemap';
780   my $lineno = 0;
781   my $junk = "";
782   my $current = \$junk;
783   my @input_expr;
784   my @output_expr;
785   while ($$stringref =~ /^(.*)$/gcm) {
786     local $_ = $1;
787     ++$lineno;
788     chomp;
789     next if /^\s*#/;
790     if (/^INPUT\s*$/) {
791       $section = 'input';
792       $current = \$junk;
793       next;
794     }
795     elsif (/^OUTPUT\s*$/) {
796       $section = 'output';
797       $current = \$junk;
798       next;
799     }
800     elsif (/^TYPEMAP\s*$/) {
801       $section = 'typemap';
802       $current = \$junk;
803       next;
804     }
805     
806     if ($section eq 'typemap') {
807       my $line = $_;
808       s/^\s+//; s/\s+$//;
809       next if /^#/ or /^$/;
810       my($type, $kind, $proto) = /^(.*?\S)\s+(\S+)\s*($ExtUtils::ParseXS::Constants::PrototypeRegexp*)$/o
811         or warn("Warning: File '$filename' Line $lineno '$line' TYPEMAP entry needs 2 or 3 columns\n"),
812            next;
813       # prototype defaults to '$'
814       $proto = '$' unless $proto;
815       warn("Warning: File '$filename' Line $lineno '$line' Invalid prototype '$proto'\n")
816         unless _valid_proto_string($proto);
817       $self->add_typemap(
818         ExtUtils::Typemaps::Type->new(
819           xstype => $kind, proto => $proto, ctype => $type
820         )
821       );
822     } elsif (/^\s/) {
823       $$current .= $$current eq '' ? $_ : "\n".$_;
824     } elsif (/^$/) {
825       next;
826     } elsif ($section eq 'input') {
827       s/\s+$//;
828       push @input_expr, {xstype => $_, code => ''};
829       $current = \$input_expr[-1]{code};
830     } else { # output section
831       s/\s+$//;
832       push @output_expr, {xstype => $_, code => ''};
833       $current = \$output_expr[-1]{code};
834     }
835
836   } # end while lines
837
838   foreach my $inexpr (@input_expr) {
839     $self->add_inputmap( ExtUtils::Typemaps::InputMap->new(%$inexpr) );
840   }
841   foreach my $outexpr (@output_expr) {
842     $self->add_outputmap( ExtUtils::Typemaps::OutputMap->new(%$outexpr) );
843   }
844
845   return 1;
846 }
847
848 # taken from ExtUtils::ParseXS
849 sub _tidy_type {
850   local $_ = shift;
851
852   # rationalise any '*' by joining them into bunches and removing whitespace
853   s#\s*(\*+)\s*#$1#g;
854   s#(\*+)# $1 #g ;
855
856   # trim leading & trailing whitespace
857   s/^\s+//; s/\s+$//;
858
859   # change multiple whitespace into a single space
860   s/\s+/ /g;
861
862   $_;
863 }
864
865
866 # taken from ExtUtils::ParseXS
867 sub _valid_proto_string {
868   my $string = shift;
869   if ($string =~ /^$ExtUtils::ParseXS::Constants::PrototypeRegexp+$/o) {
870     return $string;
871   }
872
873   return 0 ;
874 }
875
876 # taken from ExtUtils::ParseXS (C_string)
877 sub _escape_backslashes {
878   my $string = shift;
879   $string =~ s[\\][\\\\]g;
880   $string;
881 }
882
883 =head1 CAVEATS
884
885 Inherits some evil code from C<ExtUtils::ParseXS>.
886
887 =head1 SEE ALSO
888
889 The parser is heavily inspired from the one in L<ExtUtils::ParseXS>.
890
891 For details on typemaps: L<perlxstut>, L<perlxs>.
892
893 =head1 AUTHOR
894
895 Steffen Mueller C<<smueller@cpan.org>>
896
897 =head1 COPYRIGHT & LICENSE
898
899 Copyright 2009-2011 Steffen Mueller
900
901 This program is free software; you can redistribute it and/or
902 modify it under the same terms as Perl itself.
903
904 =cut
905
906 1;
907