#!/usr/bin/env perl

use strict;
use warnings;

# TODO:
# - extract prototypes
# - extract typedefs to make typemap
# - extract enums for to make constant subs

use Alien::Leptonica;
use Path::Class;
use FindBin;
use autodie;

my $header_filepath = file($FindBin::Bin)->parent->subdir('lib', 'Image')->file('leptonica.h');
$header_filepath->dir->mkpath;
my $typemap_filepath = file($FindBin::Bin)->parent->file('typemap');

sub main {
	my $l = Alien::Leptonica->new;
	my ($header_dir) = $l->cflags =~ /-I(\S+)/;
	$header_dir = dir($header_dir);

	use DDP; p $header_filepath->stringify;
	use DDP; p $typemap_filepath->stringify;

	my $all_headers_file = $header_dir->file('allheaders.h');
	my $all_types_file = $header_dir->file('alltypes.h');

	# get prototypes
	my @protos = map { s/^LEPT_DLL\s*//r; } grep { /^LEPT_DLL/ } $all_headers_file->slurp();
	#use DDP; p @protos;

	# FIXME temporary removal to avoid `undefined symbol:
	# XS_unpack_charPtrPtr` message
	@protos = grep { $_ !~ /char\s*\*\*/ } @protos;

	my $typedefs = {};

	# get typedefs in all headers files
	my $types = $all_types_file->slurp;
	while($types =~ /#include "([^"]+)"/g) {
		# for all included headers
		my $filename = $1;
		my $header = $header_dir->file( $filename );
		if( -f $header ) {
			my $lines = $header->slurp;
			#use DDP; p $lines;
			my $line_typedefs = get_typedefs($lines);
			$typedefs = { %$typedefs, %$line_typedefs };
		}
	}
	
	# map each type to a Perl XS typemap type
	my $types_to_perl = {
		intptr_t => undef, # no external use
		l_int64 => 'T_LONG',
		l_intptr_t => undef, # no external use
		l_uint16 => 'T_U_SHORT',
		l_int32 => 'T_INT',
		l_float64 => 'T_DOUBLE',
		l_float32 => 'T_FLOAT',
		l_int16 => 'T_SHORT',
		l_int8 => 'T_CHAR',
		l_uint32 => 'T_U_INT',
		l_uint8 => 'T_U_CHAR',
		l_uint64 => 'T_U_LONG',
		"*L_TIMER" => undef, # parsing error :-/
		"L_TIMER" => 'T_PTR',
		l_uintptr_t => undef, # no external use
		uintptr_t => undef, # no external use
	};
	for my $type (keys %$typedefs) {
		my $perl_type;
		unless( exists $types_to_perl->{$type} ) {
			$types_to_perl->{$type} = 'T_PTROBJ';
		}
	}

	# write out pruned header file
	my $header_fh = $header_filepath->openw;
	for my $prototype (@protos) {
		print $header_fh $prototype;
	}


	# write out typemap
	my $typemap_fh = $typemap_filepath->openw;
	for my $type (sort keys %$types_to_perl) {
		print $typemap_fh "$type\t$types_to_perl->{$type}\n" if $types_to_perl->{$type};
	}
	0;
}



sub get_typedefs {
	my ($code) = @_;
	my $typedefs = {};
	while( $code =~ /^typedef\s+(.+?)\s+(\S+)\s*;/msg ) {
		my $typedef = $2;
		my $type = $1;
		push @{ $typedefs->{ $typedef } }, $type;
	}
	$typedefs;
}

main;
