#
# this is all hacky etc. it works so it's gonna stay for now. it is not and
# should not be installed.
#
# $Header: /cvs/cairo/cairo-perl/MakeHelper.pm,v 1.3 2005/08/31 22:00:15 tsch Exp $
#

package MakeHelper;

use strict;
use warnings;
use IO::File;
use File::Spec;

our $autogen_dir = '.';

# copied/borrowed from Gtk2-Perl's CodeGen
sub write_boot
{
	my %opts = (
		ignore => '^[^:]+$',	# ignore package with no colons in it
		filename => File::Spec->catdir ($autogen_dir,
						'cairo-perl-boot.xsh'),
		'glob' => File::Spec->catfile ('xs', '*.xs'),
		@_,
	);
	my $ignore = $opts{ignore};

	my $file = IO::File->new (">$opts{filename}")
		or die "Cannot write $opts{filename}: $!";

	print $file "\n\n/* This file is automatically generated, any changes made here will be lost! */\n\n";

	my %boot=();

	my @xs_files = 'ARRAY' eq ref $opts{xs_files}
	             ? @{ $opts{xs_files} }
	             : glob $opts{'glob'};

	foreach my $xsfile (@xs_files) {
		my $in = IO::File->new ($xsfile)
				or die "can't open $xsfile: $!\n";

		while (<$in>) {
			next unless m/^MODULE\s*=\s*(\S+)/;
			#warn "found $1 in $&\n";

			my $package = $1;

			next if $package =~ m/$ignore/;

			$package =~ s/:/_/g;
			my $sym = "boot_$package";
			print $file "CAIRO_PERL_CALL_BOOT ($sym);\n"
				unless $boot{$sym};
			$boot{$sym}++;
		}

		close $in;
	}

	close $file;
}

