#!/usr/bin/perl

#use File::ShareDir;
#use File::Spec;
use File::Basename;
use IO::File;
use IO::Dir;
use XML::GDOME;
use Getopt::Long;
use Xmldoom::Definition;
use Xmldoom::Definition::PerlModuleParser;
use Xmldoom::Definition::SAXHandler qw( $OBJECT_NS $OBJECT_PERL_NS );
use Xmldoom::ORB::Definition;
use Xmldoom;
use strict;

# for debugging
use Data::Dumper;
use Carp;

$SIG{__DIE__} = sub {
	Carp::confess(@_);
	#Carp::confess;
};

#sub get_template
#{
#	my $tpl_name = shift;
#
#	# TODO: find a better way to do this!
#	if ( -e "share/tpl/$tpl_name.tpl" )
#	{
#		return File::Spec->rel2abs("share/tpl/$tpl_name.tpl");
#	}
#
#	return File::ShareDir::dist_file('Xmldoom', "tpl/$tpl_name.tpl");
#}

my $XMLDOOM_VERSION = $Xmldoom::VERSION;

sub main_javascript
{
	my $database_xml;
	my $objects_xml;
	my $prefix;
	my $output;

	GetOptions(
		'database-xml|D:s'     => \$database_xml,
		'objects-xml|X:s'      => \$objects_xml,
		'namespace-prefix|N:s' => \$prefix,
		'output|o:s'           => \$output
	);

	if ( not defined $database_xml or not defined $objects_xml )
	{
		die "Must set both -D database.xml and -X objects.xml";
	}
	if ( defined $output and not defined $prefix )
	{
		die "Must define a namespace prefix with -N Namespace.Prefix when writting -o file.js";
	}
	if ( defined $prefix and not defined $output )
	{
		print "WARING: -N Namespace.Prefix option is ignored when not writting -o file.js\n";
	}

	# load the Xmldoom data
	my $database = Xmldoom::Definition::parse_database_uri($database_xml);
	$database->parse_object_uri( $objects_xml );

	my $json_def = Xmldoom::ORB::Definition::generate($database, 'json');

	if ( defined $output )
	{
		my ($basename, $tmp, $tmp) = fileparse( $output, qr/\.[^.]*/ );

		my $header_text = << "EOF";
//
// This file was automatically generated by xmldoom-generate $XMLDOOM_VERSION !
//

dojo.provide('$prefix.$basename');

//
// A JSON dump of the object definitions.
//

EOF

		my $fd = IO::File->new($output, 'w');
		$fd->write($header_text);
		$fd->write("$prefix.$basename = '$json_def';\n\n");
		$fd->close();
	}
	else
	{
		print $json_def;
	}
}

sub main_object_xml
{
	my $root_dir;
	my $output;

	GetOptions(
		'root|recursive|r:s' => \$root_dir,
		'output|o:s'         => \$output
	);

	if ( not defined $root_dir )
	{
		$root_dir = ".";
	}

	my $comment = << "EOF";
<!--
  
  This file was automatically generated by xmldoom-generate $XMLDOOM_VERSION !  
  
  -->
EOF

	# create the main document
	my $initial_xml = "$comment<objects xmlns='$OBJECT_NS' xmlns:perl='$OBJECT_PERL_NS'></objects>";
	my $doc = XML::GDOME->createDocFromString( $initial_xml );
	my $root_node = $doc->getDocumentElement();

	# pull all the object nodes recursively from perl modules in
	# the root directory.
	my @stack = ( [ $root_dir, IO::Dir->new($root_dir) ] );
	while ( scalar @stack > 0 )
	{
		my ($dirname, $dir) = @{pop @stack};

		while ( my $fn = $dir->read() )
		{
			if ( $fn eq '.' or $fn eq '..' )
			{
				next;
			}
			elsif ( -d "$dirname/$fn" )
			{
				# push the current what-not onto the stack 
				push @stack, [ $dirname, $dir ];

				# and descend into the next directory
				$dirname = "$dirname/$fn";
				$dir     = IO::Dir->new( $dirname );
			}
			elsif ( $fn =~ /\.pm$/ )
			{
				my $pm = Xmldoom::Definition::PerlModuleParser->new( "$dirname/$fn" );

				# parse into an actual XML document
				$pm->create_documents();

				# attach the object nodes to our master document
				foreach my $object_node ( @{$pm->get_object_nodes()} )
				{
					$root_node->appendChild( $doc->importNode($object_node, 1) );
				}
			}
		}
	}

	# make into a string
	#my $result_xml = $doc->toString();
	my $result_xml = $doc->toString( GDOME_SAVE_LIBXML_INDENT );

	# and then do something with it
	if ( defined $output )
	{
		my $output_fd = IO::File->new( $output, 'w' );
		$output_fd->write( $result_xml );
		$output_fd->close();
	}
	else
	{
		print $result_xml;
	}
}

sub main
{
	my $mode = shift @ARGV;

	if ( $mode eq 'javascript' )
	{
		main_javascript;
	}
	elsif ( $mode eq 'object-xml' )
	{
		main_object_xml;
	}
	else
	{
		die "Unsupported mode: " . $mode;
	}
}

main;

