[p5sagit/p5-mst-13.2.git] / ext / Devel-PPPort / PPPort_pm.PL

################################################################################
#
#  PPPort_pm.PL -- generate PPPort.pm
#
################################################################################
#
#  $Revision: 64 $
#  $Author: mhx $
#  $Date: 2009/01/18 14:10:49 +0100 $
#
################################################################################
#
#  Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz.
#  Version 2.x, Copyright (C) 2001, Paul Marquess.
#  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
#  This program is free software; you can redistribute it and/or
#  modify it under the same terms as Perl itself.
#
################################################################################

use strict;
$^W = 1;
require "parts/ppptools.pl";

my $INCLUDE = 'parts/inc';
my $DPPP = 'DPPP_';

my %embed = map { ( $_->{name} => $_ ) }
            parse_embed(qw(parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc));

my(%provides, %prototypes, %explicit);

my $data = do { local $/; <DATA> };
$data =~ s{^\%(include)\s+(\w+)((?:[^\S\r\n]+.*?)?)\s*$}
          {eval "$1('$2', $3)" or die $@}gem;

$data = expand($data);

my @api = sort { lc $a cmp lc $b } keys %provides;

$data =~ s{^(.*)__PROVIDED_API__(\s*?)^}
          {join '', map "$1$_\n", @api}gem;

{
  my $len = 0;
  for (keys %explicit) {
    length > $len and $len = length;
  }
  my $format = sprintf '%%-%ds  %%-%ds  %%s', $len+2, $len+5;
  $len = 3*$len + 23;

$data =~ s!^(.*)__EXPLICIT_API__(\s*?)^!
           sprintf("$1$format\n", 'Function / Variable', 'Static Request', 'Global Request') .
           $1 . '-'x$len . "\n" .
           join('', map { sprintf "$1$format\n", $explicit{$_} eq 'var' ? $_ : "$_()", "NEED_$_", "NEED_${_}_GLOBAL" }
                    sort keys %explicit)
          !gem;
}

my %raw_base = %{&parse_todo('parts/base')};
my %raw_todo = %{&parse_todo('parts/todo')};

my %todo;
for (keys %raw_todo) {
  push @{$todo{$raw_todo{$_}}}, $_;
}

# check consistency
for (@api) {
  if (exists $raw_todo{$_} and exists $raw_base{$_}) {
    if ($raw_base{$_} eq $raw_todo{$_}) {
      warn "$INCLUDE/$provides{$_} provides $_, which is still marked "
           . "todo for " . format_version($raw_todo{$_}) . "\n";
    }
    else {
      check(2, "$_ was ported back to " . format_version($raw_todo{$_}) .
               " (baseline revision: " . format_version($raw_base{$_}) . ").");
    }
  }
}

my @perl_api;
for (keys %provides) {
  next if /^Perl_(.*)/ && exists $embed{$1};
  next if exists $embed{$_};
  push @perl_api, $_;
  check(2, "No API definition for provided element $_ found.");
}

push @perl_api, keys %embed;

for (@perl_api) {
  if (exists $provides{$_} && !exists $raw_base{$_}) {
    check(2, "Mmmh, $_ doesn't seem to need backporting.");
  }
  my $line = "$_|" . (exists $provides{$_} && exists $raw_base{$_} ? $raw_base{$_} : '') . '|';
  $line .= ($raw_todo{$_} || '') . '|';
  $line .= 'p' if exists $provides{$_};
  if (exists $embed{$_}) {
    my $e = $embed{$_};
    if (exists $e->{flags}{p}) {
      my $args = $e->{args};
      $line .= 'v' if @$args && $args->[-1][0] eq '...';
    }
    $line .= 'n' if exists $e->{flags}{n};
  }
  $_ = $line;
}

$data =~ s/^([\t ]*)__PERL_API__(\s*?)$/
           join "\n", map "$1$_", sort @perl_api
          /gem;

my @todo;
for (reverse sort keys %todo) {
  my $ver = format_version($_);
  my $todo = "=item perl $ver\n\n";
  for (sort @{$todo{$_}}) {
    $todo .= "  $_\n";
  }
  push @todo, $todo;
}

$data =~ s{^__UNSUPPORTED_API__(\s*?)^}
          {join "\n", @todo}gem;

$data =~ s{__MIN_PERL__}{5.003}g;
$data =~ s{__MAX_PERL__}{5.10.0}g;

open FH, ">PPPort.pm" or die "PPPort.pm: $!\n";
print FH $data;
close FH;

exit 0;

