Open-ILS/src/perlmods/lib/OpenILS/Application/Storage/Driver/Pg.pm

   1
   2 { # The driver package itself just needs a db_Main method (or db_standbys if
   3   #Class::DBI::Replication is in use) for Class::DBI to call.
   4   #
   5   # Any other fixups can go in here too... Also, the drivers should subclass the
   6   # DBI driver that they are wrapping, or provide a 'quote()' method that calls
   7   # the DBD::xxx::quote() method on FTI's behalf.
   8   #
   9   # The dirver MUST be a subclass of Class::DBI(::Replication) and
  10   # OpenILS::Application::Storage.
  11   #-------------------------------------------------------------------------------
  12     package OpenILS::Application::Storage::Driver::Pg;
  13     # The following modules add, or use, subroutines in modules that
  14     # are not available when this module is compiled.  We therefore
  15     # "require" these modules rather than "use" them.  Everything is
  16     # available at run time.
  17     require OpenILS::Application::Storage::Driver::Pg::cdbi;
  18     require OpenILS::Application::Storage::Driver::Pg::fts;
  19     require OpenILS::Application::Storage::Driver::Pg::storage;
  20     require OpenILS::Application::Storage::Driver::Pg::dbi;
  21
  22     use UNIVERSAL::require;
  23     BEGIN {
  24         'Class::DBI::Frozen::301'->use or 'Class::DBI'->use or die $@;
  25     }
  26     use base qw/Class::DBI OpenILS::Application::Storage/;
  27     use DBI;
  28     use OpenSRF::EX qw/:try/;
  29     use OpenSRF::DomainObject::oilsResponse;
  30     use OpenSRF::Utils::Logger qw/:level/;
  31     my $log = 'OpenSRF::Utils::Logger';
  32
  33     __PACKAGE__->set_sql( retrieve_limited => 'SELECT * FROM __TABLE__ ORDER BY id LIMIT ?' );
  34     __PACKAGE__->set_sql( copy_start => 'COPY %s (%s) FROM STDIN;' );
  35     __PACKAGE__->set_sql( copy_end => '\.' );
  36
  37     my $primary_db;
  38     my @standby_dbs;
  39     my $_db_params;
  40
  41     sub db_Handles {
  42         return ($primary_db, @standby_dbs);
  43     }
  44
  45     sub child_init {
  46         my $self = shift;
  47         $_db_params = shift;
  48
  49         $log->debug("Running child_init inside ".__PACKAGE__, INTERNAL);
  50
  51         $_db_params = [ $_db_params ] unless (ref($_db_params) eq 'ARRAY');
  52
  53         my %attrs = (   %{$self->_default_attributes},
  54                 RootClass => 'DBIx::ContextualFetch',
  55                 ShowErrorStatement => 1,
  56                 RaiseError => 1,
  57                 AutoCommit => 1,
  58                 PrintError => 1,
  59                 Taint => 1,
  60                 #TraceLevel => "1|SQL",
  61                 pg_enable_utf8 => 1,
  62                 pg_server_prepare => 0,
  63                 FetchHashKeyName => 'NAME_lc',
  64                 ChopBlanks => 1,
  65         );
  66
  67         my $primary = shift @$_db_params;
  68         $$primary{port} ||= '5432';
  69         $$primary{host} ||= 'localhost';
  70         $$primary{db} ||= 'openils';
  71
  72         $log->debug("Attempting to connect to $$primary{db} at $$primary{host}", INFO);
  73
  74         try {
  75             $primary_db = DBI->connect(
  76                 "dbi:Pg:".
  77                     "host=$$primary{host};".
  78                     "port=$$primary{port};".
  79                     "dbname=$$primary{db}".
  80                     ($$primary{application_name} ? ";application_name='$$primary{application_name}'": ""),
  81                 $$primary{user},
  82                 $$primary{pw},
  83                 \%attrs)
  84             || do { sleep(1);
  85                 DBI->connect(
  86                     "dbi:Pg:".
  87                         "host=$$primary{host};".
  88                         "port=$$primary{port};".
  89                         "dbname=$$primary{db}".
  90                         ($$primary{application_name} ? ";application_name='$$primary{application_name}'": ""),
  91                     $$primary{user},
  92                     $$primary{pw},
  93                     \%attrs) }
  94             || throw OpenSRF::EX::ERROR
  95                 ("Couldn't connect to $$primary{db}".
  96                  " on $$primary{host}::$$primary{port}".
  97                  " as $$primary{user}!!");
  98         } catch Error with {
  99             my $e = shift;
 100             $log->debug("Error connecting to database:\n\t$e\n\t$DBI::errstr", ERROR);
 101             throw $e;
 102         };
 103
 104         $log->debug("Connected to primary db $$primary{db} at $$primary{host}", INFO);
 105
 106         $primary_db->do("SET NAMES '$$primary{client_encoding}';") if ($$primary{client_encoding});
 107
 108         for my $db (@$_db_params) {
 109             try {
 110                 push @standby_dbs, DBI->connect("dbi:Pg:host=$$db{host};port=$$db{port};dbname=$$db{db}". ($$db{application_name} ? ";application_name='$$db{application_name}'" : ""),$$db{user},$$db{pw}, \%attrs)
 111                     || do { sleep(1); DBI->connect("dbi:Pg:host=$$db{host};port=$$db{port};dbname=$$db{db}". ($$db{application_name} ? ";application_name='$$db{application_name}'" : ""),$$db{user},$$db{pw}, \%attrs) }
 112                     || throw OpenSRF::EX::ERROR
 113                         ("Couldn't connect to $$db{db}".
 114                         " on $$db{host}::$$db{port}".
 115                         " as $$db{user}!!");
 116             } catch Error with {
 117                 my $e = shift;
 118                 $log->debug("Error connecting to database:\n\t$e\n\t$DBI::errstr", ERROR);
 119                 throw $e;
 120             };
 121
 122             $standby_dbs[-1]->do("SET NAMES '$$db{client_encoding}';") if ($$primary{client_encoding});
 123
 124             $log->debug("Connected to primary db '$$primary{db} at $$primary{host}", INFO);
 125         }
 126
 127         $log->debug("All is well on the western front", INTERNAL);
 128     }
 129
 130     sub db_Main {
 131         my $self = shift;
 132         return $primary_db if ($self->current_xact_session || $OpenILS::Application::Storage::WRITE);
 133         return $primary_db unless (@standby_dbs);
 134         return ($primary_db, @standby_dbs)[rand(scalar(@standby_dbs))];
 135     }
 136
 137     sub quote {
 138         my $self = shift;
 139         return $self->db_Main->quote(@_)
 140     }
 141
 142 #   sub tsearch2_trigger {
 143 #       my $self = shift;
 144 #       return unless ($self->value);
 145 #       $self->index_vector(
 146 #           $self->db_standbys->selectrow_array(
 147 #               "SELECT to_tsvector('default',?);",
 148 #               {},
 149 #               $self->value
 150 #           )
 151 #       );
 152 #   }
 153
 154     my $_xact_session;
 155     my $_audit_session;
 156
 157     sub current_xact_session {
 158         my $self = shift;
 159         if (defined($_xact_session)) {
 160             return $_xact_session;
 161         }
 162         return undef;
 163     }
 164
 165     sub current_audit_session {
 166         my $self = shift;
 167         if (defined($_audit_session)) {
 168             return $_audit_session;
 169         }
 170         return undef;
 171     }
 172
 173     sub current_xact_is_auto {
 174         my $self = shift;
 175         my $auto = shift;
 176         if (defined($_xact_session) and ref($_xact_session)) {
 177             if (defined $auto) {
 178                 $_xact_session->session_data(autocommit => $auto);
 179             }
 180             return $_xact_session->session_data('autocommit');
 181         }
 182     }
 183
 184     sub current_xact_id {
 185         my $self = shift;
 186         if (defined($_xact_session) and ref($_xact_session)) {
 187             return $_xact_session->session_id;
 188         }
 189         return undef;
 190     }
 191
 192     sub set_xact_session {
 193         my $self = shift;
 194         my $ses = shift;
 195         if (!defined($ses)) {
 196             return undef;
 197         }
 198         $_xact_session = $ses;
 199         return $_xact_session;
 200     }
 201
 202     sub set_audit_session {
 203         my $self = shift;
 204         my $ses = shift;
 205         if (!defined($ses)) {
 206             return undef;
 207         }
 208         $_audit_session = $ses;
 209         return $_audit_session;
 210     }
 211
 212     sub unset_xact_session {
 213         my $self = shift;
 214         my $ses = $_xact_session;
 215         undef $_xact_session;
 216         return $ses;
 217     }
 218
 219     sub unset_audit_session {
 220         my $self = shift;
 221         my $ses = $_audit_session;
 222         undef $_audit_session;
 223         return $ses;
 224     }
 225
 226 }
 227
 228 1;