#!/usr/bin/perl

# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to You under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

# -----------------------------------------------------------------------------
# Compare the native API with native methods in the Java API.
# -----------------------------------------------------------------------------

# -----------------------------------------------------------------------------
# TODO:
# - use method name plus return type plus args as key instead of
#   only method name
# -----------------------------------------------------------------------------
# 

use strict;

# Modules needed, should all be standard

# Commandline option parsing
use Getopt::Std;
# dirname function
use File::Basename;
# Traverse through directory structure and execute
# callback for each file
use File::Find;
# Platform agnostic concatenation of directory and file names
use File::Spec::Functions;

################### BEGIN VARIABLES WHICH MUST BE MAINTAINED #####################

# Script version, printed via getopts with "--version"
our $VERSION = '1.0';

# Sub directories containing c native API and Java classes.
# Path relative to tcnative main project directory.
my $C_NATIVE_SUBDIR = 'native';
my $JAVA_API_SUBDIR = 'java';

# Macro used for marking C native API
my $C_NATIVE_DECLARATION = 'TCN_IMPLEMENT_CALL';

# Macro used for marking C native API arguments
my $C_NATIVE_ARGUMENTS = 'TCN_STDARGS';

################### END VARIABLES WHICH MUST BE MAINTAINED #####################

# Global data variables

# Print verbose output?
my $verbose = 0;

# Signature structures
my %cSignature;
my %javaSignature;


# Usage/Help
sub HELP_MESSAGE {
    my $fh = shift;
    print $fh "Usage:: $0 [ -h ] [ -v ] [ -d DIRECTORY ]\n";
    print $fh "           -h: Print help\n";
    print $fh "           -v: Verbose output\n";
    print $fh " -d DIRECTORY: Path to tcnative project main directory.\n";
    print $fh "               Default is '..\\..' relative to the script directory \n";
}


# Parse arguments:
# -h: help
# -v: verbose
# -d: tcnative project main directory

$Getopt::Std::STANDARD_HELP_VERSION = 1;
our ($opt_h, $opt_v, $opt_d);
getopts('hvd:');

if ($opt_h) {
    HELP_MESSAGE(*STDOUT);
    exit 1;
}

if ($opt_v) {
    $verbose = 1;
}

my $directory = $opt_d;
if (!defined($directory) || $directory eq '') {
    $directory = dirname($0);
    $directory = catfile($directory, ('..', '..'));
}

if (! -d $directory) {
    print STDERR "Invalid tcnative project directory '$directory' - Aborting!\n";
    exit 1;
}

sub mapTypes {
    my $types = shift;
    # Replace "Array" by "[]"
    $types =~ s/Array/\\[\\]/g;
    # Remove leading "j" from scalar types
    $types =~ s/j(byte|short|int|long|boolean)/$1/g;
    # Replace string type
    $types =~ s/jstring/String/g;
    # Replace object type with pattern
    $types =~ s/jobject/([A-Z][A-Za-z0-9]*|[a-z]+\\[\\])/g;
    return $types;
}