sub include
{
  my($file, $opt) = @_;

  print "including $file\n";

  my $data = parse_partspec("$INCLUDE/$file");

  for (@{$data->{provides}}) {
    if (exists $provides{$_}) {
      if ($provides{$_} ne $file) {
        warn "$file: $_ already provided by $provides{$_}\n";
      }
    }
    else {
      $provides{$_} = $file;
    }
  }

  for (keys %{$data->{prototypes}}) {
    $prototypes{$_} = $data->{prototypes}{$_};
    $data->{implementation} =~ s/^$_(?=\s*\()/$DPPP(my_$_)/mg;
  }

  my $out = $data->{implementation};

  if (exists $opt->{indent}) {
    $out =~ s/^/$opt->{indent}/gm;
  }

  return $out;
}

sub expand
{
  my $code = shift;
  $code =~ s{^(\s*#\s*(?:el)?if\s+)(.*)$}{$1.expand_pp_expressions($2)}gem;
  $code =~ s{^\s*
              __UNDEFINED__
              \s+
              (
                ( \w+ )
                (?: \( [^)]* \) )?
              )
              [^\r\n\S]*
              (
                (?:[^\r\n\\]|\\[^\r\n])*
                (?:
                  \\
                  (?:\r\n|[\r\n])
                  (?:[^\r\n\\]|\\[^\r\n])*
                )*
              )
            \s*$}
            {expand_undefined($2, $1, $3)}gemx;
  $code =~ s{^([^\S\r\n]*)__NEED_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$}
            {expand_need_var($1, $3, $2, $4)}gem;
  $code =~ s{^([^\S\r\n]*)__NEED_DUMMY_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$}
            {expand_need_dummy_var($1, $3, $2, $4)}gem;
  return $code;
}

sub expand_need_var
{
  my($indent, $var, $type, $init) = @_;

  $explicit{$var} = 'var';

  my $myvar = "$DPPP(my_$var)";
  $init = defined $init ? " = $init" : "";

  my $code = <<ENDCODE;
#if defined(NEED_$var)
static $type $myvar$init;
#elif defined(NEED_${var}_GLOBAL)
$type $myvar$init;
#else
extern $type $myvar;
#endif
#define $var $myvar
ENDCODE

  $code =~ s/^/$indent/mg;

  return $code;
}

sub expand_need_dummy_var
{
  my($indent, $var, $type, $init) = @_;

  $explicit{$var} = 'var';

  my $myvar = "$DPPP(dummy_$var)";
  $init = defined $init ? " = $init" : "";

  my $code = <<ENDCODE;
#if defined(NEED_$var)
static $type $myvar$init;
#elif defined(NEED_${var}_GLOBAL)
$type $myvar$init;
#else
extern $type $myvar;
#endif
ENDCODE

  $code =~ s/^/$indent/mg;

  return $code;
}

sub expand_undefined
{
  my($macro, $withargs, $def) = @_;
  my $rv = "#ifndef $macro\n#  define ";

  if (defined $def && $def =~ /\S/) {
    $rv .= sprintf "%-30s %s", $withargs, $def;
  }
  else {
    $rv .= $withargs;
  }

  $rv .= "\n#endif\n";

  return $rv;
}

sub expand_pp_expressions
{
  my $pp = shift;
  $pp =~ s/\{([^\}]+)\}/expand_pp_expr($1)/ge;
  return $pp;
}

sub expand_pp_expr
{
  my $expr = shift;

  if ($expr =~ /^\s*need\s+(\w+)\s*$/i) {
    my $func = $1;
    my $e = $embed{$func} or die "unknown API function '$func' in NEED\n";
    my $proto = make_prototype($e);
    if (exists $prototypes{$func}) {
      if (compare_prototypes($proto, $prototypes{$func})) {
        check(1, "differing prototypes for $func:\n  API: $proto\n  PPP: $prototypes{$func}");
        $proto = $prototypes{$func};
      }
    }
    else {
      warn "found no prototype for $func\n";;
    }

    $explicit{$func} = 'func';

    $proto =~ s/\b$func(?=\s*\()/$DPPP(my_$func)/;
    my $embed = make_embed($e);

    return "defined(NEED_$func)\n"
         . "static $proto;\n"
         . "static\n"
         . "#else\n"
         . "extern $proto;\n"
         . "#endif\n"
         . "\n"
         . "$embed\n"
         . "\n"
         . "#if defined(NEED_$func) || defined(NEED_${func}_GLOBAL)";
  }

  die "cannot expand preprocessor expression '$expr'\n";
}

sub make_embed
{
  my $f = shift;
  my $n = $f->{name};
  my $a = do { my $x = 'a'; join ',', map { $x++ } 1 .. @{$f->{args}} };
  my $lastarg = ${$f->{args}}[-1];

  if ($f->{flags}{n}) {
    if ($f->{flags}{p}) {
      return "#define $n $DPPP(my_$n)\n" .
             "#define Perl_$n $DPPP(my_$n)";
    }
    else {
      return "#define $n $DPPP(my_$n)";
    }
  }
  else {
    my $undef = <<UNDEF;
#ifdef $n
#  undef $n
#endif
UNDEF
    if ($f->{flags}{p}) {
      if ($f->{flags}{f}) {
        return "#define Perl_$n $DPPP(my_$n)";
      }
      elsif (@$lastarg && $lastarg->[0] =~ /\.\.\./) {
        return $undef . "#define $n $DPPP(my_$n)\n" .
                        "#define Perl_$n $DPPP(my_$n)";
      }
      else {
        return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)\n" .
                        "#define Perl_$n $DPPP(my_$n)";
      }
    }
    else {
      return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)";
    }
  }
}

