#!/usr/bin/perl
# Author: Martin Lazar <mlazar@suse.cz>
#
# Generate IDL for perl2cpp from YaST TYPEINFO in perl module.
# usage: typeinfo2idl module.pl > module.idl

use strict;
no strict "refs";

our %INCLUDE;
our %unknown;
our %unsupported;

# recursivelly find all packages contains TYPEINFO
sub find_packages {
    my $preffix = shift;
    my %pkgs;
    foreach my $pkg (keys %{$preffix}) {
	next unless $pkg =~ /::$/;
	map {$pkgs{$_} = 1 } find_packages($preffix.$pkg) unless $pkg eq "main::";
        $pkgs{$preffix.$pkg} = 1 if %{"${preffix}${pkg}TYPEINFO"};
    }
    return keys %pkgs;
}

# convert TYPEINFO parameter type to perl2cpp parameter type
sub convertParam {
    my ($type, $func, $lvl) = @_;
    
    return "cpp_int" if $type eq "integer";
    return "cpp_bool" if $type eq "boolean";
    return "cpp_double" if $type eq "float";
    if ($type eq "string") {
	$INCLUDE{"<string>"} = 1;
	return "cpp_string";
    }

    if (ref($type) eq "ARRAY") {
	if ($type->[0] eq "list") {
	    my $inner = convertParam($type->[1], $func, $lvl||0+1);
	    $INCLUDE{"<deque>"} = 1;
	    return ($lvl ? "cpp_deque" : "cpp_ydeque") . ",$inner";
	} elsif ($type->[0] eq "map") {
	    if ($type->[1] ne "string") {
		$unsupported{$func}++;
		return undef;
	    }
	    my $inner2 = convertParam($type->[2], $func, $lvl||0+1);
    	    $INCLUDE{"<map>"} = 1;
	    return ($lvl ? "cpp_map" : "cpp_ymap") . ",$inner2";
	}
	$unknown{"[".join(",",@$type)."]"}{$func}++;
        return undef;
    }
    $unknown{$type}{$func}++;
    return undef;
}

# convert one TYPEINFO record for function to perl2cpp IDL
sub convertFunc {
    my ($pkg, $func, $typeinfo, $ALL_METHODS, $isMethod) = @_;
    my $out;
    (my $CPPNAME = $pkg) =~ s/.*:://;
    $out .= "[$func]\n";
    if ($isMethod && $func eq "new") {
	$out .= "CPPNAME = $CPPNAME\n";
	$out .= "PPACKAGE = $pkg\n";
	$out .= "RETURN = cpp_class_$CPPNAME\n";
    } else {
	$out .= "PNAME = ${pkg}::$func\n" unless $isMethod;
	$out .= "METHOD = 1\n" if $isMethod;
	if ($typeinfo->[1] ne "void") {
	    my $ret = convertParam($typeinfo->[1], $func);
	    return undef unless $ret;
	    $out .= "RETURN = $ret\n";
	}
    }
    my $first_arg = defined $ALL_METHODS && $ALL_METHODS == 0 && $isMethod && $func ne "new" ? 3 : 2;
    if ($typeinfo->[$first_arg]) {
	$out .= "PARAMS = <<EOT\n";
	foreach my $arg (@{$typeinfo}[$first_arg..$#$typeinfo]) {
	    my $ret = convertParam($arg, $func);
	    return undef unless $ret;
	    $out .= "$ret\n";
	}
	$out .= "EOT\n";
    }
    return "$out\n";
}

my $file = $ARGV[0];
require "$file";
my @pkgs = find_packages("main::");


foreach my $pkg (@pkgs) {
    $pkg =~ s/^(main::)?(.*?)(::)?$/$2/;
    my $t = \%{"${pkg}::TYPEINFO"};
    my $isClass = exists $t->{new};
    my $f;
    %unknown = ();
    %unsupported = ();
    foreach my $func (sort keys %$t) {
	next if $func eq "ALL_METHODS";
	$f .= convertFunc($pkg, $func, $t->{$func}, $t->{ALL_METHODS}, $isClass) || "";
    }

    foreach (keys %unknown) {
	my $warn = "Warning: Unknown data type '$_' in function(s): ".join(",",keys %{$unknown{$_}});
	print "# $warn\n";
	print STDERR "$warn\n";
    }

    if (%unsupported) {
	my $warn = "Warning: Unsupported data type in function(s): ".join(",",keys %unsupported);
	print "# $warn\n";
	print STDERR "$warn\n";
    }

#    (my $FILENAME = $pkg) =~ s|.*::||g;
    (my $FILENAME = $file) =~ s|^(.*/)?([^/.]*)(\.[^/]*)?$|$2|; # basename($file)
    (my $CPPCLASS = $pkg) =~ s|.*::||;

    print "\n[_GENERAL_]\n";
    print "FILENAME = $FILENAME\n";
    print "CPPCLASS = $CPPCLASS\n" if $isClass;
    print "INCLUDE = <<EOT\n" . join("",map{$_."\n"} sort keys %INCLUDE) ."EOT\n" if %INCLUDE;
    print "\n$f";
}

