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