sub check
{
  my $level = shift;

  if (exists $ENV{DPPP_CHECK_LEVEL} and $ENV{DPPP_CHECK_LEVEL} >= $level) {
    print STDERR @_, "\n";
  }
}

__DATA__
################################################################################
#
#  !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
#
#  This file was automatically generated from the definition files in the
#  parts/inc/ subdirectory by PPPort_pm.PL. To learn more about how all this
#  works, please read the F<HACKERS> file that came with this distribution.
#
################################################################################
#
#  Perl/Pollution/Portability
#
################################################################################
#
#  $Revision: 64 $
#  $Author: mhx $
#  $Date: 2009/01/18 14:10:49 +0100 $
#
################################################################################
#
#  Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz.
#  Version 2.x, Copyright (C) 2001, Paul Marquess.
#  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
#  This program is free software; you can redistribute it and/or
#  modify it under the same terms as Perl itself.
#
################################################################################

=head1 NAME

Devel::PPPort - Perl/Pollution/Portability

=head1 SYNOPSIS

    Devel::PPPort::WriteFile();   # defaults to ./ppport.h
    Devel::PPPort::WriteFile('someheader.h');

=head1 DESCRIPTION

Perl's API has changed over time, gaining new features, new functions,
increasing its flexibility, and reducing the impact on the C namespace
environment (reduced pollution). The header file written by this module,
typically F<ppport.h>, attempts to bring some of the newer Perl API
features to older versions of Perl, so that you can worry less about
keeping track of old releases, but users can still reap the benefit.

C<Devel::PPPort> contains a single function, called C<WriteFile>. Its
only purpose is to write the F<ppport.h> C header file. This file
contains a series of macros and, if explicitly requested, functions that
allow XS modules to be built using older versions of Perl. Currently,
Perl versions from __MIN_PERL__ to __MAX_PERL__ are supported.

This module is used by C<h2xs> to write the file F<ppport.h>.

=head2 Why use ppport.h?

You should use F<ppport.h> in modern code so that your code will work
with the widest range of Perl interpreters possible, without significant
additional work.

You should attempt older code to fully use F<ppport.h>, because the
reduced pollution of newer Perl versions is an important thing. It's so
important that the old polluting ways of original Perl modules will not be
supported very far into the future, and your module will almost certainly
break! By adapting to it now, you'll gain compatibility and a sense of
having done the electronic ecology some good.

=head2 How to use ppport.h

Don't direct the users of your module to download C<Devel::PPPort>.
They are most probably no XS writers. Also, don't make F<ppport.h>
optional. Rather, just take the most recent copy of F<ppport.h> that
you can find (e.g. by generating it with the latest C<Devel::PPPort>
release from CPAN), copy it into your project, adjust your project to
use it, and distribute the header along with your module.

=head2 Running ppport.h

But F<ppport.h> is more than just a C header. It's also a Perl script
that can check your source code. It will suggest hints and portability
notes, and can even make suggestions on how to change your code. You
can run it like any other Perl program:

    perl ppport.h [options] [files]

It also has embedded documentation, so you can use

    perldoc ppport.h

to find out more about how to use it.

=head1 FUNCTIONS

=head2 WriteFile

C<WriteFile> takes one optional argument. When called with one
argument, it expects to be passed a filename. When called with
no arguments, it defaults to the filename F<ppport.h>.

The function returns a true value if the file was written successfully.
Otherwise it returns a false value.

=head1 COMPATIBILITY

F<ppport.h> supports Perl versions from __MIN_PERL__ to __MAX_PERL__
in threaded and non-threaded configurations.

=head2 Provided Perl compatibility API

The header file written by this module, typically F<ppport.h>, provides
access to the following elements of the Perl API that is not available
in older Perl releases:

    __PROVIDED_API__

=head2 Perl API not supported by ppport.h

There is still a big part of the API not supported by F<ppport.h>.
Either because it doesn't make sense to back-port that part of the API,
or simply because it hasn't been implemented yet. Patches welcome!

Here's a list of the currently unsupported API, and also the version of
Perl below which it is unsupported:

=over 4

__UNSUPPORTED_API__

=back

=head1 BUGS

If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
system or any of its tests fail, please use the CPAN Request Tracker
at L<http://rt.cpan.org/> to create a ticket for the module.

=head1 AUTHORS

=over 2

=item *

Version 1.x of Devel::PPPort was written by Kenneth Albanowski.

=item *

Version 2.x was ported to the Perl core by Paul Marquess.

=item *

Version 3.x was ported back to CPAN by Marcus Holland-Moritz.

=back

=head1 COPYRIGHT

Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz.

Version 2.x, Copyright (C) 2001, Paul Marquess.

Version 1.x, Copyright (C) 1999, Kenneth Albanowski.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

See L<h2xs>, L<ppport.h>.

=cut

package Devel::PPPort;

use strict;
use vars qw($VERSION $data);

$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.16 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };

