Template::Plugin::Java - Generate Java Classes from XML description files and templates.

	<aBean>
		<java: option1="value1">
			<option2>value2</option2>
		</java:>
		<foo>10</foo>
		<bar>String</bar>
		<container>
			<baz>20</baz>
		</container>
	</aBean>

	[% USE Java %]
	package $package;

	public class $class {

	[% FOREACH Java.variables %]
	$type $name = $initializer;
	[% END %]

	//... etc
	}

package Template::Plugin::Java;

($VERSION) = '$ProjectVersion: 0.4 $' =~ /\$ProjectVersion:\s+(\S+)/;

require Template::Plugin;
@ISA = 'Template::Plugin';

use strict;
use Carp qw/verbose croak/;
use Template::Plugin::Java::Utils qw(
	parseOptions findPackageDir isNum determinePackage createTemplate
	parseCmdLine javaTypeName
);
use Template::Plugin::Java::Constants qw/:all/;

sub new {
	use XML::Simple;
	use File::Basename;

	my $class	= shift;
	my $self	= bless {}, ref $class || $class;
	my $context;
	my $params	= {};
	my $arg1	= $_[0];

	if (@_ <= 1 && not ref $arg1) {
		$params->{file} = shift;
	} elsif (not ref $arg1) {
		$params = {@_};
	} elsif (UNIVERSAL::isa($arg1, 'Template::Context')) {
		$self->context(shift);
	} elsif (UNIVERSAL::isa($arg1, 'HASH')) {
		$params = { %{+shift}, @_ };
	}

	$self->context(delete $params->{context});

	my $defaults = delete $params->{defaults} || {};
	my $cmd_line = delete $params->{cmdLine} || {};

# Automatically parse the command line unless either explicitly told not to, or
# a the object has been created inside a template as an actual plugin.
	unless ((exists $params->{parseCmdLine}
	 && (not $params->{parseCmdLine}))
	 || $self->context) {
		$cmd_line = {
			%$cmd_line,
			parseOptions( parseCmdLine )
		};

# Use rest of @ARGV as files.
		push @{$params->{files}}, @ARGV;
		@ARGV = ();
	}

	unless ($self->context) {
		$self->template (
			createTemplate delete $params->{templateOptions}
		);
	}

	my $files    = delete $params->{file} || delete $params->{files};

	my @files;
	if (defined $files) {
		if (UNIVERSAL::isa($files, 'ARRAY')) {
			@files = @$files;
		} else {
			push @files, $files;
		}
	}

# The ! eof STDIN is necessary here, because sub-templates will want to create
# new instances of this Plugin, when the process still has a redirected STDIN,
# just with no data to read. Using eof on a terminal is bad, but this doesn't
# happen because of the && short circuit.
	if (scalar @files == 0 && ! -t STDIN && ! eof STDIN) {
		push @files, '-';
	}

	for my $file_name (@files) {
		my $stash;

		if ($file_name ne '-') {
# Prepend ./ if relative path.
			$file_name =~ s!^([^/-])!./$1!;
			$stash  = XMLin (
				$file_name,
				keyattr => "",
				keeproot => 1,
				cache => 'storable'
			);
		} else {
# Reading from STDIN.
			my $data;
			{
				local @ARGV = '-';
				$data = join '', <>;
			}
			$stash = XMLin (
				$data,
				keyattr => "",
				keeproot => 1,
			);
		}

		my $root   = (keys %$stash)[0];
		$stash     = {%{$stash->{$root}}};

		my $context = delete $stash->{'java:'} || {};

		$stash = {
			parseOptions(
				%$defaults,
				%$params,
				%$context,
				%$cmd_line
			),
			variables => $stash
		};

		$stash->{tag}		= $root;
		$stash->{class}		||= ucfirst $root;

# Allow nopackage="true" to create a class that isn't in a package.
		{
# Turn off warnings about comparing uninitialized values.
			local $^W = undef;

			if (!$stash->{package} && $stash->{package} ne '0') {
				$stash->{package} =
					determinePackage dirname($file_name);
			}
		}

		$stash->{genContainers} ||= TRUE;
		$stash->{containerTemplate} ||= 'Container';
		$stash->{template}	||= $stash->{containerTemplate};

		$stash->{containerNamePrefix} = $stash->{class}
			if not exists $stash->{containerNamePrefix};

		if (exists $stash->{appendFile}) {
			use IO::File;
			my $file = new IO::File $stash->{appendFile}
				or die "Could not open $stash->{appendFile}";
			local $/ = undef;
			$stash->{append} .= <$file>;
		}

		$self->genClass($stash);
	}

	return $self;
}

