1 ################################################################################
3 # PPPort_pm.PL -- generate PPPort.pm
5 ################################################################################
9 # $Date: 2009/01/18 14:10:49 +0100 $
11 ################################################################################
13 # Version 3.x, Copyright (C) 2004-2009, 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 /^Perl_(.*)/ && exists $embed{$1};
86 next if exists $embed{$_};
88 check(2, "No API definition for provided element $_ found.");
91 push @perl_api, keys %embed;
94 if (exists $provides{$_} && !exists $raw_base{$_}) {
95 check(2, "Mmmh, $_ doesn't seem to need backporting.");
97 my $line = "$_|" . (exists $provides{$_} && exists $raw_base{$_} ? $raw_base{$_} : '') . '|';
98 $line .= ($raw_todo{$_} || '') . '|';
99 $line .= 'p' if exists $provides{$_};
100 if (exists $embed{$_}) {
102 if (exists $e->{flags}{p}) {
103 my $args = $e->{args};
104 $line .= 'v' if @$args && $args->[-1][0] eq '...';
106 $line .= 'n' if exists $e->{flags}{n};
111 $data =~ s/^([\t ]*)__PERL_API__(\s*?)$/
112 join "\n", map "$1$_", sort @perl_api
116 for (reverse sort keys %todo) {
117 my $ver = format_version($_);
118 my $todo = "=item perl $ver\n\n";
119 for (sort @{$todo{$_}}) {
125 $data =~ s{^__UNSUPPORTED_API__(\s*?)^}
126 {join "\n", @todo}gem;
128 $data =~ s{__MIN_PERL__}{5.003}g;
129 $data =~ s{__MAX_PERL__}{5.10.0}g;
131 open FH, ">PPPort.pm" or die "PPPort.pm: $!\n";
139 my($file, $opt) = @_;
141 print "including $file\n";
143 my $data = parse_partspec("$INCLUDE/$file");
145 for (@{$data->{provides}}) {
146 if (exists $provides{$_}) {
147 if ($provides{$_} ne $file) {
148 warn "$file: $_ already provided by $provides{$_}\n";
152 $provides{$_} = $file;
156 for (keys %{$data->{prototypes}}) {
157 $prototypes{$_} = $data->{prototypes}{$_};
158 $data->{implementation} =~ s/^$_(?=\s*\()/$DPPP(my_$_)/mg;
161 my $out = $data->{implementation};
163 if (exists $opt->{indent}) {
164 $out =~ s/^/$opt->{indent}/gm;
173 $code =~ s{^(\s*#\s*(?:el)?if\s+)(.*)$}{$1.expand_pp_expressions($2)}gem;
183 (?:[^\r\n\\]|\\[^\r\n])*
187 (?:[^\r\n\\]|\\[^\r\n])*
191 {expand_undefined($2, $1, $3)}gemx;
192 $code =~ s{^([^\S\r\n]*)__NEED_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$}
193 {expand_need_var($1, $3, $2, $4)}gem;
194 $code =~ s{^([^\S\r\n]*)__NEED_DUMMY_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$}
195 {expand_need_dummy_var($1, $3, $2, $4)}gem;
201 my($indent, $var, $type, $init) = @_;
203 $explicit{$var} = 'var';
205 my $myvar = "$DPPP(my_$var)";
206 $init = defined $init ? " = $init" : "";
208 my $code = <<ENDCODE;
209 #if defined(NEED_$var)
210 static $type $myvar$init;
211 #elif defined(NEED_${var}_GLOBAL)
219 $code =~ s/^/$indent/mg;
224 sub expand_need_dummy_var
226 my($indent, $var, $type, $init) = @_;
228 $explicit{$var} = 'var';
230 my $myvar = "$DPPP(dummy_$var)";
231 $init = defined $init ? " = $init" : "";
233 my $code = <<ENDCODE;
234 #if defined(NEED_$var)
235 static $type $myvar$init;
236 #elif defined(NEED_${var}_GLOBAL)
243 $code =~ s/^/$indent/mg;
250 my($macro, $withargs, $def) = @_;
251 my $rv = "#ifndef $macro\n# define ";
253 if (defined $def && $def =~ /\S/) {
254 $rv .= sprintf "%-30s %s", $withargs, $def;
265 sub expand_pp_expressions
268 $pp =~ s/\{([^\}]+)\}/expand_pp_expr($1)/ge;
276 if ($expr =~ /^\s*need\s+(\w+)\s*$/i) {
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};
287 warn "found no prototype for $func\n";;
290 $explicit{$func} = 'func';
292 $proto =~ s/\b$func(?=\s*\()/$DPPP(my_$func)/;
293 my $embed = make_embed($e);
295 return "defined(NEED_$func)\n"
304 . "#if defined(NEED_$func) || defined(NEED_${func}_GLOBAL)";
307 die "cannot expand preprocessor expression '$expr'\n";
314 my $a = do { my $x = 'a'; join ',', map { $x++ } 1 .. @{$f->{args}} };
315 my $lastarg = ${$f->{args}}[-1];
317 if ($f->{flags}{n}) {
318 if ($f->{flags}{p}) {
319 return "#define $n $DPPP(my_$n)\n" .
320 "#define Perl_$n $DPPP(my_$n)";
323 return "#define $n $DPPP(my_$n)";
332 if ($f->{flags}{p}) {
333 if ($f->{flags}{f}) {
334 return "#define Perl_$n $DPPP(my_$n)";
336 elsif (@$lastarg && $lastarg->[0] =~ /\.\.\./) {
337 return $undef . "#define $n $DPPP(my_$n)\n" .
338 "#define Perl_$n $DPPP(my_$n)";
341 return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)\n" .
342 "#define Perl_$n $DPPP(my_$n)";
346 return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)";
355 if (exists $ENV{DPPP_CHECK_LEVEL} and $ENV{DPPP_CHECK_LEVEL} >= $level) {
356 print STDERR @_, "\n";
361 ################################################################################
363 # !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
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.
369 ################################################################################
371 # Perl/Pollution/Portability
373 ################################################################################
377 # $Date: 2009/01/18 14:10:49 +0100 $
379 ################################################################################
381 # Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz.
382 # Version 2.x, Copyright (C) 2001, Paul Marquess.
383 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
385 # This program is free software; you can redistribute it and/or
386 # modify it under the same terms as Perl itself.
388 ################################################################################
392 Devel::PPPort - Perl/Pollution/Portability
396 Devel::PPPort::WriteFile(); # defaults to ./ppport.h
397 Devel::PPPort::WriteFile('someheader.h');
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.
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.
414 This module is used by C<h2xs> to write the file F<ppport.h>.
416 =head2 Why use ppport.h?
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
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.
429 =head2 How to use ppport.h
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
436 use it, and distribute the header along with your module.
438 =head2 Running ppport.h
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:
445 perl ppport.h [options] [files]
447 It also has embedded documentation, so you can use
451 to find out more about how to use it.
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>.
461 The function returns a true value if the file was written successfully.
462 Otherwise it returns a false value.
466 F<ppport.h> supports Perl versions from __MIN_PERL__ to __MAX_PERL__
467 in threaded and non-threaded configurations.
469 =head2 Provided Perl compatibility API
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:
477 =head2 Perl API not supported by ppport.h
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!
483 Here's a list of the currently unsupported API, and also the version of
484 Perl below which it is unsupported:
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.
504 Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
508 Version 2.x was ported to the Perl core by Paul Marquess.
512 Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
518 Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz.
520 Version 2.x, Copyright (C) 2001, Paul Marquess.
522 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
524 This program is free software; you can redistribute it and/or
525 modify it under the same terms as Perl itself.
529 See L<h2xs>, L<ppport.h>.
533 package Devel::PPPort;
536 use vars qw($VERSION $data);
538 $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.16 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
542 $data = do { local $/; <DATA> };
543 my $pkg = 'Devel::PPPort';
544 $data =~ s/__PERL_VERSION__/$]/g;
545 $data =~ s/__VERSION__/$VERSION/g;
546 $data =~ s/__PKG__/$pkg/g;
552 my $file = shift || 'ppport.h';
553 defined $data or _init_data();
555 $copy =~ s/\bppport\.h\b/$file/g;
557 open F, ">$file" or return undef;
571 ----------------------------------------------------------------------
573 ppport.h -- Perl/Pollution/Portability Version __VERSION__
575 Automatically created by __PKG__ running under perl __PERL_VERSION__.
577 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
578 includes in parts/inc/ instead.
580 Use 'perldoc ppport.h' to view the documentation below.
582 ----------------------------------------------------------------------
586 %include ppphdoc { indent => '|>' }
593 #ifndef _P_P_PORTABILITY_H_
594 #define _P_P_PORTABILITY_H_
596 #ifndef DPPP_NAMESPACE
597 # define DPPP_NAMESPACE DPPP_
600 #define DPPP_CAT2(x,y) CAT2(x,y)
601 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
661 #endif /* _P_P_PORTABILITY_H_ */
663 /* End of File ppport.h */