# -*- mode: perl; coding: utf-8; tab-width: 4 -*-
use strict;
our %cv;
our %CLASS;
our %force = (
'cvGetWindowName' => 'Cv',
'cvClone' => 'Cv',
'cvFree' => 'Cv',
'cvRelease' => 'Cv',
'cvTypeOf' => 'Cv',
);
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 = /cvCvtColor/;
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;
push(@decl, decl_cfunction($decl));
hack_class($decl[-1]);
}
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 = ();
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;
}
sub hack_class {
local $_ = shift;
return undef unless $_;
my $name = $_->[0]->[1];
if ($CLASS{$name} = $force{$name}) {
;
} elsif (@{$_} == 1) {
$CLASS{$name} = "Cv";
} else {
no warnings;
my $type = ${${$_}[1]}[0];
$type =~ s/^(IN)\s*//;
$type =~ s/^(OUT|INOUT)\s*(.*)/$1\&/;
if ($name =~ /^cvRelease/) {
$type =~ s/\s*\*\s*\*$/\*\&/;
} elsif ($name =~ /^cv.*Contour/) {
if ($type =~ /CvContourScanner/) {
$type =~ s/\s*\*$/\&/;
}
}
if ($type =~ /^(const\s+)?(void|VOID)\*(\s*\&)?$/) {
$CLASS{$name} = "Cv::Arr";
} elsif ($type =~ /^(const\s+)?(Cv)(ContourScanner)(\s*\&)?$/) {
$CLASS{$name} = "Cv::$3";
} elsif ($type =~ /^(const\s+)?(void|VOID)\s*\*(\s*\&)?$/) {
$CLASS{$name} = "Cv::Arr";
} elsif ($type =~ /^(const\s+)?(Cv)(ContourScanner)(\s*\&)?$/) {
$CLASS{$name} = "Cv::$3";
} elsif ($type =~ /^(const\s+)?(Cv)(Point[\w\d]*)\s*\*(\s*\&)?$/) {
$CLASS{$name} = "Cv";
} elsif ($type =~ /^(const\s+)?(Cv|Ipl)(\w+)\s*\*(\s*\&)?$/) {
$CLASS{$name} = "Cv::$3";
if ($CLASS{$name}->can('dst')) {
unless ($name =~ /Clone|Clear|Release/) {
$CLASS{$name} = "Cv::Arr";
}
}
} elsif ($type =~ /^(const\s+)?(\w+)(|\*|\*\*)$/) {
$CLASS{$name} = "Cv";
} else {
my $args = @{$_} == 0 ? 'void' :
join(', ', map { join(' ', @$_) } @{$_}[1..$#{$_}]);
my $cproto = join(' ', @{${$_}[0]}), "($args)";
ok(0, $cproto);
}
}
return $CLASS{$name};
}
1;