Fixed the pod path in archive

[sdlgit/SDL_perl.git] / scripts / const.pl

#!/usr/bin/perl -w

# Since the sdl_const.pl and gl_const.pl scripts with 2.0-beta2 don't seem to
# work at all, this script takes SDL/Constans.pm and OpenGL/Constants.pm (as
# original from 2.0-beta2) and fixes them up, and moves them into ../lib/

# I already did this for 1.20.2, so you need to run this only if you intent
# to rebuild the .pm files.

# See http://Bloodgate.com/perl/sdl/sdl_perl.html

use strict;

##############################################################################

my $sdl = read_file('SDL/Constants.pm');

# remove 'main::' on subs
$sdl =~ s/sub main::([\w]+)/sub $1/g;

# turn on () on subs to make peep optimizer to inline them
#$sdl =~ s/sub ([\w]+)\s+{/sub $1 () {/g;

write_file('../lib/SDL/Constants.pm',insert_export($sdl));

undef $sdl;

##############################################################################

my $gl = read_file('OpenGL/Constants.pm');

# remove 'main::' on subs
$gl =~ s/sub main::([\w]+)/sub $1/g;

# turn on () on subs to make peep optimizer to inline them
#$gl =~ s/sub ([\w]+)\s+{/sub $1 () {/g;

write_file 
  ('../lib/SDL/OpenGL/Constants.pm',insert_export($gl,grep_constants()));

1;

sub read_file
  {
  my $file = shift;

  print "Reading $file...";
  my $FILE;
  open $FILE, $file or die ("Cannot read $file: $!\n");
  local $/;	# slurp mode
  my $doc = <$FILE>;
  close $FILE;
  print "done.\n";
  $doc;
  }

sub write_file
  {
  my ($file,$txt) = @_;

  print "Writing $file...";
  my $FILE;
  open $FILE, ">$file" or die ("Cannot write $file: $!\n");
  print $FILE $txt;
  close $FILE;
  print "done.\n";
  }

sub insert_export
  {
  my $txt = shift;

  my @sub = ();
  # gather all sub names
  $txt =~ s/sub ([\w]+)\s+/push @sub, $1; 'sub ' . $1 . ' '/eg;

  # if we got a second list of names, parse it and include anything that isn't
  # alreay in

  my $add = "";
  if (ref($_[0]) eq 'ARRAY')
    {
    my $const = shift;
    foreach my $c (sort @$const)
      {
      if ( grep (/^$c->[0]$/, @sub) == 0)
	{
	print "Adding $c->[0] $c->[1]\n";
        $add .= "sub $c->[0] () { $c->[1] }\n";
        push @sub, $c->[0];
	}
      }
    $add .= "\n";
    }

  # SDL/Constants.pm contains doubles :-( So filter them out.
  my @sorted = sort @sub;
  my $last; @sub = (); my @doubles;
  foreach my $cur (@sorted)
    {
    if (defined $last && $last eq $cur)
      {
      # double!
      push @doubles,$last;
      }
    else
      {
      push @sub, $last if defined $last;
      }
    $last = $cur;
    }
  foreach my $cur (@doubles)
    {
    $txt =~ s/\bsub $cur.*//g;	# remove
    }

  my $export = "require Exporter;\nuse strict;\n";
  $export .= "use vars qw/\$VERSION \@ISA \@EXPORT/;";
  $export .= "\n\@ISA = qw/Exporter/;\n";
  
  # this makes Exporter export the symbols from SDL::Constants to whatever
  # package used SDL::Constants (usually SDL::Event.pm)
  my $pack;
  if ($txt =~ /SDL::Constants/)
    {
    $txt =~ s/SDL::Constants/SDL::Event/g;
    $pack = 'SDL::Event';
    }
  if ($txt =~ /SDL::OpenGL::Constants/)
    {
    $txt =~ s/SDL::OpenGL::Constants/SDL::OpenGL/g;
    $pack = 'SDL::OpenGL';
    }
  $export .= "\nsub import { $pack\->export_to_level(1, \@_); }\n";

  $export .= "\n\@EXPORT = qw/\n";

  my $line = "\t";
  foreach my $s (sort @sub)
    {
    if (length($line)+length($s) > 70)
      {
      $export .= "$line\n"; $line = "\t";
      }
    $line .= "$s ";
    }
  $export .= "$line /;\n";

  # insert Exporter section
  $txt =~ s/sub/$export\n\n$add\nsub/;

  $txt;
  }

sub grep_constants
  {
  # grep all the OpenGL constants from SDL and return them

  my $sdl_gl = read_file('/usr/include/GL/gl.h');

  my @const = ();
  $sdl_gl =~ s/^#define (GL_.*?)\s+(0x[\da-fA-F]+)/push @const,[$1,$2];/egm;

  \@const; 
  }

END { print "\n"; }