sub do_typemaps
{
	my %objects = %{shift ()};
	my %structs = %{shift ()};
	my %enums = %{shift ()};
	my %backend_macros = %{shift()};

	my $cairo_perl = File::Spec->catfile ($autogen_dir,
					      'cairo-perl-auto.typemap');
	open TYPEMAP, '>', $cairo_perl
		or die "unable to open ($cairo_perl) for output";

	print TYPEMAP <<EOS;
#
# This file was automatically generated.  Do not edit.
#

TYPEMAP

EOS

	sub type_id
	{
		my $ret = shift;
		$ret =~ s/ \*//;
		uc ($ret);
	}

	sub func_name
	{
		$_[0] =~ /cairo_(\w+)_t/;
		$1;
	}

	foreach (keys %objects, keys %structs, keys %enums)
	{
		print TYPEMAP "$_\t".type_id ($_)."\n";
		print TYPEMAP "const $_\t".type_id ($_)."\n";
	}

	foreach (keys %objects)
	{
		my $trunk = $_;
		$trunk =~ s/ \*//;

		print TYPEMAP "${trunk}_noinc *\t".type_id ($_)."_NOINC\n";
	}

	print TYPEMAP "\nINPUT\n\n";

	foreach (keys %objects)
	{
		print TYPEMAP type_id ($_).'
	if (sv_derived_from($arg, \"'.$objects{$_}.'\")) {
	    IV tmp = SvIV((SV*)SvRV($arg));
	    $var = INT2PTR($type,tmp);
	}
	else
	    Perl_croak(aTHX_ \"$var is not of type '.$objects{$_}.'\")

';
	}

	foreach (keys %structs)
	{
		print TYPEMAP type_id ($_).'
	if (sv_derived_from($arg, \"'.$structs{$_}.'\")) {
	    IV tmp = SvIV((SV*)SvRV($arg));
	    $var = INT2PTR($type,tmp);
	}
	else
	    Perl_croak(aTHX_ \"$var is not of type '.$structs{$_}.'\")

';
	}

	foreach (keys %enums)
	{
		print TYPEMAP type_id ($_).'
	$var = cairo_'.func_name ($_).'_from_sv ($arg);

';
	}

	print TYPEMAP "\nOUTPUT\n\n";

	my $ref;
	foreach (keys %objects)
	{
		/^(.*)_t \*/;
		$ref = $1.'_reference';
		print TYPEMAP type_id ($_)."
	$ref (".'$var);
	sv_setref_pv($arg, \"'.$objects{$_}.'\", (void*)$var);

';
		print TYPEMAP type_id ($_).'_NOINC
	sv_setref_pv($arg, \"'.$objects{$_}.'\", (void*)$var);

';
	}

	foreach (keys %structs)
	{
		print TYPEMAP type_id ($_).'
	sv_setref_pv($arg, \"'.$structs{$_}.'\", (void*)$var);

';
	}

	foreach (keys %enums)
	{
		print TYPEMAP type_id ($_).'
	$arg = cairo_'.func_name ($_).'_to_sv ($var);

';
	}

	close TYPEMAP;

	my $header = File::Spec->catfile ($autogen_dir,
					  'cairo-perl-auto.h');
	open HEADER, '>', $header
		or die "unable to open ($header) for output";

	print HEADER <<EOS;
/*
 * This file was automatically generated.  Do not edit.
 */

#include <cairo.h>

EOS

	foreach (keys %objects)
	{
		/^(.*) \*/;
		if (exists $backend_macros{$1}) {
			print HEADER "#ifdef $backend_macros{$1}\n";
		}
		print HEADER "typedef $1 ${1}_noinc;\n";
		if (exists $backend_macros{$1}) {
			print HEADER "#endif\n";
		}
	}

	close HEADER;

	return ($cairo_perl);
}

sub do_enums
{
	my %enums = %{shift ()};

	my $cairo_enums = 'cairo-perl-enums.c';
	open ENUMS, '>', $cairo_enums
		or die "unable to open ($cairo_enums) for output";

	sub name
	{
		$_[0] =~ /cairo_(\w+)_t/;
		$1;
	}

	print ENUMS "
/*
 * This file was automatically generated.  Do not edit.
 */

#include <cairo-perl.h>

";

	sub if_tree_from
	{
		my @enums = @_;

		my $prefix = shift @enums;

		my $full = shift @enums;
		my $name = $full;
		$name =~ s/$prefix//;
		$name =~ tr/_/-/;
		$name = lc ($name);
		my $len = length ($name);

		my $str = "	if (strncmp (str, \"$name\", $len) == 0)
		return $full;
";

		foreach $full (@enums)
		{
			$name = $full;
			$name =~ s/$prefix//;
			$name =~ tr/_/-/;
			$name = lc ($name);
			$len = length ($name);

			$str .= "	else if (strncmp (str, \"$name\", $len) == 0)
		return $full;
";
		}

		$str;
	}

	sub if_tree_to
	{
		my @enums = @_;

		my $prefix = shift @enums;
		my $full = shift @enums;
		my $name = $full;
		$name =~ s/$prefix//;
		$name =~ tr/_/-/;
		$name = lc ($name);

		my $str = "	if (val == $full)
		return newSVpv (\"$name\", 0);
";

		foreach $full (@enums)
		{
			$name = $full;
			$name =~ s/$prefix//;
			$name =~ tr/_/-/;
			$name = lc ($name);
			$str .= "	else if (val == $full)
		return newSVpv (\"$name\", 0);
";
		}

		$str;
	}

	open HDR, '>', "$autogen_dir/cairo-perl-enums.h";
	print HDR "/*
 * This file was automatically generated.  Do not edit.
 */

#ifndef _CAIRO_PERL_ENUMS_H_
#define _CAIRO_PERL_ENUMS_H_
";

	foreach (keys %enums)
	{
		my $name = name ($_);

		print HDR "
int cairo_".$name."_from_sv (SV * $name);
SV * cairo_".$name."_to_sv (int val);
";

		print ENUMS 'int
cairo_'.$name.'_from_sv (SV * '.$name.')
{
	char * str = SvPV_nolen ('.$name.');

'.if_tree_from (@{$enums{$_}}).'
	croak ("bad value for '.$name.' (%s)\n", str);

	free (str);
	return 0;
}

SV *
cairo_'.$name.'_to_sv (int val)
{
'.if_tree_to (@{$enums{$_}}).'
	return newSVpv ("unknown/invalid", 0);
}

';
	}

	print HDR "
#endif /* _CAIRO_PERL_ENUMS_H_ */\n";
	close HDR;

	close ENUMS;
}

1;