sub _init_data
{
  $data = do { local $/; <DATA> };
  my $pkg = 'Devel::PPPort';
  $data =~ s/__PERL_VERSION__/$]/g;
  $data =~ s/__VERSION__/$VERSION/g;
  $data =~ s/__PKG__/$pkg/g;
  $data =~ s/^\|>//gm;
}

sub WriteFile
{
  my $file = shift || 'ppport.h';
  defined $data or _init_data();
  my $copy = $data;
  $copy =~ s/\bppport\.h\b/$file/g;

  open F, ">$file" or return undef;
  print F $copy;
  close F;

  return 1;
}

1;

__DATA__
#if 0
<<'SKIP';
#endif
/*
----------------------------------------------------------------------

    ppport.h -- Perl/Pollution/Portability Version __VERSION__

    Automatically created by __PKG__ running under perl __PERL_VERSION__.

    Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
    includes in parts/inc/ instead.

    Use 'perldoc ppport.h' to view the documentation below.

----------------------------------------------------------------------

SKIP

%include ppphdoc { indent => '|>' }

%include ppphbin

__DATA__
*/

#ifndef _P_P_PORTABILITY_H_
#define _P_P_PORTABILITY_H_

#ifndef DPPP_NAMESPACE
#  define DPPP_NAMESPACE DPPP_
#endif

#define DPPP_CAT2(x,y) CAT2(x,y)
#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)

%include version

%include threads

%include limits

%include uv

%include memory

%include misc

%include variables

%include mPUSH

%include call

%include newRV

%include newCONSTSUB

%include MY_CXT

%include format

%include SvREFCNT

%include newSVpv

%include SvPV

%include Sv_set

%include sv_xpvf

%include shared_pv

%include warn

%include pvs

%include magic

%include cop

%include grok

%include snprintf

%include sprintf

%include exception

%include strlfuncs

%include pv_tools

#endif /* _P_P_PORTABILITY_H_ */

/* End of File ppport.h */
Commit	Line	Data
adfe19db	1	################################################################################
	2	#
	3	# PPPort_pm.PL -- generate PPPort.pm
	4	#
	5	################################################################################
	6	#
51d6c659	7	# $Revision: 64 $
adfe19db	8	# $Author: mhx $
51d6c659	9	# $Date: 2009/01/18 14:10:49 +0100 $
adfe19db	10	#
	11	################################################################################
	12	#
51d6c659	13	# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz.
adfe19db	14	# Version 2.x, Copyright (C) 2001, Paul Marquess.
	15	# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
	16	#
	17	# This program is free software; you can redistribute it and/or
	18	# modify it under the same terms as Perl itself.
	19	#
	20	################################################################################
	21
	22	use strict;
	23	$^W = 1;
	24	require "parts/ppptools.pl";
	25
	26	my $INCLUDE = 'parts/inc';
	27	my $DPPP = 'DPPP_';
	28
	29	my %embed = map { ( $_->{name} => $_ ) }
