lib/SGN/Role/Site/DBConnector.pm

   1 package SGN::Role::Site::DBConnector;
   2 use 5.10.0;
   3
   4 use Moose::Role;
   5 use namespace::autoclean;
   6
   7 use Carp;
   8 use CXGN::DB::Connection;
   9 use Storable;
  10
  11 requires qw(
  12             config
  13            );
  14
  15 =head2 dbc
  16
  17   Usage: $c->dbc('profile_name')->dbh->do($sql)
  18   Desc : get a L<DBIx::Connector> connection for the
  19          given profile name, or from profile 'default' if not given
  20   Args : optional profile name
  21   Ret  : a L<DBIx::Connector> connection
  22   Side Effects: uses L<DBIx::Connector> to manage database connections.
  23                 calling dbh() on the given connection will create a new
  24                 database handle on the connection if necessary
  25
  26   Example:
  27
  28      # straightforward use of a dbh
  29      $c->dbc
  30        ->dbh
  31        ->do($sql);
  32
  33      # faster way to do the same thing.  be careful though, read the
  34      # DBIx::Connector::run() documentation before doing this
  35      $c->dbc->run( fixup => sub { $_->do($sql) });
  36
  37      # do something in a transaction
  38      $c->dbc->txn( ping  => sub {
  39          my $dbh = shift;
  40          # do some stuff...
  41      });
  42
  43 =cut
  44
  45 sub _connections {
  46     my ($class) = @_;
  47     $class = ref $class if ref $class;
  48     state %connections;
  49     $connections{$class} ||= {};
  50 }
  51
  52 sub dbc {
  53     my ( $self, $profile_name ) = @_;
  54     $profile_name ||= 'default';
  55
  56     my $profile = $self->dbc_profile( $profile_name );
  57
  58     my $conn = $self->_connections->{$profile_name} ||=
  59         SGN::Role::Site::DBConnector::Connector->new( @{$profile}{qw| dsn user password attributes |} );
  60
  61     return $conn;
  62 }
  63 sub dbc_profile {
  64     my ( $self, $profile_name ) = @_;
  65     $profile_name ||= 'default';
  66
  67     $self->_build_compatibility_profiles(); #< make sure our compatibility profiles are set
  68
  69     my $profile = $self->config->{'DatabaseConnection'}->{$profile_name}
  70         or croak "connection profile '$profile_name' not defined";
  71
  72     # generate the string to set as the search path for this profile,
  73     # if necessary
  74     $profile->{'attributes'}{'private_search_path_string'}
  75         ||= $profile->{search_path} ? join ',',map qq|"$_"|, @{$profile->{'search_path'}}  :
  76                                       'public';
  77
  78     return $profile;
  79 }
  80
  81 # called on database handles to make sure they are setting the right
  82 # search path
  83 sub ensure_dbh_search_path_is_set {
  84     my ($self,$dbh) = @_;
  85     return $dbh if $dbh->{private_search_path_is_set};
  86
  87     $dbh->do("SET search_path TO $dbh->{private_search_path_string}");
  88     #warn "SET search_path TO $dbh->{private_search_path_string}";
  89
  90     $dbh->{private_search_path_is_set} = 1;
  91     return $dbh;
  92 }
  93
  94
  95 # generates 'default' and 'sgn_chado' profiles that are compatibile
  96 # with the legacy CXGN::DB::Connection
  97 sub _build_compatibility_profiles {
  98     my ($self) = @_;
  99
 100     # make a default profile
 101     $self->config->{'DatabaseConnection'}->{'default'} ||= do {
 102         require CXGN::DB::Connection;
 103         my %conn;
 104         @conn{qw| dsn user password attributes |} =
 105             CXGN::DB::Connection->new_no_connect({ config => $self->config })
 106                                 ->get_connection_parameters;
 107
 108         $conn{attributes}{AutoCommit} = 1;
 109         $conn{attributes}{pg_enable_utf8} = 1;
 110
 111         $conn{search_path} = $self->config->{'dbsearchpath'} || ['public'];
 112         \%conn
 113     };
 114
 115     # make a second profile 'sgn_chado' that removes the sgn search path
 116     # from the beginning
 117     $self->config->{'DatabaseConnection'}->{'sgn_chado'} ||= do {
 118         my $c = Storable::dclone( $self->config->{'DatabaseConnection'}->{'default'} );
 119         if( $c->{search_path}->[0] eq 'sgn' ) {
 120             push @{$c->{search_path}}, shift @{$c->{search_path}};
 121         }
 122         $c
 123     }
 124 }
 125
 126
 127 { # tiny DBIx::Connector subclass that makes sure search paths are set
 128   # on database handles before returning them
 129   package SGN::Role::Site::DBConnector::Connector;
 130   use strict;
 131   use warnings FATAL => 'all';
 132   use base 'DBIx::Connector';
 133
 134   sub dbh {
 135       my $dbh = shift->SUPER::dbh(@_);
 136       SGN::Role::Site::DBConnector->ensure_dbh_search_path_is_set( $dbh );
 137       return $dbh;
 138   }
 139 }
 140
 141
 142 1;