xref: /openbsd/gnu/usr.bin/perl/cpan/IPC-SysV/regen.pl (revision 771fbea0) 
1use strict;
2
3unless (@ARGV) {
4  @ARGV = qw( constants );
5}
6
7my %gen = map { ($_ => 1) } @ARGV;
8
9if (delete $gen{constants}) {
10  make_constants();
11}
12
13for my $key (keys %gen) {
14  print STDERR "Invalid request to regenerate $key!\n";
15}
16
17sub make_constants
18{
19  unless (eval { require ExtUtils::Constant; 1 }) {
20    my @files = qw( const-c.inc const-xs.inc );
21
22    die "Cannot regenerate constants:\n$@\n" if grep { !-f } @files;
23
24    my @deps = qw( regen.pl lib/IPC/SysV.pm );
25
26    my $oldage = (sort { $a <=> $b } map { -M } @files)[-1];  # age of oldest file
27    my $depage = (sort { $a <=> $b } map { -M } @deps)[0];    # age of newest dependency
28    my @outdated = grep { (-M) > $depage } @files;
29    my @newdeps = grep { (-M) < $oldage } @deps;
30
31    print STDERR <<EOM if @outdated;
32
33***********************************************************************
34
35  The following files seem to be out of date:
36
37    @outdated
38
39  The reason is probably that you modified these files:
40
41    @newdeps
42
43  If you're absolutely sure you didn't touch the files, please ignore
44  this message.
45
46  Otherwise, please install the ExtUtils::Constant module.
47
48***********************************************************************
49
50EOM
51
52    exit 0;   # will build anyway, since the files exist
53  }
54
55  my $source = 'lib/IPC/SysV.pm';
56  local $_;
57  local *SYSV;
58
59  open SYSV, $source or die "$source: $!\n";
60
61  my $parse = 0;
62  my @const;
63
64  while (<SYSV>) {
65    if ($parse) {
66      if (/^\)/) { $parse++; last }
67      push @const, split;
68    }
69    /^\@EXPORT_OK\s*=/ and $parse++;
70  }
71
72  close SYSV;
73
74  die "couldn't parse $source" if $parse != 2;
75
76  eval {
77    ExtUtils::Constant::WriteConstants(
78      NAME       => 'IPC::SysV',
79      NAMES      => \@const,
80      XS_FILE    => 'const-xs.inc',
81      C_FILE     => 'const-c.inc',
82      XS_SUBNAME => '_constant',
83    );
84  };
85
86  if ($@) {
87    my $err = "Cannot regenerate constants:\n$@\n";
88    if ($] < 5.006) {
89      print STDERR $err;
90      exit 0;
91    }
92    die $err;
93  }
94
95  print "Writing const-xs.inc\n";
96  print "Writing const-c.inc\n";
97}
98