cpan/IPC-SysV/regen.pl

   1 use strict;
   2
   3 unless (@ARGV) {
   4   @ARGV = qw( constants );
   5 }
   6
   7 my %gen = map { ($_ => 1) } @ARGV;
   8
   9 if (delete $gen{constants}) {
  10   make_constants();
  11 }
  12
  13 for my $key (keys %gen) {
  14   print STDERR "Invalid request to regenerate $key!\n";
  15 }
  16
  17 sub 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
  50 EOM
  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 }