ext/B/defsubs.h.PL

   1 #!perl
   2 my ($out) = __FILE__ =~ /(^.*)[._]PL/i;
   3 if ($^O eq 'VMS') { $out =~ s/(^.*)[._](.*$)/$1.$2/;}
   4 open(OUT,">$out") || die "Cannot open $file:$!";
   5 foreach my $const (qw(AVf_REAL
   6                       HEf_SVKEY
   7                       SVf_IOK SVf_NOK SVf_POK SVf_ROK SVp_IOK SVp_POK ))
   8  {
   9   doconst($const);
  10  }
  11 foreach my $file (qw(op.h cop.h))
  12  {
  13   open(OPH,"../../$file") || die "Cannot open ../../$file:$!";
  14   while (<OPH>)
  15    {
  16     doconst($1) if (/#define\s+(\w+)\s+([\(\)\|\dx]+)\s*(?:$|\/\*)/);
  17    }
  18   close(OPH);
  19  }
  20 close(OUT);
  21
  22 sub doconst
  23 {
  24  my $sym = shift;
  25  my $l = length($sym);
  26  print OUT <<"END";
  27  newCONSTSUB(stash,"$sym",newSViv($sym));
  28  av_push(export_ok,newSVpv("$sym",$l));
  29 END
  30 }