sub template {
	my ($self, $template) = @_;

	if ($template) {
		$self->{template} = $template;
		$self->context($template->context);
	}
	
	return $self->{template};
}

sub context  { $_[0]->{context} = $_[1] || $_[0]->{context}  }

sub initializer {
	my ($self, $type) = @_;
	$type ||= $self->context->stash->get('type');

# Can check if user defined, for example StringInitializer="null" in xml file
# or template, and use that. But only if not called as a static method.
	if (ref $self) {
		my $res = $self->context->stash->get($type.'Initializer');
		return $res if defined $res && $res ne "";
	}

	return '""'	if $self->string($type);

	return $self->encapsulatePrimitive($type).".MIN_VALUE"
			if $self->scalar($type);

        return "new $type(0)"
                        if $type eq 'java.sql.Date' || $type eq 'Date';
	
	return undef	if $type =~ /\[\]$/;

	return "new $type()";
}

sub variables {
	my ($self, $options) = @_;

	my $vars = $self->getVariables (
		$self->context->stash->get('variables'),
		$options
	);

	return [ map {
		my $key  = $_;
		my $type = $self->mapType($key, $vars->{$key});

# Returns a hashref for each map iteration:
		{
			name	=> $key,
			capName	=> ucfirst $key,
			type	=> $type,
			typeName=> javaTypeName $type,
			value	=> $vars->{$key},
			initializer => $self->initializer($type)
		};
	} (sort keys %$vars) ];
}

sub variableDeclarations {
	my ($self, $options) = @_;

	my $vars = $self->getVariables (
		$self->context->stash->get('variables'),
		$options
	);
	
	return [ map {
		my $key = $_;
		$self->mapType($key, $vars->{$key}).' '.$key;
	} (sort keys %$vars) ];
}

sub variableNames {
	my ($self, $options) = @_;

	return [
		keys %{ $self->getVariables (
			$self->context->stash->get('variables'),
			$options
		)}
	];
}

sub getVariables {
	my ($self, $vars, $options) = @_;
	$options ||= { type => 'All' };

	if ($options->{type} eq 'ScalarArray') {
		1;
	}

# Don't spew out stuff belonging to our namespace.
	my @names = grep { !/^java:/ } keys %$vars;
	my %vars;

	if ($options->{type} eq 'All') {
		@vars{@names} = @$vars{@names};
	} elsif ($options->{type} eq 'Scalar') {
		for my $n (@names) {
			if ($self->scalar($self->mapType($n, $vars->{$n}))) {
				$vars{$n} = $vars->{$n};
			}
		}
        } elsif ($options->{type} eq 'Composite') {
		for my $n (@names) {
                        if (!$self->scalar($self->mapType($n, $vars->{$n}))
                            and
			    !$self->array($self->mapType($n, $vars->{$n}))
			    and
			    $self->mapType($n, $vars->{$n}) !~ /\[\]/) {
				$vars{$n} = $vars->{$n};
			}
                }
	} elsif ($options->{type} eq '!Scalar') {
		for my $n (@names) {
			if (!$self->scalar($self->mapType($n, $vars->{$n}))){
				$vars{$n} = $vars->{$n};
			}
		}
        } elsif ($options->{type} eq '!Composite') {
                for my $n (@names) {
			if ($self->scalar($self->mapType($n, $vars->{$n}))
                            or
                            $self->array($self->mapType($n, $vars->{$n}))) {
				$vars{$n} = $vars->{$n};
			}
                }
        } elsif ($options->{type} eq 'ScalarArray') {
                for my $n (@names) {
                        if ($self->array($self->mapType($n, $vars->{$n}))
                            and
                            $self->scalar($self->arrayType($n, $vars->{$n}))) {
				$vars{$n} = $vars->{$n};
			}
                }
        } elsif ($options->{type} eq 'CompositeArray') {
                for my $n (@names) {
                        if ($self->array($self->mapType($n, $vars->{$n}))
                            and
                            !$self->scalar($self->arrayType($n, $vars->{$n}))
                            and
                            !$self->array($self->arrayType($n, $vars->{$n}))) {
				$vars{$n} = $vars->{$n};
			}
                }
        } else {
                die "Unknown option $options->{type}";
        }

	return \%vars;
}