# Extract C native API from one file
sub cNativeApi {

    # Only check C source files
    return if $_ !~ /\.c$/;

    my $file = $_;
    my ($m, $signature, $type, $args, $ret, $class, $method);

    print "Checking C API file $file\n" if $verbose;
    open(IN, "<$file") or do {
        print "ERROR: Ignoring file '$file', could not open file for read: $!\n";
        return;
    };

    while(<IN>) {

        # Example declaration:
        #TCN_IMPLEMENT_CALL(jlong, Socket, create)(TCN_STDARGS, jint family,
        #                                          jint type, jint protocol,
        #                                          jlong pool)
        if ($_ =~ /^\s*$C_NATIVE_DECLARATION\s*/o) {
            chomp();
            $signature = $_;
            # Concat next line until signature is complete
            while($signature !~ /\([^\)]*\)\s*\([^\)]*\)/ && $signature !~ /;/ && ($_ = <IN>)) {
                chomp();
                $signature .= $_;
            }

            # Strip C-style comments. See: "perldoc -q comment"
            $signature =~ s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#defined $2 ? $2 : ""#gse;

            # Save one declaration
            if ($signature =~ /^\s*$C_NATIVE_DECLARATION\s*\(([^\)]*)\)\s*\(([^\)]*)\)/) {
                ($type, $args) = ($1, $2);

                # Normalize return type and method name
                # Collapse multiple spaces
                $type =~ s/\s+/ /g;
                # Remove spaces around commas
                $type =~ s/, /,/g;
                $type =~ s/ ,/,/g;
                # Trim spaces at start and end
                $type =~ s/^ //;
                $type =~ s/ $//;

                ($ret, $class, $method) = split(/,/, $type);

                # Map return type
                $ret = mapTypes($ret);

                # Normalize argument list
                # Collapse multiple spaces
                $args =~ s/\s+/ /g;
                # Remove spaces around commas
                $args =~ s/, /,/g;
                $args =~ s/ ,/,/g;
                # Remove argument names, only types are needed
                $args =~ s/ [^, ]+//g;
                # Trim spaces at start and end
                $args =~ s/^ //;
                $args =~ s/ $//;
                # Remove leading JNI arguments macro
                $args =~ s/^$C_NATIVE_ARGUMENTS,?//o;

                # Map argument list types
                $args = mapTypes($args);

                $m = $cSignature{$class};
                if (!defined($m)) {
                    $m = $cSignature{$class} = {};
                }
                if (exists($m->{$method}) && ($m->{$method}->{return} ne $ret || $m->{$method}->{args} ne $args)) {
                    print "ERROR: C native file $file method $method in class $class will be overwritten!";
                    print "\tOld signature: '$m->{$method}->{return} $m->{$method}->{method}($m->{$method}->{args})\n";
                    print "\tNew signature: '$ret $method($args)\n";
                }
                # XXX Use method plus ret plus args as key instead
                $m = $m->{$method} = {};
                $m->{method} = $method;
                $m->{return} = $ret;
                $m->{args} = $args;
                print "\tFound C API in $file class $class: '$m->{return} $m->{method}($m->{args})'\n" if $verbose;
            } else {
                print "ERROR: Incomplete C signature in file $file ignored in '$signature'";
            }
        }
    }

    close(IN);
}

