The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
# -*- mode: perl; coding: utf-8; tab-width: 4 -*-

use strict;

use IO::File;
use File::Basename;
use File::Find;
use Data::Dumper;

use Getopt::Long;
my %opts;

GetOptions (
	"dump=s@"    => \$opts{dump},
	"tex"        => \$opts{tex},
	"html"       => \$opts{html},
	"rst"        => \$opts{rst},
	"packages=s@" => \$opts{packages},
	"verbose+"   => \$opts{verbose},
	);

our %cv;
our $CV_VERSION = undef;
our %file;

if ($opts{html}) {
	find(sub { parse_htm($_) if /\.htm$/;
			   parse_ver($_) if /version\.hpp$|cvver\.h$/;
		 }, @ARGV); # OpenCV-1
} elsif ($opts{tex}) {
	find(sub { parse_tex($_) if /\.tex$/;
			   parse_ver($_) if /version\.hpp$|cvver\.h$/;
		 }, @ARGV); # OpenCV-2.[0-2]
} else {
	find(sub { parse_rst($_) if /\.rst$/;
			   parse_ver($_) if /version\.hpp$|cvver\.h$/;
		 }, @ARGV); # OpenCV-2.[3-4]
}

# print STDERR "version = $CV_VERSION\n";

if ($CV_VERSION =~ /^2\.[0-2]/) {

	$cv{cvSampleLine} = [
		[ 'int', 'cvSampleLine' ],
		[ 'const CvArr*', 'image' ],
		[ 'CvPoint', 'pt1' ],
		[ 'CvPoint', 'pt2' ],
		[ 'void*', 'buffer' ],
		[ 'int', 'connectivity', '=8' ],
		];

	$cv{cvImgToObs_DCT} = [
		[ 'void', 'cvImgToObs_DCT' ],
		[ 'IplImage*', 'image' ],
		[ 'float*', 'obs' ],
		[ 'CvSize', 'dctSize' ],
		[ 'CvSize', 'obsSize' ],
		[ 'CvSize', 'delta' ],
		];

	$cv{cvGoodFeaturesToTrack} = [
	    [ 'void', 'cvGoodFeaturesToTrack' ],
	    [ 'const CvArr*', 'image' ],
	    [ 'CvArr*', 'eig_image' ],
	    [ 'CvArr*', 'temp_image' ],
	    [ 'CvPoint2D32f*', 'corners' ],
	    [ 'int*', 'corner_count' ],
	    [ 'double', 'quality_level' ],
	    [ 'double', 'min_distance' ],
	    [ 'const CvArr*', 'mask', '=NULL' ],
	    [ 'int', 'block_size', '=3' ],
	    [ 'int', 'use_harris', '=0' ],
	    [ 'double', 'k', '=0.04' ],
		];

}

if ($CV_VERSION =~ /^2\.[1-3]/) {

	$cv{cvGetHistValue_1D} = [
		[ 'float*', 'cvGetHistValue_1D' ],
		[ 'CvHistogram*', 'hist' ],
		[ 'int', 'idx0' ],
		];
	$cv{cvGetHistValue_2D} = [
		[ 'float*', 'cvGetHistValue_2D' ],
		[ 'CvHistogram*', 'hist' ],
		[ 'int', 'idx0' ],
		[ 'int', 'idx1' ],
		];
	$cv{cvGetHistValue_3D} = [
		[ 'float*', 'cvGetHistValue_3D' ],
		[ 'CvHistogram*', 'hist' ],
		[ 'int', 'idx0' ],
		[ 'int', 'idx1' ],
		[ 'int', 'idx2' ],
		];
	$cv{cvGetHistValue_nD} = [
		[ 'float*', 'cvGetHistValue_nD' ],
		[ 'CvHistogram*', 'hist' ],
		[ 'int', 'idx[]' ],
		];
}

my %RENAME = (
	cvSize2D23f => q(cvSize2D32f),
	);

