File Coverage

blib/lib/Rose/DBx/Object/Builder.pm

Criterion	Covered	Total	%
statement	226	254	88.9
branch	46	84	54.7
condition	8	20	40.0
subroutine	21	22	95.4
pod	4	4	100.0
total	305	384	79.4

package Rose::DBx::Object::Builder;
use strict;
use warnings;
no warnings 'recursion';
use Exporter 'import';

use base qw(Rose::Object);
our @EXPORT = qw(config parse build show);
our @EXPORT_OK = qw(config parse build show);

use Lingua::EN::Inflect 'PL';
use Regexp::Common;
use DBI;

our $VERSION = 0.09;
# 12.9

sub config {
	my $self = shift;
	unless ($self && defined $self->{CONFIG}) {
		$self->{CONFIG} = {
			db => {
				name => undef,
				type => 'mysql',
				host => '127.0.0.1',
				port => undef,
				username => 'root',
				password => 'root',
				tables_are_singular => undef,
				table_prefix => '',
				options => {RaiseError => 0, PrintError => 0, AutoCommit => 1}},
			format => {
				expression => sub {
					my $expression = lc(shift);
					$expression =~ s/\s*,?\s*\band\b\s*,?\s*/, /g;
					$expression =~ s/\b(a|an|the)\b//g;
					$expression =~ s/\.//g;
					return $expression;
				},
				table => sub {
					my $table = shift;
					$table =~ s/^\s+|\s+$//g;
					$table =~ s/\s+/_/g;
					return $table;
				},
				column => sub {
					my $column = shift;
					$column =~ s/^\s+|\s+$//g;
					$column =~ s/\s+/_/g;
					return $column;
				},
			},
			table => {
				mysql => 'CREATE TABLE [% table_name %] ([% columns %]) TYPE=INNODB;',
				Pg => 'CREATE TABLE [% table_name %] ([% columns %]);',
				SQLite => 'CREATE TABLE [% table_name %] ([% columns %]);',
			},
			primary_key => {
				name => 'id',
				type => {
					mysql => 'INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY',
					Pg => 'SERIAL PRIMARY KEY',
					SQLite => 'INTEGER NOT NULL PRIMARY KEY',
				}
			},
			foreign_key => {
				suffix => '_id',
				type => {
					mysql => 'INTEGER',
					Pg => 'INTEGER',
					SQLite => 'INTEGER',
				},
				singular => 1,
				clause => 'FOREIGN KEY ([% foreign_key %]) REFERENCES [% reference_table %] ([% reference_primary_key %]) ON UPDATE CASCADE ON DELETE CASCADE',
			},
			add_clause => 'ALTER TABLE [% table_name %] ADD [% clause %];',
			map_table => '[% table_name %]_[% foreign_table_name %]_map',
			columns => {
				name => 'VARCHAR(255)',
				unique => 'VARCHAR(255) UNIQUE',
				required => 'VARCHAR(255) NOT NULL',
				text => 'TEXT',
				integer => 'INTEGER',
				number => 'NUMERIC',
				date => 'DATE',
				time => 'TIME',
				timestamp => 'TIMESTAMP',
				money => 'DECIMAL(13,2)',
				boolean => 'BOOLEAN',
			}
		};

		$self->{CONFIG}->{columns}->{title} = $self->{CONFIG}->{columns}->{name};
		$self->{CONFIG}->{columns}->{description} = $self->{CONFIG}->{columns}->{text};
		$self->{CONFIG}->{columns}->{percentage} = $self->{CONFIG}->{columns}->{number};
		$self->{CONFIG}->{columns}->{cost} = $self->{CONFIG}->{columns}->{money};
		$self->{CONFIG}->{columns}->{price} = $self->{CONFIG}->{columns}->{money};
		$self->{CONFIG}->{columns}->{username} = $self->{CONFIG}->{columns}->{unique};
	}

	if (@_) {
		my $config = shift;
		foreach my $hash (keys %{$config}) {
			if (ref $config->{$hash} eq 'HASH') {
				foreach my $key (keys %{$config->{$hash}}) {
					if (ref $config->{$hash}->{$key} eq 'HASH') {
						foreach my $sub_key (keys %{$config->{$hash}->{$key}}) {
							$self->{CONFIG}->{$hash}->{$key}->{$sub_key} = $config->{$hash}->{$key}->{$sub_key};
						}
					}
					else {
						$self->{CONFIG}->{$hash}->{$key} = $config->{$hash}->{$key};
					}
				}
			}
			else {
				$self->{CONFIG}->{$hash} = $config->{$hash};
			}
		}
	}

	return $self->{CONFIG};
}

