sub cNativeApi()

in native/build/api.pl [125:215]
56 lines of code
14 McCabe index (conditional complexity)

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);
}