sub scalar {
	my ($self, $type) = @_;
	$type ||= $self->context->stash->get('type');

	return TRUE if $type =~ /@{[SCALAR]}/;
	return FALSE;
}

sub string {
	my ($self, $type) = @_;
	$type ||= $self->context->stash->get('type');

	return $1 if $type =~ /@{[STRING]}/;
	return undef;
}

sub array {
	my ($self, $type) = @_;
	$type ||= $self->context->stash->get('type');

	return $1 if $type =~ /@{[ARRAY]}/;
	return undef;
}

sub arrayType {
	my ($self, $name, $value) = @_;

	my $type = $self->mapType($name, $value->[0]);

	if ($self->scalar($type)) {
		return $self->encapsulatePrimitive($type);
	}

	return $type;
}

sub encapsulatePrimitive {
	my ($self, $type) = @_;

	if ($type eq 'int') {
		return 'Integer';
	} else {
		return ucfirst $type;
	}
}

{ # Closure over type cache.

my %cache;

sub mapType {
	my $self	= shift;
	my $name	= shift || croak "name required";
	my $value	= shift || croak "value required";

	my $type	= ref $value;
	my $result;

	return $cache{"$name $type"} if exists $cache{"$name $type"};

	if (not $type) { # I.E. a scalar.
		my $is_num = isNum $value;

		if ($is_num && $value =~ /\./) {
			$result = 'double';
		} elsif ($is_num) {
			$result = 'int';
		} else {
			$result = 'String';
		}
	} elsif($type eq 'ARRAY') {
		$result = 'Vector';
	} elsif($type eq 'HASH') {
		my @keys = keys %$value;

# Could be pre-mapped to a java type.
		if (exists $value->{'java:type'}) {
			$result = $value->{'java:type'};
		} else {
# Sub-container.
			my $s = $self->context->stash;
			if ($s->get('genContainers')) {
				$result = $self->genClass ({
					tag => $name,
					class =>
					 $s->get('containerNamePrefix')
					 ."\u$name",
					template =>
					 $s->get('containerTemplate'),
					variables => $value
				});
			} else {
				$result = 'Container';
			}
		}
	} else {
		die "Cannot map type $type to a Java type";
	}

	$cache{"$name $type"} = $result;

	return $result;
}

} # End closure.

sub genClass {
	my ($self, $hash) = @_;

	my $context = $self->context;

	my $variables = delete $hash->{variables};

	my $v = delete $variables->{'java:'} || {};
	$v = {
		%{$v},
		%{$hash}
	};

	$v->{destFile} = $v->{class}.".java";

	if (exists $v->{package}) {
		$v->{destFile} = findPackageDir (
			$v->{package}
		).$v->{destFile};
	}

	$context->localise({
		%{$v},
		variables => $variables
	});

# If not using version 2+ of Template, the context needs the output to be
# redirected to the appropriate file.
	if ($Template::VERSION =~ /^[01]/) {
# This is necessary for compiling with the newer version, since the
# TEMPLATE_OUTPUT constant is gone:
	 	my $redirect_constant =
			&{Template::Constants->can('TEMPLATE_OUTPUT')}();

		my $old_output_handle = $context->redirect(
			$redirect_constant,
			$v->{destFile}
		);

		$context->process($v->{template});

		$context->redirect(
			$redirect_constant,
			$old_output_handle
		);
	} else {
# In Template version 2+ process returns the output of processing a template.
		my $handle = new IO::File "> $v->{destFile}"
			or croak "Could not write to $v->{destFile}: $!";

		print $handle $context->process($v->{template});
		$handle->close;
	}

	$context->delocalise;

# Put variables back.
	$hash->{variables} = $variables;

# Return fully qualified name, or just name.
	if (exists $v->{package}) {
		return $v->{package}.".".$v->{class};
	} else {
		return $v->{class};
	}
}

sub castJavaString {
	my $self = shift;
	&Template::Plugin::Java::Utils::castJavaString;
}

1;

__END__