lib/DBIx/Class/CDBICompat/ImaDBI.pm

   1 package DBIx::Class::CDBICompat::ImaDBI;
   2
   3 use strict;
   4 use warnings;
   5
   6 use NEXT;
   7 use base qw/Class::Data::Inheritable/;
   8
   9 __PACKAGE__->mk_classdata('_transform_sql_handlers' =>
  10   {
  11     'TABLE' => sub { return $_[0]->_table_name },
  12     'ESSENTIAL' => sub { join(' ', $_[0]->columns('Essential')) },
  13   } );
  14
  15 sub db_Main {
  16   return $_[0]->_get_dbh;
  17 }
  18
  19 sub _dbi_connect {
  20   my ($class, @info) = @_;
  21   $info[3] = { %{ $info[3] || {}} };
  22   $info[3]->{RootClass} = 'DBIx::ContextualFetch';
  23   return $class->NEXT::_dbi_connect(@info);
  24 }
  25
  26 sub __driver {
  27   return $_[0]->_get_dbh->{Driver}->{Name};
  28 }
  29
  30 sub set_sql {
  31   my ($class, $name, $sql) = @_;
  32   my $table = $class->_table_name;
  33   #$sql =~ s/__TABLE__/$table/;
  34   no strict 'refs';
  35   *{"${class}::sql_${name}"} =
  36     sub {
  37       my $sql = $sql;
  38       my $class = shift;
  39       return $class->_sql_to_sth($class->transform_sql($sql, @_));
  40     };
  41   if ($sql =~ /select/i) {
  42     my $meth = "sql_${name}";
  43     *{"${class}::search_${name}"} =
  44       sub {
  45         my ($class, @args) = @_;
  46         $class->sth_to_objects($class->$meth, \@args);
  47       };
  48   }
  49 }
  50
  51 sub transform_sql {
  52   my ($class, $sql, @args) = @_;
  53   my $table = $class->_table_name;
  54   foreach my $key (keys %{ $class->_transform_sql_handlers }) {
  55     my $h = $class->_transform_sql_handlers->{$key};
  56     $sql =~ s/__$key(?:\(([^\)]+)\))?__/$h->($class, $1)/eg;
  57   }
  58   return sprintf($sql, @args);
  59 }
  60
  61 1;