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 if necessary.
 516
 517 Mandatory named argument: C<typemap =E<gt> $another_typemap>
 518
 519 Optional argument: C<replace =E<gt> 1> to force replacement
 520 of existing typemap entries without warning.
 521
 522 =cut
 523
 524 sub merge {
 525   my $self = shift;
 526   my %args = @_;
 527   my $typemap = $args{typemap};
 528   croak("Need ExtUtils::Typemaps as argument")
 529     if not ref $typemap or not $typemap->isa('ExtUtils::Typemaps');
 530
 531   my $replace = $args{replace};
 532
 533   # FIXME breaking encapsulation. Add accessor code.
 534   #
 535   foreach my $entry (@{$typemap->{typemap_section}}) {
 536     $self->add_typemap( $entry );
 537   }
 538
 539   foreach my $entry (@{$typemap->{input_section}}) {
 540     $self->add_inputmap( $entry );
 541   }
 542
 543   foreach my $entry (@{$typemap->{output_section}}) {
 544     $self->add_outputmap( $entry );
 545   }
 546
 547   return 1;
 548 }
 549
 550
 551 =head2 _get_typemap_hash
 552
 553 Returns a hash mapping the C types to the XS types:
 554
 555   {
 556     'char **' => 'T_PACKEDARRAY',
 557     'bool_t' => 'T_IV',
 558     'AV *' => 'T_AVREF',
 559     'InputStream' => 'T_IN',
 560     'double' => 'T_DOUBLE',
 561     # ...
 562   }
 563
 564 This is documented because it is used by C<ExtUtils::ParseXS>,
 565 but it's not intended for general consumption. May be removed
 566 at any time.
 567
 568 =cut
 569
 570 sub _get_typemap_hash {
 571   my $self = shift;
 572   my $lookup  = $self->{typemap_lookup};
 573   my $storage = $self->{typemap_section};
 574
 575   my %rv;
 576   foreach my $ctype (keys %$lookup) {
 577     $rv{$ctype} = $storage->[ $lookup->{$ctype} ]->xstype;
 578   }
 579
 580   return \%rv;
 581 }
 582
 583 =head2 _get_inputmap_hash
 584
 585 Returns a hash mapping the XS types (identifiers) to the
 586 corresponding INPUT code:
 587
 588   {
 589     'T_CALLBACK' => '   $var = make_perl_cb_$type($arg)
 590   ',
 591     'T_OUT' => '    $var = IoOFP(sv_2io($arg))
 592   ',
 593     'T_REF_IV_PTR' => '   if (sv_isa($arg, \\"${ntype}\\")) {
 594     # ...
 595   }
 596
 597 This is documented because it is used by C<ExtUtils::ParseXS>,
 598 but it's not intended for general consumption. May be removed
 599 at any time.
 600
 601 =cut
 602
 603 sub _get_inputmap_hash {
 604   my $self = shift;
 605   my $lookup  = $self->{input_lookup};
 606   my $storage = $self->{input_section};
 607
 608   my %rv;
 609   foreach my $xstype (keys %$lookup) {
 610     $rv{$xstype} = $storage->[ $lookup->{$xstype} ]->code;
 611   }
 612
 613   return \%rv;
 614 }
 615
 616
 617 =head2 _get_outputmap_hash
 618
 619 Returns a hash mapping the XS types (identifiers) to the
 620 corresponding OUTPUT code:
 621
 622   {
 623     'T_CALLBACK' => '   sv_setpvn($arg, $var.context.value().chp(),
 624                 $var.context.value().size());
 625   ',
 626     'T_OUT' => '    {
 627             GV *gv = newGVgen("$Package");
 628             if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
 629                 sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
 630             else
 631                 $arg = &PL_sv_undef;
 632          }
 633   ',
 634     # ...
 635   }
 636
 637 This is documented because it is used by C<ExtUtils::ParseXS>,
 638 but it's not intended for general consumption. May be removed
 639 at any time.
 640
 641 =cut
 642
 643 sub _get_outputmap_hash {
 644   my $self = shift;
 645   my $lookup  = $self->{output_lookup};
 646   my $storage = $self->{output_section};
 647
 648   my %rv;
 649   foreach my $xstype (keys %$lookup) {
 650     $rv{$xstype} = $storage->[ $lookup->{$xstype} ]->code;
 651   }
 652
 653   return \%rv;
 654 }
 655
 656
 657
 658
 659 # make sure that the provided types wouldn't collide with what's
 660 # in the object already.
 661 sub validate {
 662   my $self = shift;
 663   my %args = @_;
 664
 665   if ( exists $args{ctype}
 666        and exists $self->{typemap_lookup}{_tidy_type($args{ctype})} )
 667   {
 668     croak("Multiple definition of ctype '$args{ctype}' in TYPEMAP section");
 669   }
 670
 671   if ( exists $args{inputmap_xstype}
 672        and exists $self->{input_lookup}{$args{inputmap_xstype}} )
 673   {
 674     croak("Multiple definition of xstype '$args{inputmap_xstype}' in INPUTMAP section");
 675   }
 676
 677   if ( exists $args{outputmap_xstype}
 678        and exists $self->{output_lookup}{$args{outputmap_xstype}} )
 679   {
 680     croak("Multiple definition of xstype '$args{outputmap_xstype}' in OUTPUTMAP section");
 681   }
 682
 683   return 1;
 684 }
 685
 686 sub _parse {
 687   my $self = shift;
 688   my $stringref = shift;
 689   my $filename = shift;
 690   $filename = '<string>' if not defined $filename;
 691
 692   # TODO comments should round-trip, currently ignoring
 693   # TODO order of sections, multiple sections of same type
 694   # Heavily influenced by ExtUtils::ParseXS
 695   my $section = 'typemap';
 696   my $lineno = 0;
 697   my $junk = "";
 698   my $current = \$junk;
 699   my @input_expr;
 700   my @output_expr;
 701   while ($$stringref =~ /^(.*)$/gcm) {
 702     local $_ = $1;
 703     ++$lineno;
 704     chomp;
 705     next if /^\s*#/;
 706     if (/^INPUT\s*$/) {
 707       $section = 'input';
 708       $current = \$junk;
 709       next;
 710     }
 711     elsif (/^OUTPUT\s*$/) {
 712       $section = 'output';
 713       $current = \$junk;
 714       next;
 715     }
 716     elsif (/^TYPEMAP\s*$/) {
 717       $section = 'typemap';
 718       $current = \$junk;
 719       next;
 720     }
 721
 722     if ($section eq 'typemap') {
 723       my $line = $_;
 724       s/^\s+//; s/\s+$//;
 725       next if /^#/ or /^$/;
 726       my($type, $kind, $proto) = /^(.*?\S)\s+(\S+)\s*($ExtUtils::ParseXS::Constants::PrototypeRegexp*)$/o
 727         or warn("Warning: File '$filename' Line $lineno '$line' TYPEMAP entry needs 2 or 3 columns\n"),
 728            next;
 729       #$proto = '' if not $proto;
 730       # prototype defaults to '$'
 731       #$proto = '$' unless $proto;
 732       #warn("Warning: File '$filename' Line $lineno '$line' Invalid prototype '$proto'\n")
 733       #  unless _valid_proto_string($proto);
 734       $self->add_typemap(
 735         ExtUtils::Typemaps::Type->new(
 736           xstype => $kind, proto => $proto, ctype => $type
 737         )
 738       );
 739     } elsif (/^\s/) {
 740       $$current .= $$current eq '' ? $_ : "\n".$_;
 741     } elsif (/^$/) {
 742       next;
 743     } elsif ($section eq 'input') {
 744       s/\s+$//;
 745       push @input_expr, {xstype => $_, code => ''};
 746       $current = \$input_expr[-1]{code};
 747     } else { # output section
 748       s/\s+$//;
 749       push @output_expr, {xstype => $_, code => ''};
 750       $current = \$output_expr[-1]{code};
 751     }
 752
 753   } # end while lines
 754
 755   foreach my $inexpr (@input_expr) {
 756     $self->add_inputmap( ExtUtils::Typemaps::InputMap->new(%$inexpr) );
 757   }
 758   foreach my $outexpr (@output_expr) {
 759     $self->add_outputmap( ExtUtils::Typemaps::OutputMap->new(%$outexpr) );
 760   }
 761
 762   return 1;
 763 }
 764
 765 # taken from ExtUtils::ParseXS
 766 sub _tidy_type {
 767   local $_ = shift;
 768
 769   # rationalise any '*' by joining them into bunches and removing whitespace
 770   s#\s*(\*+)\s*#$1#g;
 771   s#(\*+)# $1 #g ;
 772
 773   # trim leading & trailing whitespace
 774   s/^\s+//; s/\s+$//;
 775
 776   # change multiple whitespace into a single space
 777   s/\s+/ /g;
 778
 779   $_;
 780 }
 781
 782
 783 # taken from ExtUtils::ParseXS
 784 sub _valid_proto_string {
 785   my $string = shift;
 786   if ($string =~ /^$ExtUtils::ParseXS::Constants::PrototypeRegexp+$/o) {
 787     return $string;
 788   }
 789
 790   return 0 ;
 791 }
 792
 793 # taken from ExtUtils::ParseXS (C_string)
 794 sub _escape_backslashes {
 795   my $string = shift;
 796   $string =~ s[\\][\\\\]g;
 797   $string;
 798 }
 799
 800 =head1 CAVEATS
 801
 802 Inherits some evil code from C<ExtUtils::ParseXS>.
 803
 804 =head1 SEE ALSO
 805
 806 The parser is heavily inspired from the one in L<ExtUtils::ParseXS>.
 807
 808 For details on typemaps: L<perlxstut>, L<perlxs>.
 809
 810 =head1 AUTHOR
 811
 812 Steffen Mueller C<<smueller@cpan.org>>
 813
 814 =head1 COPYRIGHT & LICENSE
 815
 816 Copyright 2009-2011 Steffen Mueller
 817
 818 This program is free software; you can redistribute it and/or
 819 modify it under the same terms as Perl itself.
 820
 821 =cut
 822
 823 1;
 824