679ad62d	30	parse_embed(qw(parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc));
adfe19db	31
	32	my(%provides, %prototypes, %explicit);
	33
	34	my $data = do { local $/; <DATA> };
	35	$data =~ s{^\%(include)\s+(\w+)((?:[^\S\r\n]+.?)?)\s$}
	36	{eval "$1('$2', $3)" or die $@}gem;
	37
	38	$data = expand($data);
	39
	40	my @api = sort { lc $a cmp lc $b } keys %provides;
	41
	42	$data =~ s{^(.)__PROVIDED_API__(\s?)^}
	43	{join '', map "$1$_\n", @api}gem;
	44
	45	{
	46	my $len = 0;
	47	for (keys %explicit) {
	48	length > $len and $len = length;
	49	}
4a582685	50	my $format = sprintf '%%-%ds %%-%ds %%s', $len+2, $len+5;
adfe19db	51	$len = 3*$len + 23;
adfe19db	52
0d0f8426	53	$data =~ s!^(.)__EXPLICIT_API__(\s?)^!
0d0f8426	54	sprintf("$1$format\n", 'Function / Variable', 'Static Request', 'Global Request') .
adfe19db	55	$1 . '-'x$len . "\n" .
0d0f8426	56	join('', map { sprintf "$1$format\n", $explicit{$_} eq 'var' ? $_ : "$_()", "NEED_$_", "NEED_${_}_GLOBAL" }
adfe19db	57	sort keys %explicit)
0d0f8426	58	!gem;
adfe19db	59	}
	60
	61	my %raw_base = %{&parse_todo('parts/base')};
	62	my %raw_todo = %{&parse_todo('parts/todo')};
	63
	64	my %todo;
	65	for (keys %raw_todo) {
	66	push @{$todo{$raw_todo{$_}}}, $_;
	67	}
	68
	69	# check consistency
	70	for (@api) {
56093a11	71	if (exists $raw_todo{$_} and exists $raw_base{$_}) {
96ad942f	72	if ($raw_base{$_} eq $raw_todo{$_}) {
	73	warn "$INCLUDE/$provides{$_} provides $_, which is still marked "
	74	. "todo for " . format_version($raw_todo{$_}) . "\n";
	75	}
	76	else {
	77	check(2, "$_ was ported back to " . format_version($raw_todo{$_}) .
	78	" (baseline revision: " . format_version($raw_base{$_}) . ").");
	79	}
adfe19db	80	}
	81	}
	82
	83	my @perl_api;
	84	for (keys %provides) {
aab9a3b6	85	next if /^Perl_(.*)/ && exists $embed{$1};
adfe19db	86	next if exists $embed{$_};
	87	push @perl_api, $_;
	88	check(2, "No API definition for provided element $_ found.");
	89	}
	90
	91	push @perl_api, keys %embed;
	92
	93	for (@perl_api) {
	94	if (exists $provides{$_} && !exists $raw_base{$_}) {
	95	check(2, "Mmmh, $_ doesn't seem to need backporting.");
	96	}
	97	my $line = "$_\|" . (exists $provides{$_} && exists $raw_base{$_} ? $raw_base{$_} : '') . '\|';
	98	$line .= ($raw_todo{$_} \|\| '') . '\|';
	99	$line .= 'p' if exists $provides{$_};
	100	if (exists $embed{$_}) {
	101	my $e = $embed{$_};
	102	if (exists $e->{flags}{p}) {
	103	my $args = $e->{args};
	104	$line .= 'v' if @$args && $args->[-1][0] eq '...';
	105	}
	106	$line .= 'n' if exists $e->{flags}{n};
	107	}
	108	$_ = $line;
	109	}
	110
	111	$data =~ s/^([\t ])__PERL_API__(\s?)$/
	112	join "\n", map "$1$_", sort @perl_api
	113	/gem;
	114
	115	my @todo;
	116	for (reverse sort keys %todo) {
	117	my $ver = format_version($_);
	118	my $todo = "=item perl $ver\n\n";
	119	for (sort @{$todo{$_}}) {
	120	$todo .= " $_\n";
	121	}
	122	push @todo, $todo;
	123	}
	124
	125	$data =~ s{^__UNSUPPORTED_API__(\s*?)^}
	126	{join "\n", @todo}gem;
	127
	128	$data =~ s{__MIN_PERL__}{5.003}g;