if ($opts{dump}) {
	if (@{$opts{dump}} == 1 &&
		${$opts{dump}}[0] =~ /^(full|all|yes)/i) {
		print Data::Dumper->Dump([\%cv, \%file], [qw(*cv *file)]);
	} else {
		print Data::Dumper->Dump([ $cv{$_} ], ["\$cv{$_}"])
			for (@{$opts{dump}});
	}
	print "1;\n";
} else {
	foreach (sort { $a->[0]->[1] cmp $b->[0]->[1] } values %cv) {
		my $args = @{$_}?
			join(', ', map { join(' ', @$_) } @{$_}[1..$#{$_}]) : 'void';
		print join(' ', @{${$_}[0]}), "($args)", "\n";
	}
}
							 
exit 0;


sub parse_ver {
	my $name = shift;
	return unless my $file = IO::File->new($name);
	my %v;
	while (<$file>) {
		if (/\#define\s+(CV_(MAJOR|MINOR|SUBMINOR)_VERSION)\s+(\d+)/) {
			$v{$2} = $3;
		}
	}
	$CV_VERSION = "$v{MAJOR}.$v{MINOR}.$v{SUBMINOR}";
}

sub parse_htm {
	my $name = shift;
	return unless my $file = IO::File->new($name);
	my $cvfunc;
	my @pre;
	while (<$file>) {
		if (/\bname\s*=\s*"decl_(cv\w+)"/) {
			$cvfunc = $1;
		}
		if (/<pre>/ .. /<\/pre>/) {
			next unless $cvfunc;
			push(@pre, $_);
			next unless $& eq "<\/pre>";
			if (join('', @pre) =~ /<pre>(.*)<\/pre>/s) {
				# parse_decl($1);
				$file{$name}{$_->[0]->[1]} = $_ for parse_decl($1);
			}
			@pre = ();
			$cvfunc = undef;
		}
	}
}

sub parse_tex {
	my $name = shift;
	return unless my $file = IO::File->new($name);
	my @lines;
	while (<$file>) {
		s/[\\\/](par|newline)/ /sg;
		s/\\([\#_])/$1/g;
		s/\s+/ /g;
		if (/\\cvexp{/ .. /}/) {
			push(@lines, $_);
			next unless $& eq "}";
			if (join('', @lines) =~ /\\cvexp{([^}]*)}/s) {
				parse_decl($1);
			}
			@lines = ();
		}
		if (/\\cvdefC{/ .. /}/) {
			push(@lines, $_);
			next unless $& eq "}";
			if (join('', @lines) =~ /\\cvdefC{([^}]*)}/s) {
				# parse_decl($1);
				$file{$name}{$_->[0]->[1]} = $_ for parse_decl($1);
			}
			@lines = ();
		}
	}
}

sub parse_rst {
	my $name = shift;
	return unless my $file = IO::File->new($name);
	my @cfunctions; my %param;
	# local $/ = "\n\n";
	while (<$file>) {
		if (/^\s*$/) {
			;
		} elsif (/^\.\. ocv:cfunction::(.*)/) {
			# parse_decl($1);
			$file{$name}{$_->[0]->[1]} = $_ for parse_decl($1);
		}
	}
}

sub parse_decl {
	local $_ = shift;
	s/\/\*.*\*\///sg;
	s/#\s*define.*[^\\]\n//sg;
	s/#\s*define[^\n]+//sg;
	s/\btypedef[^{]*{[^}]+}\s*\w+\s*;//sg;
	s/\btypedef[^;]+;//sg;
	s/\s+/ /sg;
	my %x;
	my $i = 1;
	# my $debug = /(Get|Query)HistValue/;
	my $debug = 0;
	print STDERR "parse_decl:1: $_\n" if $debug;
	while (s{([^\(=,;]+)\(((?:(?!\()(?!\)).)*)\)}{%$i}sg) {
		print STDERR "parse_decl:2: $_\n" if $debug;
		$x{$i++} = "$1($2)";
	}
	print STDERR "parse_decl:3: $_\n" if $debug;
	s/(%\d+)/$1;/g;
	print STDERR "parse_decl:4: $_\n" if $debug;
	my @decl;
	foreach my $decl (split(/[,;]/)) {
		1 while ($decl =~ s/%(\d+)/$x{$1}/g);
		print STDERR "parse_decl:5: $decl\n" if $debug;
		if (my $d = decl_cfunction($decl)) {
			push(@decl, $d);
		}
	}
	wantarray? @decl : \@decl;
}

sub decl_cfunction {
	return undef unless (my $retval = shift) =~ s/\s*(\w[:\w]+)\s*\((.*)\)//s;
	my $name = $1; local $_ = $2;
	$retval =~ s/^\s+//s;
	$retval =~ s/\s+$//s;
	return undef unless $retval and $_;
	my @ST = ();
	if (my $ren = $RENAME{$name}) {
		$name = $ren;
	}
	push(@ST, [ $retval, $name ]);
	1 while (s/\(([^\(\)]*)\)/"\x02${ local $_ = $1; s{,}{;}g; \$_ }\x03"/ge);
	for (map { s/^\s+//; s/\s+$//; tr/\x02;\x03/(,)/; $_ } split(/,/)) {
		my ($init, $param);
		$init = $1 if s/\s*(=.*)$//;
		$param = $1 if s/\s*(\w+(\[[^\]]*\])?)$//;
		if ($param && $param ne 'void') {
			s/(\w)\s+(\w)/$1 $2/g;
			s/(\w|\*)\s+(\*)/$1$2/g;
			my @st = ($_, $param);
			push(@st, $init) if $init;
			push(@ST, \@st);
		}
	}
	$cv{$name} = \@ST;
}