sub build {
	my $self = shift;
	my $dbh = shift;
	my $config = $self->config;
	my $schema = $self->parse;
	return unless $schema;

	unless ($dbh) {
		die "Database name missing" unless $config->{db}->{name};
		my $host;
	 	$host = 'host='. $config->{db}->{host} if $config->{db}->{host};
		$host .= ';port='.$config->{db}->{port} if $config->{db}->{port};
		my $dsn = qq(dbi:$config->{db}->{type}:dbname=$config->{db}->{name};$host);
		$dbh = DBI->connect($dsn, $config->{db}->{username}, $config->{db}->{password}, $config->{db}->{options}) or die "Error opening database: $config->{db}->{name}\n";
	}

	eval {
		foreach my $sql (split /;/, $schema) {
			$dbh->do($sql) or warn "Error executing SQL: $sql;\n";
		}
		$dbh->commit unless $config->{db}->{options}->{AutoCommit};
	};

	if ($@) {
		warn "Transaction aborted: $@";
		eval {$dbh->rollback};
  	}

	$dbh->disconnect or die "Error closing database: $config->{db}->{name}\n";
}

sub parse {
	my $self = shift;
	my $string = shift;

	if ($string) {
		my $config = $self->config;
		foreach my $expression (split /\./, $string) {
			my $schema;
			if ($expression =~ /\s+as\s+/) {
				$schema = _as ($config, $expression);
			}
			elsif ($expression =~ /vice[\s\-]+versa/) {
				$schema = _many_to_many ($config, $expression);
			}
			elsif ($expression =~ /(has|have)\s+many/) {
				$schema = _has_many ($config, $expression);
			}
			else {
				$schema = _has_a ($config, $expression);
			}
			$self->{SCHEMA} .= $schema if $schema;
		}
	}
	return $self->{SCHEMA} || '';
}

sub show {
	my $self = shift;
	my $schema = $self->parse(@_);
	return unless $schema;
	my @pretty;

	foreach my $schema (split /;/, $schema) {
		if ($schema =~ /CREATE/) {
			$schema =~ s/^([^\(]+)\(/$1\(\n\t/g;
			$schema =~ s/\)([^\)]+)$/\n\)$1/g;
			$schema =~ s/([^\d]),([^\d])/$1,\n\t$2/g;
			$schema =~ s/\)$/\n)/;
		}
		push @pretty, $schema . ';';
	}
	return join "\n\n", @pretty;
}

sub _as {
	my $config = shift;
	my $expression = $config->{format}->{expression}->(shift);
	my ($table_name, $has, $foreign_table_name, $foreign_key) = split /\s+(has|have)\s+(.*)\s+as\s+(.*)/, $expression;
	return unless $table_name && $foreign_table_name && $foreign_key;
	$table_name = _normalise_table($config, $config->{format}->{table}->($table_name));
	$foreign_table_name = _normalise_table($config, $config->{format}->{table}->($foreign_table_name));
	$foreign_key = $config->{format}->{column}->($foreign_key);
	$foreign_key = $config->{foreign_key}->{singular} ? _singularise($foreign_key) : $foreign_key;
	$foreign_key .= $config->{foreign_key}->{suffix};

	my $add_column = $config->{add_clause};
	$add_column =~ s/\[%\s*table_name\s*%\]/$table_name/;
	$add_column =~ s/\[%\s*table_name\s*%\]/$table_name/;

	my $foreign_key_column = $foreign_key . ' ' . $config->{foreign_key}->{type}->{$config->{db}->{type}};
	$add_column =~ s/\[%\s*clause\s*%\]/$foreign_key_column/;
	my $schema = $add_column;

	my $add_foreign_key = $config->{add_clause};
	$add_foreign_key =~ s/\[%\s*table_name\s*%\]/$table_name/;
	my $foreign_key_clause = _generate_foreign_key_clause($config, $foreign_key, $foreign_table_name);
	$add_foreign_key =~ s/\[%\s*clause\s*%\]/$foreign_key_clause/;
	$schema .= $add_foreign_key;

	return $schema;
}

