lib/DBIx/Class/SQL.pm

   1 package DBIx::Class::SQL;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/Class::Data::Inheritable/;
   7
   8 use constant COLS => 0;
   9 use constant FROM => 1;
  10 use constant COND => 2;
  11
  12 =head1 NAME
  13
  14 DBIx::Class::SQL -  SQL Specific methods for DBIx::Class
  15
  16 =head1 SYNOPSIS
  17
  18 =head1 DESCRIPTION
  19
  20 This class contains methods that generates SQL queries for
  21 the rest of the L<DBIx::Class> hiarchy. It's also responsible
  22 for executing these.
  23
  24 =cut
  25
  26 __PACKAGE__->mk_classdata('_sql_statements',
  27   {
  28     'select' =>
  29       sub { "SELECT ".join(', ', @{$_[COLS]})." FROM $_[FROM] WHERE $_[COND]"; },
  30     'update' =>
  31       sub { "UPDATE $_[FROM] SET ".join(', ', map { "$_ = ?" } @{$_[COLS]}).
  32               " WHERE $_[COND]"; },
  33     'insert' =>
  34       sub { "INSERT INTO $_[FROM] (".join(', ', @{$_[COLS]}).") VALUES (".
  35               join(', ', map { '?' } @{$_[COLS]}).")"; },
  36     'delete' =>
  37       sub { "DELETE FROM $_[FROM] WHERE $_[COND]"; },
  38   } );
  39
  40 sub _get_sql {
  41   my ($class, $name, $cols, $from, $cond) = @_;
  42   my $sql = $class->_sql_statements->{$name}->($cols, $from, $cond);
  43   #warn $sql;
  44   return $sql;
  45 }
  46
  47 sub _sql_to_sth {
  48   my ($class, $sql) = @_;
  49   return $class->_get_dbh->prepare($sql);
  50 }
  51
  52 sub _get_sth {
  53   my $class = shift;
  54   return $class->_sql_to_sth($class->_get_sql(@_));
  55 }
  56
  57 1;
  58
  59 =head1 AUTHORS
  60
  61 Matt S. Trout <perl-stuff@trout.me.uk>
  62
  63 =head1 LICENSE
  64
  65 You may distribute this code under the same terms as Perl itself.
  66
  67 =cut