#!/usr/bin/perl

# Parse cmdline and give a usage message.
my ($origfile, $newfile) = @ARGV;
if (!defined $newfile) {
  print "Usage: japicompat.pl <original api> <api to check>\n";
  exit 1;
}

# Read the "new" API and store all the details in one giant hashref, $new. The
# "new" one is parsed first because we need to check that an entry exists in new
# for every entry in orig.
open IN, $newfile or die "Could not open $newfile";
while (<IN>) {
  chomp;

  # Parse and interpret the entry.
  my ($item, $access, $abstract, $static, $final, $type) = split / /, $_, 6;
  my ($class, $member) = split /#/, $item, 2;
  my $isa;
  if ($member eq "") {
    $isa = $type =~ /class/ ? "class" : "interface";
  } elsif ($member =~ /^\(.*\)$/) {
    $isa = "constructor";
  } elsif ($member =~ /\(.*\)$/) {
    $isa = "method";
  } else {
    $isa = "field";
  }

  # Store information about the entry in $new->{$item}.
  $new->{$item}->{isa} = $isa;
  $new->{$item}->{class} = $class;
  $new->{$item}->{member} = $member;
  $new->{$item}->{access} = $access;
  $new->{$item}->{abstract} = $abstract;
  $new->{$item}->{static} = $static;
  $new->{$item}->{final} = $final;

  # Classes and interfaces have superclasses and implemented interfaces tacked
  # on to the "type" field. We store this information in the $new hash also.
  if ($member eq "") {

    # Get the interfaces data, which is separated by '*'s from the classname.
    my @ifaces = split(/\*/, $type);
    $type = shift @ifaces;
    foreach my $iface (@ifaces) {
      $new->{$item}->{ifaces}->{$iface} = 1;
    }

    # Get the class's superclasses, which are separated by ':'s.
    my @supers = split(/:/, $type);
    $type = shift @supers;
    foreach my $super (@supers) {
      $new->{$item}->{supers}->{$super} = 1;
    }

  # Methods and constructors have exceptions that can be thrown separated by
  # '*'s from the typename. These also need to get stored in the $new hash.
  } elsif ($member =~ /\(.*\)$/) {
    my @excps = split(/\*/, $type);
    $type = shift @excps;
    foreach my $excp (@excps) {
      $new->{$item}->{excps}->{$excp} = 1;
    }
  }

  # Store what's left of the type after parsing off all of those parts.
  $new->{$item}->{type} = $type;
}
close IN;

# FIXME: All of this big section, where the hard work is done, needs commenting.
open IN, $origfile or die "Could not open $origfile";
$errs=0; %missing=(); %bad=(); %good=();
while (<IN>) {
  chomp;
  my ($item, $access, $abstract, $static, $final, $type) = split / /, $_, 6;
  my ($class, $member) = split /#/, $item, 2;
  my $isa;
  if ($member eq "") {
    $isa = $type =~ /class/ ? "class" : "interface";
  } elsif ($member =~ /^\(.*\)$/) {
    $isa = "constructor";
  } elsif ($member =~ /\(.*\)$/) {
    $isa = "method";
  } else {
    $isa = "field";
  }
  $nitem = $new->{$item};
  $errhere = 0;
  unless (defined($nitem)) {
    unless ($missclass->{$class}) {
      print "$isa $item not defined in $newfile\n";
      $errs++; $missing{$isa}++;
    }
    if ($member eq "") {
      $missclass->{$class} = 1;
    }
    next;
  }
  if ($access eq "public" && $nitem->{access} ne "public") {
    print "$isa $item is public in $origfile but protected in $newfile\n";
    $errs++; $errhere++;
  }
  if ($abstract eq "concrete" && $nitem->{abstract} ne "concrete") {
    print "$isa $item is concrete in $origfile but abstract in $newfile\n";
    $errs++; $errhere++;
  }
  if ($static ne $nitem->{static}) {
    print "$isa $item is $static in $origfile but $nitem->{static} in $newfile\n";
    $errs++; $errhere++;
  }
  if ($final eq "nonfinal" && $nitem->{final} ne "nonfinal") {
    print "$isa $item is nonfinal in $origfile but final in $newfile\n";
    $errs++; $errhere++;
  }
  if ($member eq "") {
    my @ifaces = split(/\*/, $type);
    $type = shift @ifaces;
    foreach my $iface (@ifaces) {
      unless ($nitem->{ifaces}->{$iface}) {
        print "$isa $item implements $iface in $origfile but not in $newfile\n";
        $errs++; $errhere++;
      }
    }
    my @supers = split(/:/, $type);
    $type = shift @supers;
    my $super = shift @supers;
    if (defined $super and !$nitem->{supers}->{$super}) {
      print "$isa ${item}'s superclass $super in $origfile is not its superclass in $newfile\n";
      $errs++; $errhere++;
    }
  } elsif ($member =~ /\(.*\)/) {
    my @excps = split(/\*/, $type);
    my $excps = {};
    $type = shift @excps;
    foreach my $excp (@excps) {
      unless ($nitem->{excps}->{$excp}) {
        print "$isa $item throws $excp in $origfile but not in $newfile\n";
        $errs++; $errhere++;
      }
      $excps->{$excp} = 1;
    }
    foreach my $excp (keys %{$nitem->{exps}}) {
      unless ($excps->{$excp}) {
        print "$isa $item throws $excp in $newfile but not in $origfile\n";
        $errs++; $errhere++;
      }
    }
  }
  if ($type ne $nitem->{type}) {
    print "$isa ${item}'s type does not match between $origfile [$type] and $newfile [$nitem->{type}]\n";
    $errs++; $errhere++;
  }
  if ($errhere) {
    $bad{$isa}++;
  } else {
    $good{$isa}++;
  }
}

# Print summary information.
print <<EOF
Classes: $missing{class} missing, $bad{class} bad, $good{class} good.
Interfaces: $missing{interface} missing, $bad{interface} bad, $good{interface} good.
Fields: $missing{field} missing, $bad{field} bad, $good{field} good.
Constructors: $missing{constructor} missing, $bad{constructor} bad, $good{constructor} good.
Methods: $missing{method} missing, $bad{method} bad, $good{method} good.
Total Erros: $errs.
EOF