scanprov revision 1.1 
1#!/usr/bin/perl -w
2################################################################################
3#
4#  scanprov -- scan Perl headers for provided macros
5#
6################################################################################
7#
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.
11#
12#  This program is free software; you can redistribute it and/or
13#  modify it under the same terms as Perl itself.
14#
15################################################################################
16
17use strict;
18use Getopt::Long;
19
20require './parts/ppptools.pl';
21
22our %opt = (
23  mode    => 'check',
24  install => '/tmp/perl/install/default',
25  blead   => 'bleadperl',
26);
27
28GetOptions(\%opt, qw( install=s mode=s blead=s )) or die;
29
30my $write = $opt{mode} eq 'write';
31
32my %embed = map { ( $_->{name} => 1 ) }
33            parse_embed(qw(parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc ));
34
35my @provided = grep { !exists $embed{$_} }
36               map { /^(\w+)/ ? $1 : () }
37               `$^X ppport.h --list-provided`;
38
39my @perls = sort { $b->{version} <=> $a->{version} }
40            map { { version => `$_ -e 'printf "%.6f", \$]'`, path => $_ } }
41            ($opt{blead}, glob "$opt{install}/*/bin/perl5.*");
42
43for (1 .. $#perls) {
44  $perls[$_]{todo} = $perls[$_-1]{version};
45}
46
47shift @perls;
48
49my %v;
50
51for my $p (@perls) {
52  print "checking perl $p->{version}...\n";
53  my $archlib = `$p->{path} -MConfig -l -e 'print \$Config{archlib}'`;
54  chomp $archlib;
55  local @ARGV = glob "$archlib/CORE/*.h";
56  my %sym;
57  while (<>) { $sym{$_}++ for /(\w+)/g; }
58  @provided = map { $sym{$_} or $v{$p->{todo}}{$_}++; $sym{$_} ? $_ : () } @provided;
59}
60
61my $out = 'parts/base';
62my $todo = parse_todo($out);
63
64for my $v (keys %v) {
65  my @new = sort grep { !exists $todo->{$_} } keys %{$v{$v}};
66  @new or next;
67  my $file = $v;
68  $file =~ s/\.//g;
69  $file = "$out/$file";
70  -e $file or die "non-existent: $file\n";
71  print "-- $file --\n";
72  $write and (open F, ">>$file" or die "$file: $!\n");
73  for (@new) {
74    print "adding $_\n";
75    $write and printf F "%-30s # added by $0\n", $_;
76  }
77  $write and close F;
78}
79