view release on metacpan or  search on metacpan

lib/DBIx/Custom.pm  view on Meta::CPAN

use 5.008007;
package DBIx::Custom;
use Object::Simple -base;

our $VERSION = '0.45';

use Carp 'confess';
use DBI;
use DBIx::Custom::Result;
use DBIx::Custom::Where;
use DBIx::Custom::Model;
use DBIx::Custom::Order;
use DBIx::Custom::Util qw/_array_to_hash _subname _deprecate/;
use DBIx::Custom::Mapper;
use DBIx::Custom::NotExists;
use DBIx::Custom::Query;
use DBIx::Connector;

use Encode qw/encode encode_utf8 decode_utf8/;
use Scalar::Util qw/weaken/;

has [qw/dsn password quote user exclude_table user_table_info
     user_column_info safety_character/];
has connector => 1;
has option => sub { {} };
has default_option => sub {
  {
    RaiseError => 1,
    PrintError => 0,
    AutoCommit => 1
  }
};
has filters => sub {
  {
    encode_utf8 => sub { encode_utf8($_[0]) },
    decode_utf8 => sub { decode_utf8($_[0]) }
  }
};
has last_sql => '';
has models => sub { {} };
has now => sub {
  sub {
    my ($sec, $min, $hour, $mday, $mon, $year) = localtime;
    $mon++;
    $year += 1900;
    my $now = sprintf("%04d-%02d-%02d %02d:%02d:%02d",
      $year, $mon, $mday, $hour, $min, $sec);
    return $now;
  }
};
has result_class  => 'DBIx::Custom::Result';
has separator => '.';

has mytable_symbol => '__MY__';

has 'column_name_lc';

sub create_result {
  my ($self, $sth) = @_;
  
  return $self->result_class->new(sth => $sth, dbi => $self);
}

sub column {
  my $self = shift;
  my $option = pop if ref $_[-1] eq 'HASH';
  my $real_table = shift;
  my $columns = shift;
  my $table = $option->{alias} || $real_table;
  
  # Columns
  if (!defined $columns || $columns eq '*') {
    $columns = $self->model($real_table)->columns;
  }
  
  # Separator
  my $separator = $self->separator;
  
  # . is replaced
  my $t = $table;

lib/DBIx/Custom.pm  view on Meta::CPAN

      my $quote =  $driver eq 'odbc' ? '[]'
        : $driver eq 'ado' ? '[]'
        : $driver eq 'mysql' ? '`'
        : '"';
      $self->quote($quote);
    }
    
    return $self->{dbh};
  }
}

sub delete {
  my ($self, %opt) = @_;
  
  # Don't allow delete all rows
  confess qq{delete method where or id option must be specified } . _subname
    if !$opt{where} && !defined $opt{id} && !$opt{allow_delete_all};
  
  # Where
  my $where;
  if (defined $opt{id}) {
    $where = $self->_id_to_param($opt{id}, $opt{primary_key}, $opt{table}) ;
  }
  else {
    $where = $opt{where};
  }
  my $w = $self->_where_clause_and_param($where);
  
  # Delete statement
  my $sql = "delete ";
  $sql .= "$opt{prefix} " if defined $opt{prefix};
  $sql .= "from " . $self->_tq($opt{table}) . " $w->{clause} ";
  
  # Execute query
  $self->execute($sql, $w->{param}, %opt);
}

sub delete_all { shift->delete(@_, allow_delete_all => 1) }

sub create_model {
  my $self = shift;
  
  my $opt;
  if (@_ % 2 != 0 && !ref $_[0]) {
    $opt = {table => shift, @_};
  }
  else {
    $opt = ref $_[0] eq 'HASH' ? $_[0] : {@_};
  }
  
  # Options
  $opt->{dbi} = $self;
  my $model_class = delete $opt->{model_class} || 'DBIx::Custom::Model';
  my $model_name  = delete $opt->{name};
  my $model_table = delete $opt->{table};
  $model_name ||= $model_table;
  my $column_name_lc = delete $opt->{column_name_lc};
  
  # Create model
  my $model = $model_class->new($opt);
  weaken $model->{dbi};
  $model->table($model_table) unless $model->table;
  $model->name($model_name);

  if (!$model->columns || !@{$model->columns}) {
    $model->columns($self->get_columns_from_db($model->table, {column_name_lc => $column_name_lc}));
  }
  
  # Set model
  $self->model($model_name, $model);
  
  return $self->model($model->name);
}

sub execute {
  my $self = shift;
  my $sql = shift;
  
  # Options
  my $param;
  $param = shift if @_ % 2;
  $param ||= {};
  my %opt = @_;
  
  # Append
  $sql .= $opt{append} if defined $opt{append};

  # Parse named place holder
  my $safe_char = $self->{safety_character};
  my $place_holder_re = $safe_char eq 'a-zA-Z0-9_'
    ? qr/(.*?[^\\]):([$safe_char\.]+)(?:\{(.*?)\})?(.*)/so
    : qr/(.*?[^\\]):([$safe_char\.]+)(?:\{(.*?)\})?(.*)/s;
  my $source_sql = $sql;
  $source_sql =~ s/([0-9]):/$1\\:/g;
  my $parsed_sql = '';
  my $columns;
  while ($source_sql =~ /$place_holder_re/) {
    push @$columns, $2;
    ($parsed_sql, $source_sql) = defined $3 ?
      ($parsed_sql . "$1$2 $3 ?", "$4") : ($parsed_sql . "$1?", "$4");
  }
  $parsed_sql .= $source_sql;
  $parsed_sql =~ s/\\:/:/g if index($parsed_sql, "\\:") != -1;
  
  # Edit SQL after building
  my $after_build_sql = $opt{after_build_sql};
  $parsed_sql = $after_build_sql->($parsed_sql) if $after_build_sql;
  
  # Type rule
  my $type_filters;
  if ($self->{_type_rule_is_called}) {
    $type_filters = {};
    unless ($opt{type_rule_off}) {
      my $tables = $opt{table} || [];
      $tables = [$tables] unless ref $tables eq 'ARRAY';

      # Tables
      my $main_table = @{$tables}[-1];
      
      my $type_rule_off_parts = {
        1 => $opt{type_rule1_off},