sub _many_to_many {
	my $config = shift;
	my $expression = $config->{format}->{expression}->(shift);
	$expression =~ s/,\s+vice[\s\-]+versa//;
	my ($table_name, $has, $foreign_table_name) = split /\s*(has|have)\s+many\s*/, $expression;
	return unless $table_name && $foreign_table_name;
	$table_name = _normalise_table($config, $config->{format}->{table}->($table_name));
	$foreign_table_name = _normalise_table($config, $config->{format}->{table}->($foreign_table_name));
	my $map_table = $config->{map_table};
	$map_table =~ s/\[%\s*table_name\s*%\]/$table_name/;
	$map_table =~ s/\[%\s*foreign_table_name\s*%\]/$foreign_table_name/;

	my $schema = $config->{table}->{$config->{db}->{type}};
	$schema =~ s/\[%\s*table_name\s*%\]/$map_table/;

	my $foreign_keys;
	my @columns = ($config->{primary_key}->{name} . ' ' . $config->{primary_key}->{type}->{$config->{db}->{type}});

	foreach my $table ($table_name, $foreign_table_name) {
		my $foreign_key = $config->{foreign_key}->{singular} ? _singularise($table) : $table;
		$foreign_key .= $config->{foreign_key}->{suffix};
		$foreign_keys->{$foreign_key} = $table;
		push @columns, $foreign_key . ' ' . $config->{foreign_key}->{type}->{$config->{db}->{type}};
	}

	foreach my $foreign_key (keys %{$foreign_keys}) {
		push @columns, _generate_foreign_key_clause($config, $foreign_key, $foreign_keys->{$foreign_key});
	}

	my $schema_columns = join ',', @columns;
	$schema =~ s/\[%\s*columns\s*%\]/$schema_columns/;
	return $schema;
}

sub _has_many {
	my $config = shift;
	my $expression = $config->{format}->{expression}->(shift);
	my ($table_name, $has, $foreign_table_name) = split /\s*(has|have)\s+many\s*/, $expression;
	return unless $table_name && $foreign_table_name;
	$table_name = _normalise_table($config, $config->{format}->{table}->($table_name));
	$foreign_table_name = _normalise_table($config, $config->{format}->{table}->($foreign_table_name));
	my $add_column = $config->{add_clause};
	$add_column =~ s/\[%\s*table_name\s*%\]/$foreign_table_name/;

	my $foreign_key = $config->{foreign_key}->{singular} ? _singularise($table_name) : $table_name;
	$foreign_key .= $config->{foreign_key}->{suffix};

	my $foreign_key_column = $foreign_key . ' ' . $config->{foreign_key}->{type}->{$config->{db}->{type}};
	$add_column =~ s/\[%\s*clause\s*%\]/$foreign_key_column/;
	my $schema = $add_column;

	my $add_foreign_key = $config->{add_clause};
	$add_foreign_key =~ s/\[%\s*table_name\s*%\]/$foreign_table_name/;

	my $foreign_key_clause = _generate_foreign_key_clause($config, $foreign_key, $table_name);
	$add_foreign_key =~ s/\[%\s*clause\s*%\]/$foreign_key_clause/;
	$schema .= $add_foreign_key;

	return $schema;
}

