view release on metacpan or  search on metacpan

lib/App/AutoCRUD/DataSource.pm  view on Meta::CPAN

package App::AutoCRUD::DataSource;

use strict;
use warnings;

use Moose;
use Carp;
use DBI;
use Clone           qw/clone/;
use List::MoreUtils qw/part/;
use Scalar::Does    qw/does/;
use Data::Reach     qw/reach/;
use SQL::Abstract::FromQuery 0.10;

use namespace::clean -except => 'meta';

has 'app'          => (is => 'ro', isa => 'App::AutoCRUD', required => 1,
                       weak_ref => 1, handles => [qw/ dir/]);
has 'name'         => (is => 'ro', isa => 'Str',
                       builder => '_name', lazy => 1);
has 'config'       => (is => 'ro', isa => 'HashRef', reader => 'config_data',
                       builder => '_config', lazy => 1);
has 'dbh'          => (is => 'ro', isa => 'DBI::db',
                       builder => '_dbh',  lazy => 1);
has 'schema'       => (is => 'ro', isa => 'Str|Object',
                       builder => '_schema', lazy => 1);
has 'query_parser' => (is => 'ro', isa => 'SQL::Abstract::FromQuery',
                       builder => '_query_parser', lazy => 1);
has 'tablegroups'  => (is => 'ro', isa => 'ArrayRef',
                       builder => '_tablegroups', lazy => 1);

# indirectly generated through the _schema builder method
has 'generated_schema' => (is => 'ro', isa => 'Str', init_arg => undef);
has 'loaded_class'     => (is => 'ro', isa => 'Str', init_arg => undef);



#======================================================================
# ATTRIBUTE BUILDERS
#======================================================================

sub _dbh {
  my $self = shift;
  my $dbh;

  # create a connection from specifications found in config
  if (my $connect_spec = $self->config(qw/dbh connect/)) {
    if (does($connect_spec, 'ARRAY')) {
      # regular DBI connect using the given list of arguments
      $dbh = DBI->connect(@$connect_spec)
        or die "can't connect to " . join(", ", @$connect_spec);
    }
    elsif (does($connect_spec, 'CODE')) {
      $dbh = $connect_spec->()
        or die "coderef connection to " . self->name . " failed";
    }
    elsif (does($connect_spec, '""')) {
      # config was a string : treat it as a line of Perl code
      local $@;
      $dbh = eval $connect_spec
        or die $@;
    }
    else {
      die "can't connect to " . $self->name . " (wrong config/dbh info)";
    }
  }

  # or recover existing connection in schema
  elsif (my $schema = $self->{schema}) { # bypass encapsulation to avoid
                                         # circular calls with ->_schema()
    $dbh = $schema->dbh;
  }

  # report failure if no connection found
  $dbh
    or die "no DBI/connect information in config for " . $self->name;

  return $dbh;
}

sub _schema {
  my $self = shift;

  my $required_class = $self->config('require');
  my $schema_class   = $self->config('schema_class') || $required_class;

  # if external code is required, load it
  if ($required_class && 
        !($schema_class && $self->app->is_class_loaded($schema_class))) {