aab9a3b6	129	$data =~ s{__MAX_PERL__}{5.10.0}g;
adfe19db	130
	131	open FH, ">PPPort.pm" or die "PPPort.pm: $!\n";
	132	print FH $data;
	133	close FH;
	134
	135	exit 0;
	136
	137	sub include
	138	{
	139	my($file, $opt) = @_;
	140
	141	print "including $file\n";
	142
	143	my $data = parse_partspec("$INCLUDE/$file");
	144
	145	for (@{$data->{provides}}) {
	146	if (exists $provides{$_}) {
	147	if ($provides{$_} ne $file) {
	148	warn "$file: $_ already provided by $provides{$_}\n";
	149	}
	150	}
	151	else {
	152	$provides{$_} = $file;
	153	}
	154	}
	155
	156	for (keys %{$data->{prototypes}}) {
	157	$prototypes{$_} = $data->{prototypes}{$_};
96ad942f	158	$data->{implementation} =~ s/^$_(?=\s*\()/$DPPP(my_$_)/mg;
adfe19db	159	}
	160
	161	my $out = $data->{implementation};
	162
	163	if (exists $opt->{indent}) {
	164	$out =~ s/^/$opt->{indent}/gm;
	165	}
	166
	167	return $out;
	168	}
	169
	170	sub expand
	171	{
	172	my $code = shift;
	173	$code =~ s{^(\s#\s(?:el)?if\s+)(.*)$}{$1.expand_pp_expressions($2)}gem;
	174	$code =~ s{^\s*
	175	__UNDEFINED__
	176	\s+
	177	(
	178	( \w+ )
	179	(?: \( [^)]* \) )?
	180	)
	181	[^\r\n\S]*
	182	(
	183	(?:[^\r\n\\]\|\\[^\r\n])*
	184	(?:
	185	\\
	186	(?:\r\n\|[\r\n])
	187	(?:[^\r\n\\]\|\\[^\r\n])*
	188	)*
	189	)
	190	\s*$}
	191	{expand_undefined($2, $1, $3)}gemx;
c01be2ce	192	$code =~ s{^([^\S\r\n])__NEED_VAR__\s+(.?)\s+(\w+)(?:\s=\s([^;]+?))?\s;\s$}
0d0f8426	193	{expand_need_var($1, $3, $2, $4)}gem;
c01be2ce	194	$code =~ s{^([^\S\r\n])__NEED_DUMMY_VAR__\s+(.?)\s+(\w+)(?:\s=\s([^;]+?))?\s;\s$}
c01be2ce	195	{expand_need_dummy_var($1, $3, $2, $4)}gem;
0d0f8426	196	return $code;
	197	}
	198
	199	sub expand_need_var
	200	{
	201	my($indent, $var, $type, $init) = @_;
	202
	203	$explicit{$var} = 'var';
	204
	205	my $myvar = "$DPPP(my_$var)";
c01be2ce	206	$init = defined $init ? " = $init" : "";
0d0f8426	207
	208	my $code = <<ENDCODE;
	209	#if defined(NEED_$var)
c01be2ce	210	static $type $myvar$init;
0d0f8426	211	#elif defined(NEED_${var}_GLOBAL)
c01be2ce	212	$type $myvar$init;
0d0f8426	213	#else
	214	extern $type $myvar;
	215	#endif
	216	#define $var $myvar
	217	ENDCODE
	218
	219	$code =~ s/^/$indent/mg;
	220
adfe19db	221	return $code;
	222	}
	223
c01be2ce	224	sub expand_need_dummy_var
	225	{
	226	my($indent, $var, $type, $init) = @_;
	227
	228	$explicit{$var} = 'var';
	229
	230	my $myvar = "$DPPP(dummy_$var)";
	231	$init = defined $init ? " = $init" : "";
	232
	233	my $code = <<ENDCODE;
	234	#if defined(NEED_$var)
	235	static $type $myvar$init;
	236	#elif defined(NEED_${var}_GLOBAL)
	237	$type $myvar$init;
	238	#else
	239	extern $type $myvar;
	240	#endif
	241	ENDCODE
	242
	243	$code =~ s/^/$indent/mg;
	244
	245	return $code;
	246	}
	247
adfe19db	248	sub expand_undefined
	249	{
	250	my($macro, $withargs, $def) = @_;
	251	my $rv = "#ifndef $macro\n# define ";
	252
4a582685	253	if (defined $def && $def =~ /\S/) {
adfe19db	254	$rv .= sprintf "%-30s %s", $withargs, $def;
	255	}
	256	else {
	257	$rv .= $withargs;
	258	}
	259
	260	$rv .= "\n#endif\n";
	261
	262	return $rv;
	263	}
	264
	265	sub expand_pp_expressions
	266	{
	267	my $pp = shift;
	268	$pp =~ s/\{([^\}]+)\}/expand_pp_expr($1)/ge;
	269	return $pp;
	270	}
	271
	272	sub expand_pp_expr
	273	{
	274	my $expr = shift;
	275
0d0f8426	276	if ($expr =~ /^\sneed\s+(\w+)\s$/i) {
adfe19db	277	my $func = $1;
	278	my $e = $embed{$func} or die "unknown API function '$func' in NEED\n";
	279	my $proto = make_prototype($e);
	280	if (exists $prototypes{$func}) {
	281	if (compare_prototypes($proto, $prototypes{$func})) {
	282	check(1, "differing prototypes for $func:\n API: $proto\n PPP: $prototypes{$func}");
	283	$proto = $prototypes{$func};
	284	}
	285	}
	286	else {
	287	warn "found no prototype for $func\n";;
	288	}
	289
0d0f8426	290	$explicit{$func} = 'func';
adfe19db	291
96ad942f	292	$proto =~ s/\b$func(?=\s*\()/$DPPP(my_$func)/;
adfe19db	293	my $embed = make_embed($e);
	294
	295	return "defined(NEED_$func)\n"
	296	. "static $proto;\n"
	297	. "static\n"
	298	. "#else\n"
	299	. "extern $proto;\n"
	300	. "#endif\n"
	301	. "\n"
	302	. "$embed\n"
	303	. "\n"
96ad942f	304	. "#if defined(NEED_$func) \|\| defined(NEED_${func}_GLOBAL)";
adfe19db	305	}
adfe19db	306
adfe19db	307	die "cannot expand preprocessor expression '$expr'\n";
	308	}
	309
	310	sub make_embed
	311	{
	312	my $f = shift;
	313	my $n = $f->{name};
	314	my $a = do { my $x = 'a'; join ',', map { $x++ } 1 .. @{$f->{args}} };
a89b7ab8	315	my $lastarg = ${$f->{args}}[-1];
adfe19db	316
	317	if ($f->{flags}{n}) {
	318	if ($f->{flags}{p}) {
96ad942f	319	return "#define $n $DPPP(my_$n)\n" .
96ad942f	320	"#define Perl_$n $DPPP(my_$n)";
adfe19db	321	}
adfe19db	322	else {
96ad942f	323	return "#define $n $DPPP(my_$n)";
adfe19db	324	}
	325	}
	326	else {
	327	my $undef = <<UNDEF;
	328	#ifdef $n
	329	# undef $n
	330	#endif
	331	UNDEF
	332	if ($f->{flags}{p}) {
96ad942f	333	if ($f->{flags}{f}) {
	334	return "#define Perl_$n $DPPP(my_$n)";
	335	}
a89b7ab8	336	elsif (@$lastarg && $lastarg->[0] =~ /\.\.\./) {
	337	return $undef . "#define $n $DPPP(my_$n)\n" .
	338	"#define Perl_$n $DPPP(my_$n)";
	339	}
96ad942f	340	else {
	341	return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)\n" .
	342	"#define Perl_$n $DPPP(my_$n)";
	343	}
adfe19db	344	}
adfe19db	345	else {
96ad942f	346	return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)";
adfe19db	347	}
	348	}
	349	}
	350
	351	sub check
	352	{
	353	my $level = shift;
	354
	355	if (exists $ENV{DPPP_CHECK_LEVEL} and $ENV{DPPP_CHECK_LEVEL} >= $level) {
	356	print STDERR @_, "\n";
	357	}
	358	}
	359
	360	__DATA__
	361	################################################################################
	362	#
	363	# !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
	364	#