# Extract native methods in Java API from one file
sub javaNativeApi {

    # Only check Java source files
    return if $_ !~ /\.java$/;

    my $file = $_;
    my ($m, $signature, $type, $args, $ret, $class, $method);

    print "Checking Java API file $file\n" if $verbose;
    open(IN, "<$_") or do {
        print "ERROR: Ignoring file '$file', could not open file for read: $!\n";
        return;
    };

    $class = $file;
    $class =~ s/\.java$//;

    while(<IN>) {

        # Example declaration
        #public static native long uid(String username, long p)
        #       throws Error;
        if ($_ =~ /^\s*((public|protected|private)\s+)?([^\(]*)\(/ && ($type = $3) && $type =~ /\snative\s/) {
            chomp();
            $signature = $_;
            # Concat next line until signature is complete
            while($signature !~ /\([^\)]*\)/ && $signature !~ /;/ && ($_ = <IN>)) {
                chomp();
                $signature .= $_;
            }

            # Save one declaration
            if ($signature =~ /^\s*([^\(]+)\(([^\)]*)\)/) {
                ($type, $args) = ($1, $2);

                # Normalize return type and method name
                # Remove unused specifiers
                $type =~ s/\b(public|protected|private)\b//g;
                $type =~ s/\bnative\b//g;
                $type =~ s/\bstatic\b//g;
                # Collapse multiple spaces
                $type =~ s/\s+/ /g;
                # Trim spaces at start and end
                $type =~ s/^ //;
                $type =~ s/ $//;

                ($ret, $method) = split(/\s+/, $type);

                # Normalize argument list
                # Collapse multiple spaces
                $args =~ s/\s+/ /g;
                # Remove spaces around commas
                $args =~ s/, /,/g;
                $args =~ s/ ,/,/g;
                # Remove spaces in front of array "[]"
                $args =~ s/ \[\]/[]/g;
                # Remove argument names, only types are needed
                $args =~ s/ [^, ]+//g;
                # Trim spaces at start and end
                $args =~ s/^ //;
                $args =~ s/ $//;

                $m = $javaSignature{$class};
                if (!defined($m)) {
                    $m = $javaSignature{$class} = {};
                }
                if (exists($m->{$method})) {
                    print "ERROR: Java file $file method $method in class $class will be overwritten!";
                    print "\tOld signature: '$m->{$method}->{return} $m->{$method}->{method}($m->{$method}->{args})\n";
                    print "\tNew signature: '$ret $method($args)\n";
                }
                # XXX Use method plus ret plus args as key instead
                $m = $m->{$method} = {};
                $m->{method} = $method;
                $m->{return} = $ret;
                $m->{args} = $args;
                print "\tFound native Java API in $file class $class: '$m->{return} $m->{method}($m->{args})'\n" if $verbose;
            } else {
                print "ERROR: Incomplete Java signature in file $file ignored in '$signature'";
            }
        }
    }

    close(IN);
}

# Search for C native API
find(\&cNativeApi, catfile($directory, $C_NATIVE_SUBDIR));
# Search for native methods in Java API
find(\&javaNativeApi, catfile($directory, $JAVA_API_SUBDIR));

print "Comparing C and Java APIs...\n";

# Check whether all native methods have correct Java counterparts
for my $class (sort keys %cSignature) {
    my $c = $cSignature{$class};
    my $j = $javaSignature{$class};
    if (!defined($j)) {
        print "ERROR: No Java API defined for class '$class'\n";
        for my $method (sort keys %{$c}) {
            my $m = $c->{$method};
            print "\tMissing Java method: $m->{return} $m->{method}($m->{args})\n";
        }
    } else {
        for my $method (sort keys %{$c}) {
            my $m = $c->{$method};
            if (!exists($j->{$method})) {
                print "ERROR: Missing Java method in class '$class': $m->{return} $m->{method}($m->{args})\n";
            } else {
                my $n = $j->{$method};
                if ($n->{return} !~ /^$m->{return}$/ || $n->{args} !~ /^$m->{args}$/) {
                    print "ERROR: Incompatible API in class '$class'!\n";
                    print "\tC signature: $m->{return} $m->{method}($m->{args})\n";
                    print "\tJava signature: $n->{return} $n->{method}($n->{args})\n";
                }
                delete($j->{$method});
            }
        }
    }
}

# Check whether any native Java API methods remain
for my $class (sort keys %javaSignature) {
    my $j = $javaSignature{$class};
    my $c = $cSignature{$class};
    if (!defined($c)) {
        print "ERROR: No C API defined for class '$class'!\n";
        for my $method (sort keys %{$j}) {
            my $m = $j->{$method};
            print "\tMissing C method: $m->{return} $m->{method}($m->{args})\n";
        }
    } else {
        for my $method (sort keys %{$j}) {
            my $m = $j->{$method};
            if (!exists($c->{$method})) {
                print "ERROR: Missing C method in class '$class': $m->{return} $m->{method}($m->{args})\n";
            } else {
                my $n = $c->{$method};
                if ($m->{return} !~ /^$n->{return}$/ || $m->{args} !~ /^$n->{args}$/) {
                    print "ERROR: Incompatible API in class '$class'!\n";
                    print "\tC signature: $n->{return} $n->{method}($n->{args})\n";
                    print "\tJava signature: $m->{return} $m->{method}($m->{args})\n";
                }
                delete($c->{$method});
            }
        }
    }
}

print "Done.\n";