Class::DBI::SQL::Transformer::Quotify - Quote column and table names in Class::DBI-generated SQL

  package Foo;
  use base qw/Class::DBI/;
  __PACKAGE__->connection('DBI:Mock:', '', '');
  __PACKAGE__->sql_transformer_class('Class::DBI::SQL::Transformer::Quotify');
  __PACKAGE__->table('table name');
  __PACKAGE__->columns( Essential => 'my id', 'my name' );
  package main;
  my $row = Foo->retrieve( 3 );

  SELECT my id, my name
  FROM table name
  WHERE my id = ?

    perldoc Class::DBI::SQL::Transformer::Quotify

package Class::DBI::SQL::Transformer::Quotify;

use warnings;
use strict;

use base qw/Class::DBI::SQL::Transformer/;
our $VERSION = '0.02';

sub _expand_table {
	my $self = shift;
	my $s = shift;
	my ($class, $alias) = split /=/, defined($s)?$s:'', 2;
	my $caller = $self->{_caller};
	my $table = $class ? $class->table : $caller->table;
	$self->{cmap}{ $alias || $table } = $class || ref $caller || $caller;
	($alias ||= "") &&= " ".$caller->db_Main->quote_identifier($alias);
	return $caller->db_Main->quote_identifier($table) . $alias;
}

sub _expand_join {
	my $self  = shift;
	my $joins = shift;
	my @table = split /\s+/, $joins;

	my $caller = $self->{_caller};
	my %tojoin = map { $table[$_] => $table[ $_ + 1 ] } 0 .. $#table - 1;
	my @sql;
	while (my ($t1, $t2) = each %tojoin) {
		my ($c1, $c2) = map $self->{cmap}{$_}
			|| $caller->_croak("Don't understand table '$_' in JOIN"), ($t1, $t2);

		my $join_col = sub {
			my ($c1, $c2) = @_;
			my $meta = $c1->meta_info('has_a');
			my ($col) = grep $meta->{$_}->foreign_class eq $c2, keys %$meta;
			$col;
		};

		my $col = $join_col->($c1 => $c2) || do {
			($c1, $c2) = ($c2, $c1);
			($t1, $t2) = ($t2, $t1);
			$join_col->($c1 => $c2);
		};

		$caller->_croak("Don't know how to join $c1 to $c2") unless $col;
		push @sql, sprintf " %s = %s ",
			$caller->db_Main->quote_identifier($t1, $col),
			$caller->db_Main->quote_identifier($t2, $c2->primary_column);
	}
	return join " AND ", @sql;
}

sub _backtickify_arg {
    my $self = shift;
    my $caller = $self->{_caller};
    my $char = $caller->db_Main->get_info(29) || q{"}; # SQL_IDENTIFIER_QUOTE_CHAR
    return $_[0] if $_[0] =~ /^$char[^$char]*$char$/; # return if already quoted
    my @cols = $_[1]
        ? @{$_[1]} # use what's given us (in the recursion cases)
        # or (the initial case) use all cols, sorted longest to shortest
        # This is necessary so that 'foo bar' gets processed before 'foo',
        #  so that if you have "foo bar" it doesn't become "`foo` bar"
        : sort { length $b <=> length $a } map { "$_" } $caller->all_columns
    ;
    return $_[0] unless @cols;
    my $c = shift @cols; # process first col
    my $quoted = $caller->db_Main->quote_identifier($c);
    $_[0] =~ s/\b(?<!$char)$c(?!$char)\b/$quoted/g; # quote it where it's currently unquoted
    # Recurse on all the pieces w/the remaining columns to process.
    # Note the the quoted ones will just return right way.
    my @s = map { $self->_backtickify_arg($_,\@cols) } split /($quoted)/, $_[0];
    $_[0] = join '', @s;
    return $_[0];
}

sub _do_transformation {
	my $me     = shift;
	my $sql    = $me->{_sql};
	my @args   = @{ $me->{_args} };
	my $caller = $me->{_caller};

	# Each entry in @args is a SQL fragment. This will bugger with fragments that
	# contain strings that match column names but are not supposed to be column names.
	$me->_backtickify_arg($_) for @args;

	$sql =~ s/__TABLE(?:\((.+?)\))?__/$me->_expand_table($1)/eg;
	$sql =~ s/__JOIN\((.+?)\)__/$me->_expand_join($1)/eg;
	$sql =~ s/__ESSENTIAL__/join ", ", map { $caller->db_Main->quote_identifier($_) } $caller->_essential/eg;
	$sql =~
		s/__ESSENTIAL\((.+?)\)__/join ", ", map $caller->db_Main->quote_identifier($1,$_), $caller->_essential/eg;
	if ($sql =~ /__IDENTIFIER__/) {
		my $key_sql = join " AND ", map $caller->db_Main->quote_identifier($_).'=?', $caller->primary_columns;
		$sql =~ s/__IDENTIFIER__/$key_sql/g;
	}

	$me->{_transformed_sql}  = $sql;
	$me->{_transformed_args} = [@args];
	$me->{_transformed}      = 1;
	return 1;
}

1;