cac25305	365	# This file was automatically generated from the definition files in the
	366	# parts/inc/ subdirectory by PPPort_pm.PL. To learn more about how all this
	367	# works, please read the F<HACKERS> file that came with this distribution.
	368	#
adfe19db	369	################################################################################
	370	#
	371	# Perl/Pollution/Portability
	372	#
	373	################################################################################
	374	#
51d6c659	375	# $Revision: 64 $
adfe19db	376	# $Author: mhx $
51d6c659	377	# $Date: 2009/01/18 14:10:49 +0100 $
adfe19db	378	#
	379	################################################################################
	380	#
51d6c659	381	# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz.
adfe19db	382	# Version 2.x, Copyright (C) 2001, Paul Marquess.
	383	# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
	384	#
	385	# This program is free software; you can redistribute it and/or
	386	# modify it under the same terms as Perl itself.
	387	#
	388	################################################################################
	389
	390	=head1 NAME
	391
	392	Devel::PPPort - Perl/Pollution/Portability
	393
	394	=head1 SYNOPSIS
	395
	396	Devel::PPPort::WriteFile(); # defaults to ./ppport.h
	397	Devel::PPPort::WriteFile('someheader.h');
	398
	399	=head1 DESCRIPTION
	400
	401	Perl's API has changed over time, gaining new features, new functions,
	402	increasing its flexibility, and reducing the impact on the C namespace
	403	environment (reduced pollution). The header file written by this module,
	404	typically F<ppport.h>, attempts to bring some of the newer Perl API
	405	features to older versions of Perl, so that you can worry less about
	406	keeping track of old releases, but users can still reap the benefit.
	407
	408	C<Devel::PPPort> contains a single function, called C<WriteFile>. Its
	409	only purpose is to write the F<ppport.h> C header file. This file
	410	contains a series of macros and, if explicitly requested, functions that
	411	allow XS modules to be built using older versions of Perl. Currently,
	412	Perl versions from __MIN_PERL__ to __MAX_PERL__ are supported.
	413
4a582685	414	This module is used by C<h2xs> to write the file F<ppport.h>.
adfe19db	415
adfe19db	416	=head2 Why use ppport.h?
4a582685	417
adfe19db	418	You should use F<ppport.h> in modern code so that your code will work
	419	with the widest range of Perl interpreters possible, without significant
	420	additional work.
	421
	422	You should attempt older code to fully use F<ppport.h>, because the
	423	reduced pollution of newer Perl versions is an important thing. It's so
	424	important that the old polluting ways of original Perl modules will not be
	425	supported very far into the future, and your module will almost certainly
	426	break! By adapting to it now, you'll gain compatibility and a sense of
	427	having done the electronic ecology some good.
	428
	429	=head2 How to use ppport.h
	430
	431	Don't direct the users of your module to download C<Devel::PPPort>.
	432	They are most probably no XS writers. Also, don't make F<ppport.h>
	433	optional. Rather, just take the most recent copy of F<ppport.h> that
	434	you can find (e.g. by generating it with the latest C<Devel::PPPort>
	435	release from CPAN), copy it into your project, adjust your project to
4a582685	436	use it, and distribute the header along with your module.
adfe19db	437
	438	=head2 Running ppport.h
	439
	440	But F<ppport.h> is more than just a C header. It's also a Perl script
	441	that can check your source code. It will suggest hints and portability
	442	notes, and can even make suggestions on how to change your code. You
	443	can run it like any other Perl program:
	444
9132e1a3	445	perl ppport.h [options] [files]
adfe19db	446
	447	It also has embedded documentation, so you can use
	448
	449	perldoc ppport.h
	450
	451	to find out more about how to use it.
	452
	453	=head1 FUNCTIONS
	454
	455	=head2 WriteFile
	456
	457	C<WriteFile> takes one optional argument. When called with one
	458	argument, it expects to be passed a filename. When called with
	459	no arguments, it defaults to the filename F<ppport.h>.
	460
	461	The function returns a true value if the file was written successfully.
	462	Otherwise it returns a false value.
	463
	464	=head1 COMPATIBILITY
	465
	466	F<ppport.h> supports Perl versions from __MIN_PERL__ to __MAX_PERL__
	467	in threaded and non-threaded configurations.
	468
	469	=head2 Provided Perl compatibility API
	470
	471	The header file written by this module, typically F<ppport.h>, provides
	472	access to the following elements of the Perl API that is not available
	473	in older Perl releases:
	474
	475	__PROVIDED_API__
	476
	477	=head2 Perl API not supported by ppport.h
	478
	479	There is still a big part of the API not supported by F<ppport.h>.
	480	Either because it doesn't make sense to back-port that part of the API,
	481	or simply because it hasn't been implemented yet. Patches welcome!
	482
	483	Here's a list of the currently unsupported API, and also the version of
	484	Perl below which it is unsupported:
	485
	486	=over 4
	487
	488	__UNSUPPORTED_API__
	489
	490	=back
	491
	492	=head1 BUGS
	493
	494	If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
	495	system or any of its tests fail, please use the CPAN Request Tracker
	496	at L<http://rt.cpan.org/> to create a ticket for the module.
	497
	498	=head1 AUTHORS
	499
	500	=over 2
	501
	502	=item *
	503
	504	Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
	505
	506	=item *
	507
	508	Version 2.x was ported to the Perl core by Paul Marquess.
	509
