2 ################################################################################
4 # scanprov -- scan Perl headers for provided macros
6 ################################################################################
8 # Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
9 # Version 2.x, Copyright (C) 2001, Paul Marquess.
10 # Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
12 # This program is free software; you can redistribute it and/or
13 # modify it under the same terms as Perl itself.
15 ################################################################################
20 require './parts/ppptools.pl';
21 require './parts/inc/inctools';
22 require './devel/devtools.pl';
26 install => '/tmp/perl/install/default',
32 GetOptions(\%opt, qw( install=s mode=s blead=s debug=i debug-start=s)) or die;
34 my $write = $opt{mode} eq 'write';
36 my %embed = map { ( $_->{name} => 1 ) }
37 parse_embed(qw(parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc ));
39 # @provided is set to the elements that are provided, but not functions in the
41 my @provided = grep { !exists $embed{$_} }
42 map { /^(\w+)/ ? $1 : () }
43 `$^X ppport.h --list-provided`;
45 my $perls_ref = get_and_sort_perls(\%opt);
48 die "Couldn't find any perls" unless @$perls_ref > 1;
52 # We look in descending order of perl versions. Each time through the loop
53 # @provided is narrowed.
54 for my $p (@$perls_ref) {
55 print "checking perl $p->{version}...\n";
57 # Get the hdr files associated with this version
58 my $archlib = `$p->{path} -MConfig -l -e 'print \$Config{archlib}'`;
60 local @ARGV = glob "$archlib/CORE/*.h";
63 # %sym's keys are every single thing that looks like an identifier
64 # (beginning with a non-digit \w, followed by \w*) that occurs in all the
65 # headers, regardless of where (outside of comments).
67 while (<>) { # Read in the next file
69 # Strip comments, from perl faq
70 s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#defined $2 ? $2 : ""#gse;
72 $sym{$_}++ for /(\b[^\W\d]\w*)/g;
75 # @provided is narrowed to include only those identifier-like things that
76 # are mentioned in some hdr in this release. (If it isn't even mentioned,
77 # it won't exist in the release.) For those not mentioned, a key is added
78 # of the identifier-like thing in %v. It is a subkey of this release's
79 # "todo" release, which is the next higher one. If we are at version n, we
80 # have already done version n+1 and the provided element was mentioned
81 # there, and now it no longer is. We take that to mean that to mean that
82 # the element became provided for in n+1.
83 @provided = map { $sym{$_} or $v{$p->{todo}}{$_}++;
88 # Read in the parts/base files. The hash ref has keys being all symbols found
89 # in all the files in base/, and the values being the perl versions each symbol
91 my $out = 'parts/base';
92 my $base_ref = parse_todo($out);
94 # Now add the results from above. At this point, The keys of %v are the 7
95 # digit BCD version numbers, and their subkeys are the symbols provided by
96 # D:P that are first mentioned in this version, like this:
98 # 'MY_CXT_CLONE' => 1,
100 # 'UTF8_MAXBYTES' => 1
103 for my $v (keys %v) {
105 # Things listed in blead (the most recent file) are special. They are there
106 # by default because we haven't found them anywhere, so they don't really
107 # exist as far as we can determine, so shouldn't be listed as existing.
108 next if $v > $perls_ref->[0]->{file};
110 # @new becomes the symbols for version $v not already in the file for $v
111 my @new = sort dictionary_order grep { !exists $base_ref->{$_} }
113 @new or next; # Nothing new, skip writing
117 $file = "$out/$file";
118 -e $file or die "non-existent: $file\n";
119 print "-- $file --\n";
120 $write and (open F, ">>$file" or die "$file: $!\n");
123 $write and printf F "%-30s # added by $0\n", $_;