sub _has_a {
	my $config = shift;
	my $expression = $config->{format}->{expression}->(shift);
	my ($table_name, $has, $columns) = ($expression =~ /^([\w_\-0-9\s]+)\s+(has|have)\s+(.*)$/);
	return unless $table_name && $columns;

	my ($schema, $foreign_keys, $foreign_table_name, $foreign_table_columns, $custom_columns);
	my $foreign_key_suffix = $config->{foreign_key}->{suffix};
	my $table = {name => _normalise_table($config, $config->{format}->{table}->($table_name))};

	push @{$table->{columns}}, {name => $config->{primary_key}->{name}, type => $config->{primary_key}->{type}->{$config->{db}->{type}}};

	while ($columns =~ /[()]/) {
		($foreign_table_name, $foreign_table_columns) = ($columns =~ /([\w_\-0-9\s]+)\s*($RE{balanced}{-parens=>'()'})/);
		($foreign_table_columns) = ($foreign_table_columns =~ /\((.*)\)/);

		if($foreign_table_columns =~ /^\s*(has|have)/) {
			$schema .= _has_a($config, join ' ', ($foreign_table_name , $foreign_table_columns));
			$foreign_table_name = _normalise_table($config, $config->{format}->{table}->($foreign_table_name));
			my $foreign_key = $config->{foreign_key}->{singular} ? _singularise($foreign_table_name) : $foreign_table_name;
			$foreign_key .= $foreign_key_suffix;
			$foreign_keys->{$foreign_key} = $foreign_table_name;
			$columns =~ s/(\b[\w_\-0-9\s]*)\b\s*($RE{balanced}{-parens=>'()'})/$foreign_key/;
		}
		else {
			$foreign_table_name = $config->{format}->{column}->($foreign_table_name);

			if ($foreign_table_columns =~ /^reference/) {
				my $foreign_key = $foreign_table_name;
				my ($reference_table) = ($foreign_table_columns =~ /^references?\s+([\w_\-0-9\s]+)$/);

				if ($reference_table) {
					$foreign_table_name = _normalise_table($config, $config->{format}->{table}->($reference_table));
				}
				else {
					$foreign_table_name =~ s/$foreign_key_suffix$//;
					$foreign_table_name = _normalise_table($config, $config->{format}->{table}->($foreign_table_name));
				}

				$foreign_keys->{$foreign_key} = $foreign_table_name;
			}
			elsif (exists $config->{columns}->{$foreign_table_columns}) {
				$custom_columns->{$foreign_table_name} = $config->{columns}->{$foreign_table_columns};
			}

			$columns =~ s/([\w_\-0-9]*)\s*($RE{balanced}{-parens=>'()'})/$1/; # clean it for the while loop
		}
	}

	foreach my $column (split /\s*,\s*/, $columns) {
		$column = $config->{format}->{column}->($column);
		if (exists $foreign_keys->{$column}) {
			push @{$table->{columns}}, {name => $column, type => $config->{foreign_key}->{type}->{$config->{db}->{type}}};
		}
		else {
			if (exists $custom_columns->{$column}) {
				push @{$table->{columns}}, {name => $column, type => $custom_columns->{$column}};
			}
			elsif (exists $config->{columns}->{$column}) {
				push @{$table->{columns}}, {name => $column, type => $config->{columns}->{$column}};
			}
			else {
				my $column_type;
				DEF: foreach my $column_key (keys %{$config->{columns}}) {
					if ($column =~ /$column_key/) {
						 # first match
						$column_type = $column_key;
						last DEF;
					}
				}

				if ($column_type) {
					push @{$table->{columns}}, {name => $column, type => $config->{columns}->{$column_type}};
				}
				else {
					push @{$table->{columns}}, {name => $column, type => $config->{columns}->{name}}; # default
				}
			}
		}
	}

	my $schema_columns = [map {$_->{name} . ' ' . $_->{type}} @{$table->{columns}}];

	foreach my $foreign_key (keys %{$foreign_keys}) {
		push @{$schema_columns}, _generate_foreign_key_clause($config, $foreign_key, $foreign_keys->{$foreign_key});
	}

	my $schema_columns_string = join ',', @{$schema_columns};

	$schema .= $config->{table}->{$config->{db}->{type}};
	$schema =~ s/\[%\s*table_name\s*%\]/$table->{name}/;
	$schema =~ s/\[%\s*columns\s*%\]/$schema_columns_string/;

	return $schema;
}

sub _singularise  {
	# based on Rose::DB::Object::ConventionManager
	my $word = shift;
	$word =~ s/ies$/y/i;
	return $word if ($word =~ s/ses$/s/);
	return $word if($word =~ /[aeiouy]ss$/i);
	$word =~ s/s$//i;
	return $word;
}

sub _generate_foreign_key_clause {
	my ($config, $foreign_key, $reference_table) = @_;
	my $foreign_key_clause = $config->{foreign_key}->{clause};
	$foreign_key_clause =~ s/\[%\s*foreign_key\s*%\]/$foreign_key/;
	$foreign_key_clause =~ s/\[%\s*reference_table\s*%\]/$reference_table/;
	$foreign_key_clause =~ s/\[%\s*reference_primary_key\s*%\]/$config->{primary_key}->{name}/;
	return $foreign_key_clause;
}

sub _normalise_table {
	my ($config, $table) = @_;
	my $table_name;

	if ($config->{db}->{tables_are_singular}) {
		$table_name = _singularise($table);
	}
	else {
		$table_name = Lingua::EN::Inflect::PL(_singularise($table));
	}

	return $config->{db}->{table_prefix} . $table_name if defined $config->{db}->{table_prefix};
	return $table_name;
}

1;

__END__