510	=item *
511
512	Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
513
514	=back
515
516	=head1 COPYRIGHT
517
51d6c659	518	Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz.
adfe19db	519
	520	Version 2.x, Copyright (C) 2001, Paul Marquess.
	521
	522	Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
	523
	524	This program is free software; you can redistribute it and/or
	525	modify it under the same terms as Perl itself.
	526
	527	=head1 SEE ALSO
	528
	529	See L<h2xs>, L<ppport.h>.
	530
	531	=cut
	532
	533	package Devel::PPPort;
	534
adfe19db	535	use strict;
236afa0a	536	use vars qw($VERSION $data);
adfe19db	537
ac2e3cea	538	$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.16 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
adfe19db	539
4a582685	540	sub _init_data
adfe19db	541	{
adfe19db	542	$data = do { local $/; <DATA> };
adfe19db	543	my $pkg = 'Devel::PPPort';
	544	$data =~ s/__PERL_VERSION__/$]/g;
	545	$data =~ s/__VERSION__/$VERSION/g;
adfe19db	546	$data =~ s/__PKG__/$pkg/g;
4a582685	547	$data =~ s/^\\|>//gm;
adfe19db	548	}
	549
	550	sub WriteFile
	551	{
	552	my $file = shift \|\| 'ppport.h';
4a582685	553	defined $data or _init_data();
adfe19db	554	my $copy = $data;
	555	$copy =~ s/\bppport\.h\b/$file/g;
	556
	557	open F, ">$file" or return undef;
	558	print F $copy;
	559	close F;
	560
	561	return 1;
	562	}
	563
	564	1;
	565
	566	__DATA__
	567	#if 0
	568	<<'SKIP';
	569	#endif
	570	/*
	571	----------------------------------------------------------------------
	572
4a582685	573	ppport.h -- Perl/Pollution/Portability Version __VERSION__
4a582685	574
d31fb070	575	Automatically created by __PKG__ running under perl __PERL_VERSION__.
4a582685	576
adfe19db	577	Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
adfe19db	578	includes in parts/inc/ instead.
4a582685	579
adfe19db	580	Use 'perldoc ppport.h' to view the documentation below.
	581
	582	----------------------------------------------------------------------
	583
	584	SKIP
	585
4a582685	586	%include ppphdoc { indent => '\|>' }
adfe19db	587
	588	%include ppphbin
	589
	590	__DATA__
	591	*/
	592
	593	#ifndef _P_P_PORTABILITY_H_
	594	#define _P_P_PORTABILITY_H_
	595
	596	#ifndef DPPP_NAMESPACE
	597	# define DPPP_NAMESPACE DPPP_
	598	#endif
	599
	600	#define DPPP_CAT2(x,y) CAT2(x,y)
	601	#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
	602
	603	%include version
	604
fd7af155	605	%include threads
fd7af155	606
adfe19db	607	%include limits
	608
	609	%include uv
	610
0d0f8426	611	%include memory
0d0f8426	612
adfe19db	613	%include misc
adfe19db	614
0d0f8426	615	%include variables
0d0f8426	616
adfe19db	617	%include mPUSH
	618
	619	%include call
	620
	621	%include newRV
	622
	623	%include newCONSTSUB
	624
	625	%include MY_CXT
	626
	627	%include format
	628
c07deaaf	629	%include SvREFCNT
c07deaaf	630
c1a049cb	631	%include newSVpv
c1a049cb	632
adfe19db	633	%include SvPV
adfe19db	634
0d0f8426	635	%include Sv_set
0d0f8426	636
96ad942f	637	%include sv_xpvf
96ad942f	638
c83e6f19	639	%include shared_pv
c83e6f19	640
f2ab5a41	641	%include warn
	642
	643	%include pvs
	644
adfe19db	645	%include magic
	646
	647	%include cop
	648
	649	%include grok
	650
f2ab5a41	651	%include snprintf
f2ab5a41	652
c01be2ce	653	%include sprintf
c01be2ce	654
9132e1a3	655	%include exception
9132e1a3	656
aef0a14c	657	%include strlfuncs
aef0a14c	658
db42c902	659	%include pv_tools
db42c902	660
adfe19db	661	#endif /* _P_P_PORTABILITY_H_ */
	662
	663	/* End of File ppport.h */