The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/perl
#
# Name:
#	generator.pl.tmpl.
#
# Purpose:
#	To serve as a template for an auto-generated script.
#	This template is input to Rose::DBx::Bouquet via rose.app.gen.pl.
#	The output of rose.app.gen.pl is redirected to generator.pl,
#	which, when run, generates a set of module files.

use strict;
use warnings;

# -------------------------------------------------

<tmpl_loop name=package_loop>package <tmpl_var name=prefix>::Rose::<tmpl_var name=module>;

use base '<tmpl_var name=prefix>::Base::Object';

__PACKAGE__ -> meta() -> table('<tmpl_var name=table>');
__PACKAGE__ -> meta() -> auto_initialize();

</tmpl_loop>package main;

use base 'Rose::DB::Object::Loader';
use strict;
use warnings;

use Carp;
use File::Path;
use File::Spec;
use HTML::Template;

# -------------------------------------------------

sub column_to_field
{
	my($attribute_map, $type_map, $column, $tabindex) = @_;

	my(%attribute);

	$attribute{'id'}        = $column -> name();
	$attribute{'class'}     = $column -> type();
	$attribute{'label'}     = ucfirst join(' ', split(/_/, $attribute{'id'}) );
	$attribute{'maxlength'} = 64;
	$attribute{'rank'}      = $tabindex;
	$attribute{'size'}      = $column -> can('length') ? $column -> length() : 0;
	$attribute{'size'}      = 24 if (! defined $attribute{'size'});
	$attribute{'size'}      = $attribute{'maxlength'} if ($attribute{'size'} > $attribute{'maxlength'});
	$attribute{'tabindex'}  = $tabindex;
	$attribute{'type'}      = $$type_map{$attribute{'class'} };
	my($attribute_set)      = $$attribute_map{$attribute{'type'} } || $$attribute_map{'default'};

	my($attribute);
	my($filler);
	my(@definition);

	for $attribute (@$attribute_set)
	{
		$filler = ' ' x (10 - length $attribute);

		push @definition, qq|\t$attribute$filler=> '$attribute{$attribute}'|;
	}

	return join(",\n\t", @definition) . ',';

} # End of column_to_field.

# -------------------------------------------------

my($output_dir_name) = '<tmpl_var name=dir_name>';

my(@pm_file_name);

<tmpl_loop name=module_loop>push @pm_file_name, '<tmpl_var name=module>';
</tmpl_loop>
# Generate *.pm modules, one per table.

if (<tmpl_var name=verbose>) # if (verbose).
{
	print STDERR "Processing Rose::DB-based modules:\n";
}

my($name);
my($output_file_name, @output_file_name);
my($module);

for $module (@pm_file_name)
{
	$name             = "<tmpl_var name=prefix>::Rose::$module";
	$output_file_name = File::Spec -> catfile($output_dir_name, "$module.pm");

	if (<tmpl_var name=remove>) # if (remove).
	{
		push @output_file_name, $output_file_name;
	}
	else
	{
		open(OUT, "> $output_file_name") || die "Can't open(> $output_file_name): \$!";
		print OUT $name -> meta() -> perl_class_definition(braces => 'bsd');
		close OUT;

		if (<tmpl_var name=verbose>) # if (verbose).
		{
			print STDERR "Generated $output_file_name\n";
		}
	}
}

# Generate */Manager.pm modules, one per table.

if (<tmpl_var name=verbose>) # if (verbose).
{
	print STDERR "Processing */Manager.pm modules:\n";
}

my($lc_module);
my($template);

for $module (@pm_file_name)
{
	mkpath([File::Spec -> catfile($output_dir_name, $module)], 0, 0744);

	$lc_module        = lc $module;
	$output_file_name = File::Spec -> catfile($output_dir_name, $module, 'Manager.pm');

	if (<tmpl_var name=remove>) # if (remove).
	{
		push @output_file_name, $output_file_name;
	}
	else
	{
		$template = HTML::Template -> new(filename => File::Spec -> catfile('<tmpl_var name=tmpl_path>', 'manager.pm.tmpl') );

		$template -> param(module => $module);
		$template -> param(prefix => '<tmpl_var name=prefix>');
		$template -> param(table  => $lc_module);

		open(OUT, "> $output_file_name") || die "Can't open(> $output_file_name): $!";
		print OUT $template -> output();
		close OUT;

		if (<tmpl_var name=verbose>) # if (verbose).
		{
			print STDERR "Generated $output_file_name\n";
		}
	}
}

# Generate */Form.pm modules, one per table.

if (<tmpl_var name=verbose>) # if (verbose).
{
	print STDERR "Processing */Form.pm modules:\n";
}

my(%attribute_map) =
(
 boolean  => [qw/id class label           rank      tabindex type/],
 default  => [qw/id class label maxlength rank size tabindex type/],
 hidden   => [qw/id class label           rank      type/],
 numeric  => [qw/id class label maxlength rank size tabindex type/],
 text     => [qw/id class label maxlength rank size tabindex type/],
 textarea => [qw/id class label           rank size tabindex type/],
);
my(%type_map) =
(
 'boolean'          => 'boolean',
 'character'        => 'text',
 'date'             => 'date',
 'datetime'         => 'datetime',
 'decimal'          => 'numeric',
 'double precision' => 'numeric',
 'epoch'            => 'datetime',
 'float'            => 'numeric',
 'integer'          => 'integer',
 'numeric'          => 'numeric',
 'serial'           => 'hidden',
 'text'             => 'textarea',
 'time'             => 'time',
 'timestamp'        => 'datetime',
 'varchar'          => 'text',
);

my(@column, $column);
my(@definition);
my($tabindex);

for $module (@pm_file_name)
{
	if (<tmpl_var name=remove>) # if (remove).
	{
		push @output_file_name, $output_file_name;

		next;
	}

	$name = "<tmpl_var name=prefix>::Rose::$module";

	eval "require $name";
	croak $@ if $@;

	@column     = sort $name -> meta() -> columns();
	@definition = ();
	$tabindex   = 1;

	for $column (@column)
	{
		push @definition, column_to_field(\%attribute_map, \%type_map, $column, $tabindex++);
	}

	if (<tmpl_var name=verbose>) # if (verbose).
	{
		print STDERR "Module: $module. Columns: ", join(', ', @column), "\n";
	}

	$lc_module        = lc $module;
	$output_file_name = File::Spec -> catfile($output_dir_name, $module, 'Form.pm');
	$template         = HTML::Template -> new(filename => File::Spec -> catfile('<tmpl_var name=tmpl_path>', 'form.pm.tmpl') );

	$template -> param(column_loop => [map{ {column => $column[$_], definition => $definition[$_]} } 0 .. $#column]);
	$template -> param(module      => $module);
	$template -> param(prefix      => '<tmpl_var name=prefix>');
	$template -> param(table       => $lc_module);

	open(OUT, "> $output_file_name") || die "Can't open(> $output_file_name): $!";
	print OUT $template -> output();
	close OUT;

	if (<tmpl_var name=verbose>) # if (verbose).
	{
		print STDERR "Generated $output_file_name\n";
	}
}

if (<tmpl_var name=remove>) # if (remove).
{
	for $output_file_name (@output_file_name)
	{
		unlink $output_file_name;

		if (<tmpl_var name=verbose>) # if (verbose).
		{
			print STDERR "Removed $output_file_name\n";
		}
	}
}

if (<tmpl_var name=verbose>) # if (verbose).
{
	print STDERR "Success\n";
}