1 ################################################################################
3 # PPPort_pm.PL -- generate PPPort.pm
5 ################################################################################
9 # $Date: 2007/08/13 00:03:11 +0200 $
11 ################################################################################
13 # Version 3.x, Copyright (C) 2004-2007, Marcus Holland-Moritz.
14 # Version 2.x, Copyright (C) 2001, Paul Marquess.
15 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
17 # This program is free software; you can redistribute it and/or
18 # modify it under the same terms as Perl itself.
20 ################################################################################
24 require "parts/ppptools.pl";
26 my $INCLUDE = 'parts/inc';
29 my %embed = map { ( $_->{name} => $_ ) }
30 parse_embed(qw(parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc));
32 my(%provides, %prototypes, %explicit);
34 my $data = do { local $/; <DATA> };
35 $data =~ s{^\%(include)\s+(\w+)((?:[^\S\r\n]+.*?)?)\s*$}
36 {eval "$1('$2', $3)" or die $@}gem;
38 $data = expand($data);
40 my @api = sort { lc $a cmp lc $b } keys %provides;
42 $data =~ s{^(.*)__PROVIDED_API__(\s*?)^}
43 {join '', map "$1$_\n", @api}gem;
47 for (keys %explicit) {
48 length > $len and $len = length;
50 my $format = sprintf '%%-%ds %%-%ds %%s', $len+2, $len+5;
53 $data =~ s!^(.*)__EXPLICIT_API__(\s*?)^!
54 sprintf("$1$format\n", 'Function / Variable', 'Static Request', 'Global Request') .
55 $1 . '-'x$len . "\n" .
56 join('', map { sprintf "$1$format\n", $explicit{$_} eq 'var' ? $_ : "$_()", "NEED_$_", "NEED_${_}_GLOBAL" }
61 my %raw_base = %{&parse_todo('parts/base')};
62 my %raw_todo = %{&parse_todo('parts/todo')};
65 for (keys %raw_todo) {
66 push @{$todo{$raw_todo{$_}}}, $_;
71 if (exists $raw_todo{$_} and exists $raw_base{$_}) {
72 if ($raw_base{$_} eq $raw_todo{$_}) {
73 warn "$INCLUDE/$provides{$_} provides $_, which is still marked "
74 . "todo for " . format_version($raw_todo{$_}) . "\n";
77 check(2, "$_ was ported back to " . format_version($raw_todo{$_}) .
78 " (baseline revision: " . format_version($raw_base{$_}) . ").");
84 for (keys %provides) {
85 next if exists $embed{$_};
87 check(2, "No API definition for provided element $_ found.");
90 push @perl_api, keys %embed;
93 if (exists $provides{$_} && !exists $raw_base{$_}) {
94 check(2, "Mmmh, $_ doesn't seem to need backporting.");
96 my $line = "$_|" . (exists $provides{$_} && exists $raw_base{$_} ? $raw_base{$_} : '') . '|';
97 $line .= ($raw_todo{$_} || '') . '|';
98 $line .= 'p' if exists $provides{$_};
99 if (exists $embed{$_}) {
101 if (exists $e->{flags}{p}) {
102 my $args = $e->{args};
103 $line .= 'v' if @$args && $args->[-1][0] eq '...';
105 $line .= 'n' if exists $e->{flags}{n};
110 $data =~ s/^([\t ]*)__PERL_API__(\s*?)$/
111 join "\n", map "$1$_", sort @perl_api
115 for (reverse sort keys %todo) {
116 my $ver = format_version($_);
117 my $todo = "=item perl $ver\n\n";
118 for (sort @{$todo{$_}}) {
124 $data =~ s{^__UNSUPPORTED_API__(\s*?)^}
125 {join "\n", @todo}gem;
127 $data =~ s{__MIN_PERL__}{5.003}g;
128 $data =~ s{__MAX_PERL__}{5.9.5}g;
130 open FH, ">PPPort.pm" or die "PPPort.pm: $!\n";
138 my($file, $opt) = @_;
140 print "including $file\n";
142 my $data = parse_partspec("$INCLUDE/$file");
144 for (@{$data->{provides}}) {
145 if (exists $provides{$_}) {
146 if ($provides{$_} ne $file) {
147 warn "$file: $_ already provided by $provides{$_}\n";
151 $provides{$_} = $file;
155 for (keys %{$data->{prototypes}}) {
156 $prototypes{$_} = $data->{prototypes}{$_};
157 $data->{implementation} =~ s/^$_(?=\s*\()/$DPPP(my_$_)/mg;
160 my $out = $data->{implementation};
162 if (exists $opt->{indent}) {
163 $out =~ s/^/$opt->{indent}/gm;
172 $code =~ s{^(\s*#\s*(?:el)?if\s+)(.*)$}{$1.expand_pp_expressions($2)}gem;
182 (?:[^\r\n\\]|\\[^\r\n])*
186 (?:[^\r\n\\]|\\[^\r\n])*
190 {expand_undefined($2, $1, $3)}gemx;
191 $code =~ s{^([^\S\r\n]*)__NEED_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?)\s*;\s*)?$}
192 {expand_need_var($1, $3, $2, $4)}gem;
198 my($indent, $var, $type, $init) = @_;
200 $explicit{$var} = 'var';
202 my $myvar = "$DPPP(my_$var)";
204 my $code = <<ENDCODE;
205 #if defined(NEED_$var)
206 static $type $myvar = $init;
207 #elif defined(NEED_${var}_GLOBAL)
208 $type $myvar = $init;
215 $code =~ s/^/$indent/mg;
222 my($macro, $withargs, $def) = @_;
223 my $rv = "#ifndef $macro\n# define ";
225 if (defined $def && $def =~ /\S/) {
226 $rv .= sprintf "%-30s %s", $withargs, $def;
237 sub expand_pp_expressions
240 $pp =~ s/\{([^\}]+)\}/expand_pp_expr($1)/ge;
248 if ($expr =~ /^\s*need\s+(\w+)\s*$/i) {
250 my $e = $embed{$func} or die "unknown API function '$func' in NEED\n";
251 my $proto = make_prototype($e);
252 if (exists $prototypes{$func}) {
253 if (compare_prototypes($proto, $prototypes{$func})) {
254 check(1, "differing prototypes for $func:\n API: $proto\n PPP: $prototypes{$func}");
255 $proto = $prototypes{$func};
259 warn "found no prototype for $func\n";;
262 $explicit{$func} = 'func';
264 $proto =~ s/\b$func(?=\s*\()/$DPPP(my_$func)/;
265 my $embed = make_embed($e);
267 return "defined(NEED_$func)\n"
276 . "#if defined(NEED_$func) || defined(NEED_${func}_GLOBAL)";
279 die "cannot expand preprocessor expression '$expr'\n";
286 my $a = do { my $x = 'a'; join ',', map { $x++ } 1 .. @{$f->{args}} };
287 my $lastarg = ${$f->{args}}[-1];
289 if ($f->{flags}{n}) {
290 if ($f->{flags}{p}) {
291 return "#define $n $DPPP(my_$n)\n" .
292 "#define Perl_$n $DPPP(my_$n)";
295 return "#define $n $DPPP(my_$n)";
304 if ($f->{flags}{p}) {
305 if ($f->{flags}{f}) {
306 return "#define Perl_$n $DPPP(my_$n)";
308 elsif (@$lastarg && $lastarg->[0] =~ /\.\.\./) {
309 return $undef . "#define $n $DPPP(my_$n)\n" .
310 "#define Perl_$n $DPPP(my_$n)";
313 return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)\n" .
314 "#define Perl_$n $DPPP(my_$n)";
318 return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)";
327 if (exists $ENV{DPPP_CHECK_LEVEL} and $ENV{DPPP_CHECK_LEVEL} >= $level) {
328 print STDERR @_, "\n";
333 ################################################################################
335 # !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
337 # This file was automatically generated from the definition files in the
338 # parts/inc/ subdirectory by PPPort_pm.PL. To learn more about how all this
339 # works, please read the F<HACKERS> file that came with this distribution.
341 ################################################################################
343 # Perl/Pollution/Portability
345 ################################################################################
349 # $Date: 2007/08/13 00:03:11 +0200 $
351 ################################################################################
353 # Version 3.x, Copyright (C) 2004-2007, Marcus Holland-Moritz.
354 # Version 2.x, Copyright (C) 2001, Paul Marquess.
355 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
357 # This program is free software; you can redistribute it and/or
358 # modify it under the same terms as Perl itself.
360 ################################################################################
364 Devel::PPPort - Perl/Pollution/Portability
368 Devel::PPPort::WriteFile(); # defaults to ./ppport.h
369 Devel::PPPort::WriteFile('someheader.h');
373 Perl's API has changed over time, gaining new features, new functions,
374 increasing its flexibility, and reducing the impact on the C namespace
375 environment (reduced pollution). The header file written by this module,
376 typically F<ppport.h>, attempts to bring some of the newer Perl API
377 features to older versions of Perl, so that you can worry less about
378 keeping track of old releases, but users can still reap the benefit.
380 C<Devel::PPPort> contains a single function, called C<WriteFile>. Its
381 only purpose is to write the F<ppport.h> C header file. This file
382 contains a series of macros and, if explicitly requested, functions that
383 allow XS modules to be built using older versions of Perl. Currently,
384 Perl versions from __MIN_PERL__ to __MAX_PERL__ are supported.
386 This module is used by C<h2xs> to write the file F<ppport.h>.
388 =head2 Why use ppport.h?
390 You should use F<ppport.h> in modern code so that your code will work
391 with the widest range of Perl interpreters possible, without significant
394 You should attempt older code to fully use F<ppport.h>, because the
395 reduced pollution of newer Perl versions is an important thing. It's so
396 important that the old polluting ways of original Perl modules will not be
397 supported very far into the future, and your module will almost certainly
398 break! By adapting to it now, you'll gain compatibility and a sense of
399 having done the electronic ecology some good.
401 =head2 How to use ppport.h
403 Don't direct the users of your module to download C<Devel::PPPort>.
404 They are most probably no XS writers. Also, don't make F<ppport.h>
405 optional. Rather, just take the most recent copy of F<ppport.h> that
406 you can find (e.g. by generating it with the latest C<Devel::PPPort>
407 release from CPAN), copy it into your project, adjust your project to
408 use it, and distribute the header along with your module.
410 =head2 Running ppport.h
412 But F<ppport.h> is more than just a C header. It's also a Perl script
413 that can check your source code. It will suggest hints and portability
414 notes, and can even make suggestions on how to change your code. You
415 can run it like any other Perl program:
417 perl ppport.h [options] [files]
419 It also has embedded documentation, so you can use
423 to find out more about how to use it.
429 C<WriteFile> takes one optional argument. When called with one
430 argument, it expects to be passed a filename. When called with
431 no arguments, it defaults to the filename F<ppport.h>.
433 The function returns a true value if the file was written successfully.
434 Otherwise it returns a false value.
438 F<ppport.h> supports Perl versions from __MIN_PERL__ to __MAX_PERL__
439 in threaded and non-threaded configurations.
441 =head2 Provided Perl compatibility API
443 The header file written by this module, typically F<ppport.h>, provides
444 access to the following elements of the Perl API that is not available
445 in older Perl releases:
449 =head2 Perl API not supported by ppport.h
451 There is still a big part of the API not supported by F<ppport.h>.
452 Either because it doesn't make sense to back-port that part of the API,
453 or simply because it hasn't been implemented yet. Patches welcome!
455 Here's a list of the currently unsupported API, and also the version of
456 Perl below which it is unsupported:
466 If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
467 system or any of its tests fail, please use the CPAN Request Tracker
468 at L<http://rt.cpan.org/> to create a ticket for the module.
476 Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
480 Version 2.x was ported to the Perl core by Paul Marquess.
484 Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
490 Version 3.x, Copyright (C) 2004-2007, Marcus Holland-Moritz.
492 Version 2.x, Copyright (C) 2001, Paul Marquess.
494 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
496 This program is free software; you can redistribute it and/or
497 modify it under the same terms as Perl itself.
501 See L<h2xs>, L<ppport.h>.
505 package Devel::PPPort;
508 use vars qw($VERSION $data);
510 $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.11_03 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
514 $data = do { local $/; <DATA> };
515 my $pkg = 'Devel::PPPort';
516 $data =~ s/__PERL_VERSION__/$]/g;
517 $data =~ s/__VERSION__/$VERSION/g;
518 $data =~ s/__PKG__/$pkg/g;
524 my $file = shift || 'ppport.h';
525 defined $data or _init_data();
527 $copy =~ s/\bppport\.h\b/$file/g;
529 open F, ">$file" or return undef;
543 ----------------------------------------------------------------------
545 ppport.h -- Perl/Pollution/Portability Version __VERSION__
547 Automatically created by __PKG__ running under perl __PERL_VERSION__.
549 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
550 includes in parts/inc/ instead.
552 Use 'perldoc ppport.h' to view the documentation below.
554 ----------------------------------------------------------------------
558 %include ppphdoc { indent => '|>' }
565 #ifndef _P_P_PORTABILITY_H_
566 #define _P_P_PORTABILITY_H_
568 #ifndef DPPP_NAMESPACE
569 # define DPPP_NAMESPACE DPPP_
572 #define DPPP_CAT2(x,y) CAT2(x,y)
573 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
625 #endif /* _P_P_PORTABILITY_H_ */
627 /* End of File ppport.h */