#!/usr/bin/perl

use strict;
use Data::Dumper;

my @original_tokens = ();
my @clean_tokens = ();
my @packages = ();
my %packages = ();
my @node_array = ();
my %node_index = ();
my $node_count = 0;
my $file_count = 0;
my %class_path = ();

sub usage {
  print <<EOT;
Usage:

$0 [--prefix=<source file prefix] source1.java [source2.java ...]

Generates code suitable for inclusion by the cook tool to express java
dependencies and compute all the names of all the class files generated
by the given set of java source files.
EOT
  exit 0;
}

sub slurp_file {
  my $file = shift;
  open(F, $file) || return;

  $file_count++;
  push(@original_tokens, '##file##', $file);
  # slurp in file, split by obvious tokens...
  while (<F>) {
    for my $token (split(/([^a-zA-Z0-9_.])/)) {
      # ignore white spaces
      push(@original_tokens, $token) if $token =~ /\S/;
    }
    # keep newlines for // comment processing
    push(@original_tokens, "\n");
  }
  close(F);
}

sub do_clean {
  my $token;
  my $count = 0;
 NonBlankToken:
  # remove strings and comments
  while (defined($token = shift(@original_tokens))) {
    if ($token eq '##file##') {
      $count++;
      push(@clean_tokens, $token);
    } elsif ($token eq "\\") {
      shift(@original_tokens);
    } elsif ($token eq '"') {
    DoubleQuote:
      while (defined($token = shift(@original_tokens))) {
	if ($token eq "\\") {
	  shift(@original_tokens);
	} elsif ($token eq '"') {
	  last DoubleQuote;
	}
      }
    } elsif ($token eq "'") {
    SingleQuote:
      while (defined($token = shift(@original_tokens))) {
	if ($token eq "\\") {
	  shift(@original_tokens);
	} elsif ($token eq "'") {
	  last SingleQuote;
	}
      }
    } elsif ($token eq '/') {
      $token = shift(@original_tokens);
      if ($token eq '/') { # //
      LineComment:
	while (defined($token = shift(@original_tokens))) {
	  last LineComment if $token eq "\n";
	}
      } elsif ($token eq '*') { # /*
      Cstyle:
	while (defined($token = shift(@original_tokens))) {
	  while ($token eq '*') {
	    $token = shift(@original_tokens);
	    last Cstyle if $token eq '/'; # */
	  }
	}
      } else {
	unshift(@original_tokens, $token);
	push(@clean_tokens, '/');
      }
    } elsif ($token =~ /^\s*$/) {
      next NonBlankToken;
    } else {
      push(@clean_tokens, $token);
    }
  }
}

sub do_packages {
  my $token;
  my $package = undef;
  my $file = undef;
  my $count = 0;

 PackageToken:
  while (defined($token = shift(@clean_tokens))) {
    if ($token eq 'import') {
      my $import = '';
    ImportPackage:
      while (defined($token = shift(@clean_tokens))) {
	if ($token eq ';') {
	  last ImportPackage;
	} else {
	  $import .= $token;
	}
      }
      $package->{Imports}->{$import} = 1;
    } elsif ($token eq '##file##') {
      $file = shift(@clean_tokens);
      $count++;
    } elsif ($token eq 'package') {
      if (defined($package)) {
	$packages{$package->{Name}} = $package;
      }
      $package = { Name => '',
		   File => $file,
		   Imports => {},
		   Classes => {} };
    PackageName:
      while (defined($token = shift(@clean_tokens))) {
	if ($token eq ';') {
	  if ($file =~ m,([^/]*).java$,) {
	    $package->{Name} .= ".$1";
	  }
	  $file = undef;
	  last PackageName;
	} else {
	  $package->{Name} .= $token;
	}
      }
    } elsif ($token eq 'class' || $token eq 'interface') {
      my $class = do_class($package, shift(@clean_tokens));
      $package->{Classes}->{$class} = 1 if defined($class);
    }
  }
  if (defined($package)) {
    $packages{$package->{Name}} = $package;
  }
}

sub do_class {
  my $package = shift;
  my $current_class = shift;
  my $anonymous = 0;
  my $token;

 Preamble:
  while (defined($token = shift(@clean_tokens))) {
    last Preamble if $token eq '{';
  }

  my $brace_depth = 0;

 ClassToken:
  while (defined($token = shift(@clean_tokens))) {
    if ($token eq 'class' || $token eq 'interface' ) {
      my $inner_class = shift(@clean_tokens);
      my $class = do_class($package, $current_class.'$'.$inner_class);
      $package->{Classes}->{$class} = 1 if defined($class);
    } elsif ($token eq '{') {
      $brace_depth++;
    } elsif ($token eq '}') {
      if ($brace_depth == 0) {
	return $current_class;
      } else {
	$brace_depth--;
      }
    } elsif ($token eq 'new') {
      my $is_array = 0;
    AnonClassToken:
      while (defined($token = shift(@clean_tokens))) {
	if ($token eq ';') {
	  last AnonClassToken;
	} elsif ($token eq '[') {
	  $is_array = 1;
	} elsif ($token eq '}') {
	  $brace_depth--;
	} elsif ($token eq '{') {
	  if ($is_array) {
	    $brace_depth++;
	  } else {
	    unshift(@clean_tokens, $token);
	    $anonymous++;
	    my $class = do_class($package, $current_class.'$'.$anonymous);
	    $package->{Classes}->{$class} = 1 if defined($class);
	    last AnonClassToken;
	  }
	}
      }
    }
  }
}

my $prefix = '';
my $parse_options = 1;
while (my $arg = shift) {
  if ($parse_options) {
    if ($arg =~ /^--prefix=(.*)/) {
      $prefix = $1;
    } elsif ($arg eq '--prefix') {
      $prefix = shift;
    } elsif ($arg eq '--') {
      $parse_options = 0;
    } elsif (index($arg, '-') == 0) {
      usage;
    } else {
      slurp_file($arg);
    }
  } else {
    slurp_file($arg);
  }
}

if ($prefix) {
  $prefix .= '/' unless $prefix =~ m:/$:;
}

do_clean;
do_packages;

while (my($package, $data) = each(%packages)) {
  next unless exists($data->{Name});
  my $dir = $data->{Name};
  $dir =~ s:\.:/:g;
  $dir =~ s:[^/]*$::;
  my $class_dir = $data->{File};
  $class_dir =~ s:[^/]*$::;
  unless (index($class_dir, "$prefix$dir/") == 0) {
    print STDERR "Not in proper location, skipping .java file:\n  $data->{File}\n";
    next;
  }

  print "'requirements_of_$prefix' = [defined-or-null 'requirements_of_$prefix']\n";
  for my $import (keys(%{$data->{Imports}})) {
    $import =~ s:\.:/:g;
    next if index($import, 'java/') == 0;
    print " '$import'\n";
  }
  print ";\n";
  print "'class_files_for_$prefix' = [defined-or-null 'class_files_for_$prefix']\n";
  for my $class (keys(%{$data->{Classes}})) {
    print " '$class_dir$class.class'\n";
  }
  print ";\n";

  for my $class (keys(%{$data->{Classes}})) {
    print <<EOT;
if [defined 'provider_of_$dir$class'] then {
  if [not [in '$dir$class' [multiple_providers]]] then multiple_providers += '$dir$class';
  'provider_of_$dir$class' += '$prefix';
} else {
  'provider_of_$dir$class' = '$prefix';
}
EOT
  }
}