#!/usr/bin/perl

sub usage
{
  print <<EOT;
Usage:

$0 [--prefix=<common-prefix-of-class-file-locations>] [path-to-classfile1.class ...]

Generates code useful for inclusion in the cook autobuild environment,
containing all static dependencies which can be extracted out of the
constants section in the byte code of the specified java class files.
EOT
  exit 0;
}

use IO::File;

my %classes = ();
my %file_seen = ();

my @bytes = ();

sub u1 {
  my $val = shift(@bytes);
  return $val
}

sub u2 {
  my $val = u1() * 256 + u1();
  return $val
}

sub u4 {
  my $val = u2() * 256 * 256 + u2();
  return $val
}

my $parse_options = 1;
my $prefix = '';

while (my $arg = shift) {
  my @files = ();
  if ($parse_options) {
    if ($arg =~ /^\@(.*)/) {
      my $listfile = $1;
      unless (open(F, $listfile)) {
        print STDERR "Failed to open - skipping: $arg\n";
        next;
      }
      while (<F>) {
        chomp;
        push(@files, $_);
      }
      close(F);
    } elsif ($arg =~ /^--prefix=(.*)/) {
      $prefix = $1;
    } elsif ($arg eq '--prefix') {
      $prefix = shift;
    } elsif ($arg eq '--') {
      $parse_options = 0;
    } elsif (index($arg, '-') == 0) {
      usage;
    } else {
      push(@files, $arg);
    }
  } else {
    push(@files, $arg);
  }

  for my $file (@files) {
    $file_seen{$file}++;

    my $fh = new IO::File;
    unless (sysopen($fh, $file, 0)) {
      print STDERR "Failed to open - skipping: $file\n";
      next;
    }

    my $buf;
    my $off = 0;
    while (my $bytes_read = sysread($fh, $buf, 1024, $off)) { $off += $bytes_read; }
    undef $fh;
    @bytes = map(ord($_), split(//, $buf));
  
    my @class_ref = ();
    my @class_name = ();
  
    # magic = 4
    my $magic = u4();
    unless ($magic == 0xCAFEBABE) {
      print STDERR "Not a .class file - skipping: $file\n";
      next;
    }

    # minor version = 2 major version = 2
    u2();
    u2();
  
    # constant_pool_count
    my $constant_pool_count = u2();
  
    for (my $i = 1; $i < $constant_pool_count; $i++) {
      my $tag = u1();

      $class_name[$i] = undef;

      if ($tag == 7) {
        # CONSTANT_Class 	7
        push(@class_ref, u2());
      } elsif ($tag == 9 || $tag == 10 || $tag == 11) {
        # CONSTANT_Fieldref 	9
        # CONSTANT_Methodref 	10
        # CONSTANT_InterfaceMethodref 	11
        u2(); # class_index
        u2(); # name_and_type_index
      } elsif ($tag == 8) {
        # CONSTANT_String 	8
        u2(); # string_index
      } elsif ($tag == 3 || $tag == 4) {
        # CONSTANT_Integer 	3
        # CONSTANT_Float 	4
        u4(); # value
      } elsif ($tag == 5 || $tag == 6) {
        # CONSTANT_Long 	5
        # CONSTANT_Double 	6
        u4(); # high bytes
        u4(); # low bytes
      } elsif ($tag == 12) {
        # CONSTANT_NameAndType 	12
        u2(); # name_index
        u2(); # descriptor_index
      } elsif ($tag == 1) {
        # CONSTANT_Utf8 	1
        my $l = u2();
        my $s = '';
        while ($l--) {
          $s .= chr(u1());
        }
        $class_name[$i] = $s;
      }
    }

    for my $ref (@class_ref) {
      my $name = $class_name[$ref];
      push(@{$classes{$name}}, $file)
        if $name !~ /[\.\(\)\[\]IL\;\:\#]/ && $name =~ /^[a-z][a-z0-9]*\//;
    }
  }
}

my %wildcard_imports = ();

for my $file (keys(%file_seen)) {
  my $class = $file;
  $class =~ s:^$prefix(.*)\.class$:$1:;
  print <<EOT;
if [defined 'provider_of_$class'] then {
  if [not [in '$class' [multiple_providers]]] then multiple_providers += '$class';
  'provider_of_$class' += '$prefix';
} else {
  'provider_of_$class' = '$prefix';
}
EOT
  $class =~ s:[^/]*$:\*:;
  next if exists($wildcard_imports{$class});
  $wildcard_imports{$class} = 1;
  print <<EOT;
if [defined 'provider_of_$class'] then {
  if [not [in '$class' [multiple_providers]]] then multiple_providers += '$class';
  'provider_of_$class' += '$prefix';
} else {
  'provider_of_$class' = '$prefix';
}
EOT
}

print "'requirements_of_$prefix' =\n";
while (my($class, $files) = each(%classes)) {
  next if index($class, 'java/') == 0; # skip over built-ins
  unless (exists($file_seen{"$prefix$class.class"})) {
    print "'$class'\n  /* ".join(" */\n  /* ", @$files)." */\n";
  }
}
print ";\n";