view release on metacpan or  search on metacpan

lib/DBIx/PgLink/Connector.pm  view on Meta::CPAN

package DBIx::PgLink::Connector;

use Carp;
use Moose;
use MooseX::Method;
use DBIx::PgLink::Logger qw/trace_msg trace_level/;
use DBIx::PgLink::Local;
use DBIx::PgLink::Types;
use Scalar::Util qw/weaken/;
use Data::Dumper;

extends 'Moose::Object';

our $VERSION = '0.01';

has 'conn_name' => (
  is  => 'ro',
  isa => 'Str',
  required => 1,
);

has 'adapter' => (
  is  => 'rw',
  isa => 'DBIx::PgLink::Adapter',
);

has 'credentials' => (
  is  => 'rw',
  isa => 'HashRef',
);

with 'DBIx::PgLink::RoleInstaller';

# functions spread out to fixed roles
with 'DBIx::PgLink::TypeMapper';
with 'DBIx::PgLink::Accessor';
with 'DBIx::PgLink::RemoteAction';


sub BUILD {
  my $self = shift;
  my $self_attr = shift;

  # load main connection record
  my $conn = $self->load_connection;

  # include additional paths
  $self->use_libs( $conn->{use_libs} );

  # apply Connector roles to myself
  $self->load_roles('Connector', $self);

  # check adapter class
  my $adapter_class = $self->require_class($conn->{adapter_class}, "DBIx::PgLink::Adapter");

  # load remote credentials
  $self->credentials( $self->load_credentials($conn->{logon_mode}) )
    or croak "Access to the " . $self->conn_name . " is denied because no login-mapping exists";

  # load attributes
  my $attr_href = $self->load_attributes;

  # pass weak reference to self
  $attr_href->{connector} = $self;
  weaken $attr_href->{connector};

  # create adapter
  trace_msg('INFO', "Creating adapter '$adapter_class' for connection " . $self->conn_name) 
    if trace_level>=2;
  $self->adapter( $adapter_class->new($attr_href) );

  # remove applied attributes from hash
  # the rest belongs to DBI or Adapter role
  $self->apply_attributes_to_adapter($attr_href, 1);

  # apply adapter roles
  $self->load_roles('Adapter', $self->adapter);

  # set role attributes
  # the rest belongs to DBI (and DBI->connect ignore unknown attributes)
  $self->apply_attributes_to_adapter($attr_href);


  return if $self_attr->{no_connect}; # for debugging and connection uninstall

  # connect to remote database
  $self->adapter->connect(
    $conn->{data_source}, 
    $self->credentials->{remote_user}, 
    $self->credentials->{remote_password}, 
    $attr_href
  );
  trace_msg('NOTICE', "Connection " . $self->conn_name . " established to data source $conn->{data_source}" 
    . " as '" . $self->credentials->{remote_user} . "'"
  ) if trace_level>=1;

  return;
}


sub load_connection {
  my $self = shift;
  my $conn = pg_dbh->selectrow_hashref(<<'END_OF_SQL',
SELECT *
FROM dbix_pglink.connections
WHERE conn_name = $1
END_OF_SQL
    {  
      Slice=>{},
      array=>[qw/use_libs/],
    }, 
    $self->conn_name,
  );
  confess "Connection named '" . $self->conn_name . "' not found" unless $conn;
  return $conn;
}


sub use_libs {
  my $self = shift;
  my $libs = shift or return;

  for my $lib (@{$libs}) {
    eval q/use lib $lib/; # change global @INC, not scoped
  }