File Coverage

lib/UR/DataSource/RDBMS.pm
Criterion Covered Total %
statement 1269 1684 75.3
branch 371 642 57.7
condition 142 299 47.4
subroutine 99 123 80.4
pod 5 47 10.6
total 1886 2795 67.4


line stmt bran cond sub pod time code
1             package UR::DataSource::RDBMS;
2              
3             # NOTE:: UR::DataSource::QueryPlan has conditional logic
4             # for this class/subclasses currently
5              
6 130     130   5211 use strict;
  130         172  
  130         3546  
7 130     130   436 use warnings;
  130         157  
  130         3052  
8 130     130   437 use Scalar::Util;
  130         155  
  130         4921  
9 130     130   475 use List::MoreUtils;
  130         178  
  130         1551  
10 130     130   33062 use File::Basename;
  130         177  
  130         266286  
11              
12             require UR;
13             our $VERSION = "0.46"; # UR $VERSION;
14              
15             UR::Object::Type->define(
16             class_name => 'UR::DataSource::RDBMS',
17             is => ['UR::DataSource','UR::Singleton'],
18             is_abstract => 1,
19             has => [
20             server => { is => 'Text', doc => 'the "server" part of the DBI connect string' },
21             login => { is => 'Text', doc => 'user name to connect as', is_optional => 1 },
22             auth => { is => 'Text', doc => 'authentication for the given user', is_optional => 1 },
23             owner => { is => 'Text', doc => 'Schema/owner name to connect to', is_optional => 1 },
24             ],
25              
26             has_optional => [
27             alternate_db_dsn => {
28             is => 'Text',
29             default_value => 0,
30             doc => 'Set to a DBI dsn to copy all data queried from this datasource to an alternate database',
31             },
32             camel_case_table_names => {
33             is => 'Boolean',
34             default_value => 0,
35             doc => 'When true, dynamically calculating class names from table names will expect camel case in table names.',
36             },
37             camel_case_column_names => {
38             is => 'Boolean',
39             default_value => 0,
40             doc => 'When true, dynamically calculating property names from column names will expect camel case in column names.',
41             },
42             _all_dbh_hashref => { is => 'HASH', len => undef, is_transient => 1 },
43             _last_savepoint => { is => 'Text', len => undef, is_transient => 1 },
44             ],
45             valid_signals => ['query', 'query_failed', 'commit_failed', 'do_failed', 'connect_failed', 'sequence_nextval', 'sequence_nextval_failed'],
46             doc => 'A logical DBI-based database, independent of prod/dev/testing considerations or login details.',
47             );
48              
49             # A record of objects saved to the database. It's filled in by _sync_database()
50             # and used by the alternate DB saving code. Objects noted in this hash don't get
51             # saved to the alternate DB
52             my %objects_in_database_saved_by_this_process;
53              
54             sub database_exists {
55 0     0 0 0 my $self = shift;
56 0         0 warn $self->class . " failed to implement the database_exists() method. Testing connection as a surrogate. FIXME here!\n";
57 0         0 eval {
58 0         0 my $c = $self->create_default_handle();
59             };
60 0 0       0 if ($@) {
61 0         0 return;
62             }
63 0         0 return 1;
64             }
65              
66             sub create_database {
67 0     0 0 0 my $self = shift;
68 0         0 die $self->class . " failed to implement the create_database() method!"
69             . " Unable to initialize a new database for this data source "
70             . $self->__display_name__ . " FIXME here.\n";
71             }
72              
73             sub _resolve_ddl_for_table {
74 0     0   0 my ($self,$table, %opts) = @_;
75              
76 0         0 my $all = delete $opts{all};
77 0 0       0 if (%opts) {
78 0         0 Carp::confess("odd arguments to _resolve_ddl_for_table: " . UR::Util::d(\%opts));
79             }
80              
81 0         0 my $table_name = $table->table_name;
82 0         0 my @ddl;
83 0 0 0     0 if ($table->{db_committed} and not $all) {
84 0         0 my @columns = $table->columns;
85 0         0 for my $column (@columns) {
86 0 0 0     0 next unless $all or $column->last_object_revision eq '-';
87 0         0 my $column_name = $column->column_name;
88 0         0 my $ddl = "alter table $table_name add column ";
89              
90 0         0 $ddl .= "\t$column_name " . $column->data_type;
91 0 0       0 if ($column->data_length) {
92 0         0 $ddl .= '(' . $column->data_length . ')';
93             }
94 0 0       0 push(@ddl, $ddl) if $ddl;
95             }
96             }
97             else {
98 0         0 my $ddl;
99 0         0 my @columns = $table->columns;
100 0         0 for my $column (@columns) {
101 0 0 0     0 next unless $all or $column->last_object_revision eq '-';
102 0         0 my $column_name = $column->column_name;
103 0 0       0 $ddl = 'create table ' . $table_name . "(\n" unless defined $ddl;
104              
105 0         0 $ddl .= "\t$column_name " . $column->data_type;
106 0 0       0 if ($column->data_length) {
107 0         0 $ddl .= '(' . $column->data_length . ')';
108             }
109              
110 0 0       0 $ddl .= ",\n" unless $column eq $columns[-1];
111             }
112 0 0       0 $ddl .= "\n)" if defined $ddl;
113 0 0       0 push(@ddl, $ddl) if $ddl;
114             }
115 0         0 return @ddl;
116             }
117              
118             sub generate_schema_for_class_meta {
119 42     42 0 76 my ($self, $class_meta, $temp) = @_;
120              
121             # We now support on-the-fly database introspection
122             # this gets called with the temp flag when _sync_database realizes
123             # it knows nothing about the table in question.
124            
125             # We basically presume the schema is the one we would have generated
126             # given the current class definitions
127              
128             # TODO: We still need to presume foreign keys are constrained.
129              
130 42 50       117 my $method = ($temp ? '__define__' : 'create');
131 42         44 my @defined;
132 42         233 my $table_name = $class_meta->table_name;
133 42         63 my @fks_to_generate;
134 42         330 for my $p ($class_meta->parent_class_metas) {
135 43 100 100     187 next if ($p->class_name eq 'UR::Object' or $p->class_name eq 'UR::Entity');
136 16 50       44 next unless $p->class_name->isa("UR::Object");
137 16         135 my @new = $self->generate_schema_for_class_meta($p,$temp);
138 16         24 push @defined, @new;
139              
140 16         20 my $parent_table;
141 16 100       43 if (($parent_table) = grep { $_->isa("UR::DataSource::RDBMS::Table") } @new) {
  14         72  
142 4         37 my @id_by = $class_meta->id_property_names;
143 4         11 my @column_names = map { $class_meta->property($_)->column_name } @id_by;
  4         50  
144 4         16 my $r_table_name = $parent_table->table_name;
145             ##$DB::single = 1; # get pk columns
146 4         24 my @r_id_by = $p->id_property_names;
147 4         11 my @r_column_names = map { $class_meta->property($_)->column_name } @r_id_by;
  4         16  
148 4         18 push @fks_to_generate, [$class_meta->class_name, $table_name, $r_table_name, \@column_names, \@r_column_names];
149             }
150             }
151              
152             my %properties_with_expected_columns =
153 65         135 map { $_->column_name => $_ }
154 42         386 grep { $_->column_name }
  87         209  
155             $class_meta->direct_property_metas;
156              
157             #my %expected_constraints =
158             # map { $_->column_name => $_ }
159             # grep { $_->class_meta eq $class_meta }
160             # map { $class_meta->property_meta_for_name($_) }
161             # map { @{ $_->id_by } }
162             # grep { $_->id_by }
163             # $class_meta->all_property_metas;
164             #print Data::Dumper::Dumper(\%expected_constraints);
165            
166 42 100       148 unless ($table_name) {
167 14 50       46 if (my @column_names = keys %properties_with_expected_columns) {
168 0         0 Carp::confess("class " . $class_meta->__display_name__ . " has no table_name specified for columns @column_names!");
169             }
170             else {
171             # no table, but no storable columns. all ok.
172 14         40 return;
173             }
174             }
175              
176             ## print "handling table $table_name\n";
177              
178 28 50       145 if ($table_name =~ /[^\w\.]/) {
179             # pass back anything from parent classes, but do nothing for special "view" tables
180             #$DB::single = 1;
181 0         0 return @defined;
182             }
183            
184 28         56 my $t = '-';
185              
186 28         229 my $table = $self->refresh_database_metadata_for_table_name($table_name, $method);
187            
188 28         50 my %existing_columns;
189 28 50       82 if ($table) {
190             ## print "found table $table_name\n";
191             %existing_columns =
192 66         127 map { $_->column_name => $_ }
193 28         386 grep { $_->column_name }
  66         145  
194             $table->columns;
195 28         120 push @defined, ($table,$table->columns);
196             }
197             else {
198             ## print "adding table $table_name\n";
199 0 0       0 $table = UR::DataSource::RDBMS::Table->$method(
200             table_name => $table_name,
201             data_source => $self->_my_data_source_id,
202             remarks => $class_meta->doc,
203             er_type => 'entity',
204             last_object_revision => $t,
205             table_type => ($table_name =~ /\s/ ? 'view' : 'table'),
206             );
207 0 0       0 Carp::confess("Failed to create metadata or table $table_name") unless $table;
208 0         0 push @defined, $table;
209             }
210              
211 28         271 my ($update,$add,$extra) = UR::Util::intersect_lists([keys %properties_with_expected_columns],[keys %existing_columns]);
212              
213 28         84 for my $column_name (@$extra) {
214 1         2 my $column = $existing_columns{$column_name};
215 1         5 $column->last_object_revision('?');
216             }
217            
218 28         64 for my $column_name (@$add) {
219 0         0 my $property = $properties_with_expected_columns{$column_name};
220             #print "adding column $column_name\n";
221 0   0     0 my $column = UR::DataSource::RDBMS::TableColumn->$method(
222             column_name => $column_name,
223             table_name => $table->table_name,
224             data_source => $table->data_source,
225             namespace => $table->namespace,
226             data_type => $self->object_to_db_type($property->data_type) || 'Text',
227             data_length => $property->data_length,
228             nullable => $property->is_optional,
229             remarks => $property->doc,
230             last_object_revision => $t,
231             );
232 0         0 push @defined, $column;
233             }
234              
235 28         69 for my $column_name (@$update) {
236 65         106 my $property = $properties_with_expected_columns{$column_name};
237 65         85 my $column = $existing_columns{$column_name};
238             ##print "updating column $column_name with data from property " . $property->property_name . "\n";
239 65 50       176 if ($column->data_type) {
240 65 100       170 $column->data_type($self->object_to_db_type($property->data_type)) if $property->data_type;
241             }
242             else {
243 0   0     0 $column->data_type($self->object_to_db_type($property->data_type) || 'Text');
244             }
245 65         191 $column->data_length($property->data_length);
246 65         176 $column->nullable($property->is_optional);
247 65         188 $column->remarks($property->doc);
248             }
249              
250 28         527 for my $property ( $class_meta->direct_id_property_metas ) {
251              
252 31 100       139 unless (UR::DataSource::RDBMS::PkConstraintColumn->get(table_name => $table->table_name, column_name => $property->column_name, data_source => $table->data_source)) {
253 4         16 UR::DataSource::RDBMS::PkConstraintColumn->$method(
254             column_name => $property->column_name,
255             data_source => $table->data_source,
256             rank => $property->is_id,
257             table_name => $table->table_name );
258             }
259             }
260              
261             # this "property_metas" method filers out things which have an id_by.
262             # it used to call ->properties, which used that method internally ...but seems like it never could have done anything?
263 28         345 for my $property ($class_meta->property_metas) {
264 74         184 my $id_by = $property->id_by;
265 74 50       169 next unless $id_by;
266 0         0 my $r_class_name = $property->data_type;
267 0         0 my $r_class_meta = $r_class_name->__meta__;
268 0         0 my $r_table_name = $r_class_meta->table_name;
269 0 0       0 next unless $r_table_name;
270 0         0 my @column_names = map { $class_meta->property($_)->column_name } @$id_by;
  0         0  
271 0         0 my @r_column_names = map { $r_class_meta->property($_)->column_name } @{ $r_class_meta->id_property_names };
  0         0  
  0         0  
272              
273 0         0 push @fks_to_generate, [$property->id, $table_name, $r_table_name, \@column_names, \@r_column_names ];
274             }
275              
276 28         70 for my $fk_to_generate (@fks_to_generate) {
277 1         6 my ($fk_id, $table_name, $r_table_name, $column_names, $r_column_names) = @$fk_to_generate;
278            
279 1         10 my $fk = UR::DataSource::RDBMS::FkConstraint->$method(
280             fk_constraint_name => $fk_id,
281             table_name => $table_name,
282             r_table_name => $r_table_name,
283             data_source => $self->_my_data_source_id,
284             last_object_revision => '-',
285             );
286 1 50       5 unless ($fk) {
287 0         0 die "failed to generate an implied foreign key constraint for $table_name => $r_table_name!"
288             . UR::DataSource::RDBMS::FkConstraint->error_message;
289             }
290 1         5 push @defined, $fk;
291              
292 1         6 for (my $n = 0; $n < @$column_names; $n++) {
293 1         2 my $column_name = $column_names->[$n];
294 1         4 my $r_column_name = $r_column_names->[$n];
295 1         7 my %fkcol_params = ( fk_constraint_name => $fk_id,
296             table_name => $table_name,
297             column_name => $column_name,
298             r_table_name => $r_table_name,
299             r_column_name => $r_column_name,
300             data_source => $self->_my_data_source_id,
301             );
302              
303 1         11 my $fkcol = UR::DataSource::RDBMS::FkConstraintColumn->get(%fkcol_params);
304 1 50       5 unless ($fkcol) {
305 1         9 $fkcol = UR::DataSource::RDBMS::FkConstraintColumn->$method(%fkcol_params);
306             }
307 1 50       5 unless ($fkcol) {
308 0         0 die "failed to generate an implied foreign key constraint for $table_name => $r_table_name!"
309             . UR::DataSource::RDBMS::FkConstraint->error_message;
310             }
311 1         8 push @defined, $fkcol;
312             }
313             }
314            
315             # handle missing meta datasource on the fly...
316 28 50       89 if (@defined) {
317 28         222 my $ns = $class_meta->namespace;
318 28         143 my $exists = UR::Object::Type->get($ns . "::DataSource::Meta");
319 28 100       113 unless ($exists) {
320 4         32 UR::DataSource::Meta->generate_for_namespace($ns);
321             }
322             }
323              
324 28 50       104 unless ($temp) {
325 0         0 my @ddl = $self->_resolve_ddl_for_table($table);
326 0         0 $t = $UR::Context::current->now;
327 0 0       0 if (@ddl) {
328 0         0 my $dbh = $table->data_source->get_default_handle;
329 0         0 for my $ddl (@ddl) {
330 0 0       0 $dbh->do($ddl) or Carp::confess("Failed to modify the database schema!: $ddl\n" . $dbh->errstr);
331 0         0 for my $o ($table, $table->columns) {
332 0         0 $o->last_object_revision($t);
333             }
334             }
335             }
336             }
337              
338 28         203 return @defined;
339             }
340              
341             # override in architecture-oriented subclasses
342             sub object_to_db_type {
343 41     41 0 59 my ($self, $object_type) = @_;
344 41         47 my $db_type = $object_type;
345             # ...
346 41         95 return $db_type;
347             }
348              
349             # override in architecture-oriented subclasses
350             sub db_to_object_type {
351 0     0 0 0 my ($self, $db_type) = @_;
352 0         0 my $object_type = $db_type;
353             # ...
354 0         0 return $object_type;
355             }
356              
357              
358             # FIXME - shouldn't this be a property of the class instead of a method?
359 126     126 0 602 sub does_support_joins { 1 }
360              
361             # Most RDBMSs support limit/offset selects
362 1436     1436 0 6154 sub does_support_limit_offset { 1 }
363              
364             sub get_class_meta_for_table {
365 0     0 0 0 my $self = shift;
366 0         0 my $table = shift;
367 0         0 my $table_name = $table->table_name;
368              
369 0         0 return $self->get_class_meta_for_table_name($table_name);
370             }
371              
372             sub get_class_meta_for_table_name {
373 0     0 0 0 my($self,$table_name) = @_;
374            
375             # There is an unique constraint on classes, but only those which use
376             # tables in an RDBMS, which dicates that there can be only two for
377             # a given table in a given data source: one for the ghost and one
378             # for the regular entity. We can't just fix this with a unique constraint
379             # since classes with a null data source would be lost in some queries.
380             my @class_meta =
381 0         0 grep { not $_->class_name->isa("UR::Object::Ghost") }
  0         0  
382             UR::Object::Type->get(
383             table_name => $table_name,
384             data_source => $self->class,
385             );
386            
387 0 0       0 unless (@class_meta) {
388             # This will load every class in the namespace on the first execution :(
389             ##$DB::single = 1;
390             @class_meta =
391 0         0 grep { not $_->class_name->isa("UR::Object::Ghost") }
  0         0  
392             UR::Object::Type->get(
393             table_name => $table_name,
394             data_source => $self->class,
395             );
396             }
397              
398 0         0 $self->context_return(@class_meta);
399             }
400              
401             sub dbi_data_source_name {
402 178     178 0 4850 my $self = shift->_singleton_object;
403 178         1372 my $driver = $self->driver;
404 178         583 my $server = $self->server;
405 178 50       932 unless ($driver) {
406 0         0 Carp::confess("Cannot resolve a dbi_data_source_name with an undefined driver()");
407             }
408 178 50       624 unless ($server) {
409 0         0 Carp::confess("Cannot resolve a dbi_data_source_name with an undefined server()");
410             }
411 178         856 return 'dbi:' . $driver . ':' . $server;
412             }
413              
414             *get_default_dbh = \&get_default_handle;
415             sub get_default_handle {
416 2697     2697 1 72917 my $self = shift->_singleton_object;
417 2697         11601 my $dbh = $self->SUPER::get_default_handle;
418 2695 50 33     43923 unless ($dbh && $dbh->{Active}) {
419 0         0 $self->__invalidate_get_default_handle__;
420 0         0 $dbh = $self->create_default_handle();
421             }
422 2695         8034 return $dbh;
423             }
424              
425              
426              
427              
428             sub get_for_dbh {
429 125     125 0 231 my $class = shift;
430 125         198 my $dbh = shift;
431 125         1426 my $ds_name = $dbh->{"private_UR::DataSource::RDBMS_name"};
432 125 50       526 return unless($ds_name);
433 125         1185 my $ds = UR::DataSource->get($ds_name);
434 125         469 return $ds;
435             }
436              
437             sub has_changes_in_base_context {
438 0     0 0 0 shift->has_default_handle;
439             # TODO: actually check, as this is fairly conservative
440             # If used for switching contexts, we'd need to safely rollback any transactions first.
441             }
442              
443              
444             sub _dbi_connect_args {
445 175     175   332 my $self = shift;
446              
447 175         315 my @connection;
448 175         1132 $connection[0] = $self->dbi_data_source_name;
449 175         1235 $connection[1] = $self->login;
450 175         1019 $connection[2] = $self->auth;
451 175         713 $connection[3] = { AutoCommit => 0, RaiseError => 0 };
452              
453 175         639 return @connection;
454             }
455              
456             sub get_connection_debug_info {
457 3     3 0 6 my $self = shift;
458 3         6 my $handle_class = $self->default_handle_class;
459 3   50     10 my @debug_info = (
      50        
460             "DBI Data Source Name: ", $self->dbi_data_source_name, "\n",
461             "DBI Login: ", $self->login || '' , "\n",
462             "DBI Version: ", $DBI::VERSION, "\n",
463             "DBI Error: ", $handle_class->errstr || '(no error)', "\n",
464             );
465 3         26 return @debug_info;
466             }
467              
468 172     172 0 372 sub default_handle_class { 'UR::DBI' };
469              
470 0     0 0 0 sub create_dbh { shift->create_default_handle_wrapper }
471             sub create_default_handle {
472 175     175 0 356 my $self = shift;
473 175 50 33     947 if (! ref($self) and $self->isa('UR::Singleton')) {
474 0         0 $self = $self->_singleton_object;
475             }
476            
477             # get connection information
478 175         1328 my @connection = $self->_dbi_connect_args();
479            
480             # connect
481 175         1551 my $handle_class = $self->default_handle_class;
482 175         1950 my $dbh = $handle_class->connect(@connection);
483 175 100       624 unless ($dbh) {
484 3         3 my $errstr;
485 130     130   742 { no strict 'refs';
  130         192  
  130         484291  
  3         8  
486 3         4 $errstr = ${"${handle_class}::errstr"};
  3         16  
487             };
488 3         15 my @confession = (
489             "Failed to connect to the database: $errstr\n",
490             $self->get_connection_debug_info(),
491             );
492 3         15 $self->__signal_observers__('connect_failed', 'connect', \@connection, $errstr);
493 1         193 Carp::confess(@confession);
494             }
495              
496             # used for reverse lookups
497 172         1716 $dbh->{'private_UR::DataSource::RDBMS_name'} = $self->class;
498              
499             # store the handle in a hash, since it's not a UR::Object
500 172         2046 my $all_dbh_hashref = $self->_all_dbh_hashref;
501 172 100       644 unless ($all_dbh_hashref) {
502 171         404 $all_dbh_hashref = {};
503 171         552 $self->_all_dbh_hashref($all_dbh_hashref);
504             }
505 172         560 $all_dbh_hashref->{$dbh} = $dbh;
506 172         925 Scalar::Util::weaken($all_dbh_hashref->{$dbh});
507              
508 172         1605 $self->is_connected(1);
509            
510 172         856 return $dbh;
511             }
512              
513             # The default is to ignore no tables, but derived classes
514             # will probably override this
515             sub _ignore_table {
516 0     0   0 0;
517             }
518              
519              
520             sub _table_name_to_use_for_metadata_objects {
521 44     44   84 my($self, $schema, $table_name) = @_;
522 44 100       113 return $self->owner
523             ? $table_name
524             : join('.', $schema, $table_name);
525             }
526              
527             sub _get_table_names_from_data_dictionary {
528 1     1   26 my $self = shift->_singleton_object;
529 1 50       6 if (@_) {
530 0         0 Carp::confess("get_tables does not currently take filters! FIXME.");
531             }
532 1         4 my $dbh = $self->get_default_handle;
533 1   50     8 my $owner = $self->owner || '%';
534              
535             # FIXME This will fix the immediate problem of getting classes to be created out of
536             # views. We still need to somehow mark the resulting class as read-only
537              
538 1         14 my $sth = $self->get_table_details_from_data_dictionary('%', $owner, '%', 'TABLE,VIEW');
539 1         6 my @names;
540 1         3 while (my $row = $sth->fetchrow_hashref) {
541 2         14 my $table_name = $self->_table_name_to_use_for_metadata_objects(@$row{'TABLE_SCHEM','TABLE_NAME'});
542 2         10 $table_name =~ s/"|'//g; # Postgres puts quotes around entities that look like keywords
543 2 50       14 next if $self->_ignore_table($table_name);
544 2         10 push @names, $table_name;
545             }
546 1         4 return @names;
547             }
548              
549              
550             # A wrapper for DBI's table_info() since the DBD implementations of them
551             # aren't always exactly what we need in other places in the system. Other
552             # subclasses can override it to get custom behavior
553             sub get_table_details_from_data_dictionary {
554 29     29 0 163 return shift->_get_whatever_details_from_data_dictionary('table_info',@_);
555             }
556              
557             sub _get_whatever_details_from_data_dictionary {
558 57     57   81 my $self = shift;
559 57         107 my $method = shift;
560              
561 57         416 my $dbh = $self->get_default_handle();
562 57 50       169 return unless $dbh;
563              
564 57         709 return $dbh->$method(@_);
565             }
566              
567             sub get_column_details_from_data_dictionary {
568 0     0 0 0 return shift->_get_whatever_details_from_data_dictionary('column_info',@_);
569             }
570              
571             sub get_foreign_key_details_from_data_dictionary {
572 0     0 0 0 return shift->_get_whatever_details_from_data_dictionary('foreign_key_info',@_);
573             }
574              
575             sub get_primary_key_details_from_data_dictionary {
576 28     28 0 130 return shift->_get_whatever_details_from_data_dictionary('primary_key_info',@_);
577             }
578              
579              
580             sub get_table_names {
581 22     22 0 146 map { $_->table_name } shift->get_tables(@_);
  42         636  
582             }
583              
584             sub get_tables {
585 22     22 0 52 my $self = shift;
586              
587             #my $class = shift->_singleton_class_name;
588             #return UR::DataSource::RDBMS::Table->get(data_source_id => $class);
589 22         33 my $ds_id;
590 22 50       77 if (ref $self) {
591 22 50       453 if ($self->can('id')) {
592 22         248 $ds_id = $self->id;
593             } else {
594 0         0 $ds_id = ref $self;
595             }
596             } else {
597 0         0 $ds_id = $self;
598             }
599 22         168 return UR::DataSource::RDBMS::Table->get(data_source => $ds_id);
600             }
601              
602             sub get_nullable_foreign_key_columns_for_table {
603 92     92 0 145 my $self = shift;
604 92         107 my $table = shift;
605              
606 92         102 my @nullable_fk_columns;
607 92         377 my @fk = $table->fk_constraints;
608 92         188 for my $fk (@fk){
609 78         232 my @fk_columns = UR::DataSource::RDBMS::FkConstraintColumn->get(
610             fk_constraint_name => $fk->fk_constraint_name,
611             data_source => $self->_my_data_source_id);
612 78         162 for my $fk_col (@fk_columns){
613 128         345 my $column_obj = UR::DataSource::RDBMS::TableColumn->get(data_source => $self->_my_data_source_id,
614             table_name => $fk_col->table_name,
615             column_name=> $fk_col->column_name);
616 128 50       293 unless ($column_obj) {
617 0         0 Carp::croak("Can't find TableColumn metadata object for table name ".$fk_col->table_name." column ".$fk_col->column_name." while processing foreign key constraint named ".$fk->fk_constraint_name);
618             }
619 128 100 66     343 if ($column_obj->nullable and $column_obj->nullable ne 'N'){
620 25         65 my $col = $column_obj->column_name;
621 25         80 push @nullable_fk_columns, $col;
622             }
623             }
624             }
625 92         221 return @nullable_fk_columns;
626             }
627              
628             sub get_non_primary_key_nullable_foreign_key_columns_for_table {
629 92     92 0 137 my $self = shift;
630 92         128 my $table = shift;
631              
632 92         315 my @nullable_fk_columns = $self->get_nullable_foreign_key_columns_for_table($table);
633 92         351 my %pk_columns = map { $_->column_name => 1} $table->primary_key_constraint_columns;
  119         309  
634 92         152 my @non_pk_nullable_fk_columns;
635 92         211 for my $fk_column (@nullable_fk_columns){
636 25 50       30 push @non_pk_nullable_fk_columns, $fk_column unless grep { $fk_column eq $_} keys %pk_columns;
  25         98  
637             }
638 92         267 return @non_pk_nullable_fk_columns;
639             }
640              
641             # TODO: make "env" an optional characteristic of a class attribute
642             # for all of the places we do this crap...
643              
644             sub access_level {
645 0     0 0 0 my $self = shift;
646 0         0 my $env = $self->_method2env("access_level");
647 0 0       0 if (@_) {
648 0 0       0 if ($self->has_default_handle) {
649 0         0 Carp::confess("Cannot change the db access level for $self while connected!");
650             }
651 0         0 $ENV{$env} = lc(shift);
652             }
653             else {
654 0   0     0 $ENV{$env} ||= "ro";
655             }
656 0         0 return $ENV{$env};
657             }
658              
659             sub _method2env {
660 0     0   0 my $class = shift;
661 0         0 my $method = shift;
662 0 0       0 unless ($method =~ /^(.*)::([^\:]+)$/) {
663 0 0       0 $class = ref($class) if ref($class);
664 0         0 $method = $class . "::" . $method;
665             }
666 0         0 $method =~ s/::/__/g;
667 0         0 return $method;
668             }
669              
670             sub resolve_class_name_for_table_name {
671 0     0 0 0 my $self = shift->_singleton_object;
672 0         0 my $qualified_table_name = shift;
673 0         0 my $relation_type = shift; # Should be 'TABLE' or 'VIEW'
674              
675 0         0 my(undef, $table_name) = $self->_resolve_owner_and_table_from_table_name($qualified_table_name);
676             # When a table_name conflicts with a reserved word, it ends in an underscore.
677 0         0 $table_name =~ s/_$//;
678              
679 0 0       0 if ($self->camel_case_table_names) {
680 0         0 $table_name = UR::Value::Text->get($table_name)->to_lemac("_");
681             }
682              
683 0         0 my $namespace = $self->get_namespace;
684 0         0 my $vocabulary = $namespace->get_vocabulary;
685              
686 0         0 my @words;
687 0 0       0 $vocabulary = 'UR::Vocabulary' unless eval { $vocabulary->__meta__ };
  0         0  
688 0 0       0 if ($vocabulary) {
689             @words =
690 0         0 map { $vocabulary->convert_to_title_case($_) }
691 0         0 map { $vocabulary->plural_to_singular($_) }
692 0         0 map { lc($_) }
  0         0  
693             split("_",$table_name);
694             } else {
695             @words =
696 0         0 map { ucfirst(lc($_)) }
  0         0  
697             split("_",$table_name);
698             }
699              
700 0 0       0 if ($self->can('_resolve_class_name_for_table_name_fixups')) {
701 0         0 @words = $self->_resolve_class_name_for_table_name_fixups(@words);
702             }
703              
704 0         0 my $class_name;
705             my $addl;
706 0 0 0     0 if ($relation_type && $relation_type =~ m/view/i) {
707 0         0 $addl = 'View::';
708             } else {
709             # Should just be for tables, temp tables, etc
710 0         0 $addl = '';
711             }
712 0         0 $class_name = $namespace . "::" . $addl . join("",@words);
713              
714 0 0       0 if (substr($class_name, -6) eq '::Type') {
715             # Don't overwrite class metadata objects for a table called 'type'
716 0         0 $class_name .= 'Table';
717 0         0 $self->warning_message("Class for table $table_name will be $class_name");
718             }
719              
720 0         0 return $class_name;
721             }
722              
723             sub resolve_type_name_for_table_name {
724 0     0 0 0 my $self = shift->_singleton_object;
725 0         0 my $table_name = shift;
726              
727 0 0       0 if ($self->camel_case_table_names) {
728 0         0 $table_name = UR::Value::Text->get($table_name)->to_lemac("_");
729             }
730            
731 0         0 my $namespace = $self->get_namespace;
732 0         0 my $vocabulary = $namespace->get_vocabulary;
733 0 0       0 $vocabulary = 'UR::Vocabulary' unless eval { $vocabulary->__meta__ };
  0         0  
734              
735 0         0 my $vocab_obj = eval { $vocabulary->__meta__ };
  0         0  
736             my @words =
737             (
738             (
739 0         0 map { $vocabulary->plural_to_singular($_) }
740 0         0 map { lc($_) }
  0         0  
741             split("_",$table_name)
742             )
743             );
744              
745 0         0 my $type_name = join(" ",@words);
746 0         0 return $type_name;
747             }
748              
749             sub resolve_property_name_for_column_name {
750 0     0 0 0 my $self = shift->_singleton_object;
751 0         0 my $column_name = shift;
752              
753 0 0       0 if ($self->camel_case_column_names) {
754 0         0 $column_name = UR::Value::Text->get($column_name)->to_lemac("_");
755             }
756             my @words =
757 0         0 map { lc($_) }
  0         0  
758             split("_",$column_name);
759              
760 0         0 my $type_name = join("_",@words);
761 0         0 return $type_name;
762             }
763              
764             sub _get_or_create_table_meta {
765 28     28   46 my $self = shift;
766              
767 28         71 my ($data_source,
768             $qualified_table_name,
769             $db_table_name,
770             $creation_method,
771             $table_data,
772             $revision_time) = @_;
773            
774 28         111 my $data_source_id = $self->_my_data_source_id;
775 28         163 my $table_object = UR::DataSource::RDBMS::Table->get(data_source => $data_source_id,
776             table_name => $qualified_table_name);
777 28 100       94 if ($table_object) {
778             # Already exists, update the existing entry
779             # Instead of deleting and recreating the table object (the old way),
780             # modify its attributes in-place. The name can't change but all the other
781             # stuff might.
782 1         7 $table_object->table_type($table_data->{TABLE_TYPE});
783 1         5 $table_object->data_source($data_source->class);
784 1         6 $table_object->remarks($table_data->{REMARKS});
785 1 50       11 $table_object->last_object_revision($revision_time) if ($table_object->__changes__());
786              
787             } else {
788             # Create a brand new one from scratch
789              
790             $table_object = UR::DataSource::RDBMS::Table->$creation_method(
791             table_name => $qualified_table_name,
792             table_type => $table_data->{TABLE_TYPE},
793             data_source => $data_source_id,
794             remarks => $table_data->{REMARKS},
795 27         294 last_object_revision => $revision_time,
796             );
797 27 50       86 unless ($table_object) {
798 0         0 Carp::confess("Failed to $creation_method table object for $db_table_name");
799             }
800             }
801            
802 28         86 return $table_object;
803             }
804              
805             sub refresh_database_metadata_for_table_name {
806 28     28 0 59 my ($self,$qualified_table_name, $creation_method) = @_;
807              
808 28   50     80 $creation_method ||= 'create';
809              
810             # this must be on or before the actual data dictionary queries
811 28         209 my $revision_time = $UR::Context::current->now();
812              
813             # The class definition can specify a table name as . to override the
814             # data source's default schema/owner.
815 28         8534 my($ds_owner,$db_table_name) = $self->_resolve_owner_and_table_from_table_name($qualified_table_name);
816              
817 28         167 my $data_source_id = $self->_my_data_source_id;
818              
819 28         197 my $table_object = $self->_get_or_create_table_metadata_for_refresh($ds_owner, $db_table_name, $qualified_table_name, $creation_method, $revision_time);
820 28 50       100 return unless $table_object;
821              
822             # We'll count a table object as changed even if any of the columns,
823             # FKs, etc # were changed
824 28         244 my $data_was_changed_for_this_table = $self->_update_column_metadata_for_refresh($ds_owner, $db_table_name, $qualified_table_name, $creation_method, $revision_time, $table_object);
825              
826 28 100       313 if ($self->_update_foreign_key_metadata_for_refresh($ds_owner, $db_table_name, $qualified_table_name, $creation_method, $revision_time, $table_object)) {
827 11         25 $data_was_changed_for_this_table = 1;
828             }
829              
830 28 50       284 if ($self->_update_primary_key_metadata_for_refresh($ds_owner, $db_table_name, $qualified_table_name, $creation_method, $revision_time, $table_object)) {
831 0         0 $data_was_changed_for_this_table = 1;
832             }
833              
834 28 50       299 if ($self->_update_unique_constraint_metadata_for_refresh($ds_owner, $db_table_name, $qualified_table_name, $creation_method, $revision_time, $table_object)) {
835 0         0 $data_was_changed_for_this_table = 1;
836             }
837              
838 28 50       206 $table_object->last_object_revision($revision_time) if ($data_was_changed_for_this_table);
839              
840             # Determine the ER type.
841             # We have 'validation item', 'entity', and 'bridge'
842              
843 28   50     172 my $column_count = scalar($table_object->column_names) || 0;
844 28   100     140 my $pk_column_count = scalar($table_object->primary_key_constraint_column_names) || 0;
845 28   100     125 my $constraint_count = scalar($table_object->fk_constraint_names) || 0;
846              
847 28 100 100     135 if ($column_count == 1 and $pk_column_count == 1) {
848 1         5 $table_object->er_type('validation item');
849             }
850             else {
851 27 100       83 if ($constraint_count == $column_count) {
852 1         5 $table_object->er_type('bridge');
853             }
854             else {
855 26         127 $table_object->er_type('entity');
856             }
857             }
858              
859 28         115 return $table_object;
860             }
861              
862             sub _get_or_create_table_metadata_for_refresh {
863 28     28   66 my($self, $ds_owner, $db_table_name, $qualified_table_name, $creation_method, $revision_time) = @_;
864              
865 28         218 my $table_sth = $self->get_table_details_from_data_dictionary('%', $ds_owner, $db_table_name, "TABLE,VIEW");
866 28         214 my $table_data = $table_sth->fetchrow_hashref();
867 28 50 33     303 unless ($table_data && %$table_data) {
868             #$self->error_message("No data for table $table_name in data source $self.");
869 0         0 return;
870             }
871              
872 28         254 my $table_object = $self->_get_or_create_table_meta(
873             $self,
874             $qualified_table_name,
875             $db_table_name,
876             $creation_method,
877             $table_data,
878             $revision_time);
879 28         173 return $table_object;
880             }
881              
882             sub _update_column_metadata_for_refresh {
883 28     28   74 my($self, $ds_owner, $db_table_name, $qualified_table_name, $creation_method, $revision_time, $table_object) = @_;
884              
885 28         41 my $data_was_changed_for_this_table = 0;
886 28         112 my $data_source_id = $self->_my_data_source_id;
887              
888             # mysql databases seem to require you to actually put in the database name in the first arg
889 28 50       132 my $db_name = ($self->can('db_name')) ? $self->db_name : '%';
890 28         3221 my $column_sth = $self->get_column_details_from_data_dictionary($db_name, $ds_owner, $db_table_name, '%');
891 28 50       108 unless ($column_sth) {
892 0         0 $self->error_message("Error getting column data for table $db_table_name in data source $self.");
893 0         0 return;
894             }
895 28         202 my $all_column_data = $column_sth->fetchall_arrayref({});
896 28 50       3419 unless (@$all_column_data) {
897 0         0 $self->error_message("No column data for table $db_table_name in data source $data_source_id");
898 0         0 return;
899             }
900              
901 28         310 my %columns_to_delete = map {$_->column_name, $_}
  3         7  
902             UR::DataSource::RDBMS::TableColumn->get(
903             table_name => $qualified_table_name,
904             data_source => $data_source_id);
905              
906              
907 28         98 for my $column_data (@$all_column_data) {
908              
909             #my $id = $table_name . '.' . $column_data->{COLUMN_NAME}
910 66         338 $column_data->{'COLUMN_NAME'} =~ s/"|'//g; # Postgres puts quotes around things that look like keywords
911              
912 66         118 delete $columns_to_delete{$column_data->{'COLUMN_NAME'}};
913              
914             my $column_obj = UR::DataSource::RDBMS::TableColumn->get(table_name => $qualified_table_name,
915             data_source => $data_source_id,
916 66         291 column_name => $column_data->{'COLUMN_NAME'});
917 66 100       171 if ($column_obj) {
918             # Already exists, change the attributes
919 3         9 $column_obj->data_source($table_object->{data_source});
920 3         8 $column_obj->data_type($column_data->{TYPE_NAME});
921 3         11 $column_obj->nullable(substr($column_data->{IS_NULLABLE}, 0, 1));
922 3         9 $column_obj->data_length($column_data->{COLUMN_SIZE});
923 3         7 $column_obj->remarks($column_data->{REMARKS});
924 3 50       12 if ($column_obj->__changes__()) {
925 3         6 $column_obj->last_object_revision($revision_time);
926 3         3 $data_was_changed_for_this_table = 1;
927             }
928              
929             } else {
930             # It's new, create it from scratch
931              
932             $column_obj = UR::DataSource::RDBMS::TableColumn->$creation_method(
933             column_name => $column_data->{COLUMN_NAME},
934             table_name => $qualified_table_name,
935             data_source => $table_object->{data_source},
936              
937             data_type => $column_data->{TYPE_NAME},
938             nullable => substr($column_data->{IS_NULLABLE}, 0, 1),
939             data_length => $column_data->{COLUMN_SIZE},
940             remarks => $column_data->{REMARKS},
941 63         707 last_object_revision => $revision_time,
942             );
943              
944 63         141 $data_was_changed_for_this_table = 1;
945             }
946              
947 66 50       202 unless ($column_obj) {
948 0         0 Carp::confess("Failed to create a column ".$column_data->{'COLUMN_NAME'}." for table $db_table_name");
949             }
950             }
951              
952 28         83 for my $to_delete (values %columns_to_delete) {
953             #$self->status_message("Detected column " . $to_delete->column_name . " has gone away.");
954 0         0 $to_delete->delete;
955 0         0 $data_was_changed_for_this_table = 1;
956             }
957              
958 28         2252 return $data_was_changed_for_this_table;
959             }
960              
961             sub _update_foreign_key_metadata_for_refresh {
962 28     28   80 my($self, $ds_owner, $db_table_name, $qualified_table_name, $creation_method, $revision_time, $table_object) = @_;
963              
964 28         44 my $data_was_changed_for_this_table = 0;
965 28         411 my $data_source_id = $self->_my_data_source_id;
966              
967             # Make a note of what FKs exist in the Meta DB involving this table
968 28         306 my @fks_in_meta_db = UR::DataSource::RDBMS::FkConstraint->get(data_source => $data_source_id,
969             table_name => $qualified_table_name);
970 28         151 push @fks_in_meta_db, UR::DataSource::RDBMS::FkConstraint->get(data_source => $data_source_id,
971             r_table_name => $qualified_table_name);
972 28         58 my %fks_in_meta_db_by_fingerprint;
973 28         76 foreach my $fk ( @fks_in_meta_db ) {
974 4         288 my $fingerprint = $self->_make_foreign_key_fingerprint($fk);
975 4         17 $fks_in_meta_db_by_fingerprint{$fingerprint} = $fk;
976             }
977              
978             # constraints on this table against columns in other tables
979              
980 28         325 my $fk_sth = $self->get_foreign_key_details_from_data_dictionary('', $ds_owner, $db_table_name, '', '', '');
981              
982 28         319 my %fk; # hold the fk constraints that this invocation of foreign_key_info created
983              
984             my @constraints;
985 0         0 my %fks_in_real_db;
986 28 50       87 if ($fk_sth) {
987 28         368 while (my $data = $fk_sth->fetchrow_hashref()) {
988              
989 9         217 foreach ( qw( FK_NAME FK_TABLE_NAME FKTABLE_NAME UK_TABLE_NAME PKTABLE_NAME FK_COLUMN_NAME FKCOLUMN_NAME UK_COLUMN_NAME PKCOLUMN_NAME ) ) {
990 81 100       134 next unless defined($data->{$_});
991             # Postgres puts quotes around things that look like keywords
992 45         111 $data->{$_} =~ s/"|'//g;
993             }
994              
995 9         21 my $constraint_name = $data->{'FK_NAME'};
996             my $fk_table_name = $self->_table_name_to_use_for_metadata_objects(
997             $data->{FK_TABLE_SCHEM} || $data->{FKTABLE_SCHEM},
998 9   33     143 $data->{'FK_TABLE_NAME'} || $data->{'FKTABLE_NAME'});
      33        
999             my $r_table_name = $self->_table_name_to_use_for_metadata_objects(
1000             $data->{UK_TABLE_SCHEM} || $data->{PKTABLE_SCHEM},
1001 9   33     64 $data->{'UK_TABLE_NAME'} || $data->{'PKTABLE_NAME'});
      33        
1002             my $fk_column_name = $data->{'FK_COLUMN_NAME'}
1003 9   33     41 || $data->{'FKCOLUMN_NAME'};
1004             my $r_column_name = $data->{'UK_COLUMN_NAME'}
1005 9   33     39 || $data->{'PKCOLUMN_NAME'};
1006              
1007             # MySQL returns primary key info with foreign_key_info()!?
1008             # They show up here with no $r_table_name or $r_column_name
1009 9 50 33     62 next unless ($r_table_name and $r_column_name);
1010              
1011 9         60 my $fk = UR::DataSource::RDBMS::FkConstraint->get(fk_constraint_name => $constraint_name,
1012             table_name => $fk_table_name,
1013             data_source => $data_source_id,
1014             r_table_name => $r_table_name
1015             );
1016              
1017 9 100       34 unless ($fk) {
1018             $fk = UR::DataSource::RDBMS::FkConstraint->$creation_method(
1019             fk_constraint_name => $constraint_name,
1020             table_name => $fk_table_name,
1021             r_table_name => $r_table_name,
1022             data_source => $table_object->{data_source},
1023 6         78 last_object_revision => $revision_time,
1024             );
1025              
1026 6         24 $fk{$fk->id} = $fk;
1027 6         13 $data_was_changed_for_this_table = 1;
1028             }
1029              
1030 9 100       31 if ($fk{$fk->id}) {
1031             my %fkcol_params = ( fk_constraint_name => $constraint_name,
1032             table_name => $fk_table_name,
1033             column_name => $fk_column_name,
1034             r_table_name => $r_table_name,
1035             r_column_name => $r_column_name,
1036             data_source => $table_object->{data_source},
1037 6         46 );
1038 6         106 my $fkcol = UR::DataSource::RDBMS::FkConstraintColumn->get(%fkcol_params);
1039 6 50       41 unless ($fkcol) {
1040 6         79 $fkcol = UR::DataSource::RDBMS::FkConstraintColumn->$creation_method(%fkcol_params);
1041             }
1042             }
1043              
1044 9         88 my $fingerprint = $self->_make_foreign_key_fingerprint($fk);
1045 9         34 $fks_in_real_db{$fingerprint} = $fk;
1046              
1047 9         216 push @constraints, $fk;
1048             }
1049             }
1050              
1051             # get foreign_key_info the other way
1052             # constraints on other tables against columns in this table
1053              
1054 28         544 my $fk_reverse_sth = $self->get_foreign_key_details_from_data_dictionary('', '', '', '', $ds_owner, $db_table_name);
1055              
1056 28         258 %fk = (); # resetting this prevents data_source referencing
1057             # tables from fouling up their fk objects
1058              
1059              
1060 28 50       95 if ($fk_reverse_sth) {
1061 28         259 while (my $data = $fk_reverse_sth->fetchrow_hashref()) {
1062              
1063 12         276 foreach ( qw( FK_NAME FK_TABLE_NAME FKTABLE_NAME UK_TABLE_NAME PKTABLE_NAME FK_COLUMN_NAME FKCOLUMN_NAME UK_COLUMN_NAME PKCOLUMN_NAME PKTABLE_SCHEM FKTABLE_SCHEM UK_TABLE_SCHEM FK_TABLE_SCHEM) ) {
1064 156 100       233 next unless defined($data->{$_});
1065             # Postgres puts quotes around things that look like keywords
1066 82         149 $data->{$_} =~ s/"|'//g;
1067             }
1068              
1069 12   100     94 my $constraint_name = $data->{'FK_NAME'} || '';
1070             my $fk_table_name = $self->_table_name_to_use_for_metadata_objects(
1071             $data->{FK_TABLE_SCHEM} || $data->{FKTABLE_SCHEM},
1072 12   33     114 $data->{'FK_TABLE_NAME'} || $data->{'FKTABLE_NAME'});
      33        
1073             my $r_table_name = $self->_table_name_to_use_for_metadata_objects(
1074             $data->{UK_TABLE_SCHEM} || $data->{PKTABLE_SCHEM},
1075 12   33     93 $data->{'UK_TABLE_NAME'} || $data->{'PKTABLE_NAME'});
      33        
1076             my $fk_column_name = $data->{'FK_COLUMN_NAME'}
1077 12   33     65 || $data->{'FKCOLUMN_NAME'};
1078             my $r_column_name = $data->{'UK_COLUMN_NAME'}
1079 12   33     40 || $data->{'PKCOLUMN_NAME'};
1080              
1081             # MySQL returns primary key info with foreign_key_info()?!
1082             # They show up here with no $r_table_name or $r_column_name
1083 12 50 33     153 next unless ($r_table_name and $r_column_name);
1084              
1085             my $fk = UR::DataSource::RDBMS::FkConstraint->get(fk_constraint_name => $constraint_name,
1086             table_name => $fk_table_name,
1087             r_table_name => $r_table_name,
1088 12         91 data_source => $table_object->{'data_source'},
1089             );
1090 12 100       51 unless ($fk) {
1091             $fk = UR::DataSource::RDBMS::FkConstraint->$creation_method(
1092             fk_constraint_name => $constraint_name,
1093             table_name => $fk_table_name,
1094             r_table_name => $r_table_name,
1095             data_source => $table_object->{data_source},
1096 7         73 last_object_revision => $revision_time,
1097             );
1098 7 50       27 unless ($fk) {
1099             ##$DB::single = 1;
1100 0         0 1;
1101             }
1102 7         26 $fk{$fk->fk_constraint_name} = $fk;
1103 7         13 $data_was_changed_for_this_table = 1;
1104             }
1105              
1106 12 100       43 if ($fk{$fk->fk_constraint_name}) {
1107             my %fkcol_params = ( fk_constraint_name => $constraint_name,
1108             table_name => $fk_table_name,
1109             column_name => $fk_column_name,
1110             r_table_name => $r_table_name,
1111             r_column_name => $r_column_name,
1112             data_source => $table_object->{data_source},
1113 7         40 );
1114 7 50       76 unless ( UR::DataSource::RDBMS::FkConstraintColumn->get(%fkcol_params) ) {
1115 7         88 UR::DataSource::RDBMS::FkConstraintColumn->$creation_method(%fkcol_params);
1116             }
1117             }
1118              
1119              
1120 12         97 my $fingerprint = $self->_make_foreign_key_fingerprint($fk);
1121 12         42 $fks_in_real_db{$fingerprint} = $fk;
1122              
1123 12         318 push @constraints, $fk;
1124             }
1125             }
1126              
1127             # Find FKs still in the Meta db that don't exist in the real database anymore
1128 28         485 foreach my $fingerprint ( keys %fks_in_meta_db_by_fingerprint ) {
1129 4 50       17 unless ($fks_in_real_db{$fingerprint}) {
1130 0         0 my $fk = $fks_in_meta_db_by_fingerprint{$fingerprint};
1131 0         0 my @fk_cols = $fk->get_related_column_objects();
1132 0         0 $_->delete foreach @fk_cols;
1133 0         0 $fk->delete;
1134             }
1135             }
1136              
1137 28         1781 return $data_was_changed_for_this_table;
1138             }
1139              
1140             sub _update_primary_key_metadata_for_refresh {
1141 28     28   80 my($self, $ds_owner, $db_table_name, $qualified_table_name, $creation_method, $revision_time, $table_object) = @_;
1142              
1143 28         46 my $data_was_changed_for_this_table = 0;
1144 28         450 my $data_source_id = $self->_my_data_source_id;
1145              
1146 28         182 my $pk_sth = $self->get_primary_key_details_from_data_dictionary(undef, $ds_owner, $db_table_name);
1147              
1148 28 50       6909 if ($pk_sth) {
1149 28         47 my @new_pk;
1150 28         245 while (my $data = $pk_sth->fetchrow_hashref()) {
1151 27         553 $data->{'COLUMN_NAME'} =~ s/"|'//g; # Postgres puts quotes around things that look like keywords
1152             my $pk = UR::DataSource::RDBMS::PkConstraintColumn->get(
1153             table_name => $qualified_table_name,
1154             data_source => $data_source_id,
1155 27         352 column_name => $data->{'COLUMN_NAME'},
1156             );
1157 27 100       113 if ($pk) {
1158             # Since the rank/order is pretty much all that might change, we
1159             # just delete and re-create these.
1160             # It's a no-op at save time if there are no changes.
1161 1         17 $pk->delete;
1162             }
1163              
1164             push @new_pk, [
1165             table_name => $qualified_table_name,
1166             data_source => $data_source_id,
1167             column_name => $data->{'COLUMN_NAME'},
1168 27   33     718 rank => $data->{'KEY_SEQ'} || $data->{'ORDINAL_POSITION'},
1169             ];
1170             }
1171              
1172 28         569 for my $data (@new_pk) {
1173 27         224 my $pk = UR::DataSource::RDBMS::PkConstraintColumn->$creation_method(@$data);
1174 27 50       128 unless ($pk) {
1175 0         0 $self->error_message("Failed to create primary key @$data");
1176 0         0 return;
1177             }
1178             }
1179             }
1180 28         1524 return $data_was_changed_for_this_table;
1181             }
1182              
1183             sub _update_unique_constraint_metadata_for_refresh {
1184 28     28   81 my($self, $ds_owner, $db_table_name, $qualified_table_name, $creation_method, $revision_time, $table_object) = @_;
1185              
1186 28         50 my $data_was_changed_for_this_table = 0;
1187 28         430 my $data_source_id = $self->_my_data_source_id;
1188              
1189 28 50       208 if (my $uc = $self->get_unique_index_details_from_data_dictionary($ds_owner, $db_table_name)) {
1190 28         103 my %uc = %$uc; # make a copy we can manipulate in case $uc is shared or read-only
1191              
1192             # check for redundant unique constraints
1193             # there may be both an index and a constraint
1194              
1195 28         83 for my $uc_name_1 ( keys %uc ) {
1196              
1197 8 50       32 my $uc_columns_1 = $uc{$uc_name_1}
1198             or next;
1199 8         32 my $uc_columns_1_serial = join ',', sort @$uc_columns_1;
1200              
1201 8         19 for my $uc_name_2 ( keys %uc ) {
1202 8 50       33 next if ( $uc_name_2 eq $uc_name_1 );
1203 0 0       0 my $uc_columns_2 = $uc{$uc_name_2}
1204             or next;
1205 0         0 my $uc_columns_2_serial = join ',', sort @$uc_columns_2;
1206              
1207 0 0       0 if ( $uc_columns_2_serial eq $uc_columns_1_serial ) {
1208 0         0 delete $uc{$uc_name_1};
1209             }
1210             }
1211             }
1212              
1213             # compare primary key constraints to unique constraints
1214             my $pk_columns_serial =
1215             join(',',
1216 28         204 sort map { $_->column_name }
  27         119  
1217             UR::DataSource::RDBMS::PkConstraintColumn->get(
1218             data_source => $data_source_id,
1219             table_name => $qualified_table_name,
1220             )
1221             );
1222 28         95 for my $uc_name ( keys %uc ) {
1223              
1224             # see if primary key constraint has the same name as
1225             # any unique constraints
1226             # FIXME - disabling this for now, the Meta DB dosen't track PK constraint names
1227             # Isn't it just as goot to check the involved columns?
1228             #if ( $table_object->primary_key_constraint_name eq $uc_name ) {
1229             # delete $uc{$uc_name};
1230             # next;
1231             #}
1232              
1233             # see if any unique constraints cover the exact same column(s) as
1234             # the primary key column(s)
1235 8         15 my $uc_columns_serial = join ',', sort @{ $uc{$uc_name} };
  8         26  
1236              
1237 8 50       29 if ( $pk_columns_serial eq $uc_columns_serial ) {
1238 8         16 delete $uc{$uc_name};
1239             }
1240             }
1241              
1242             # Create new UniqueConstraintColumn objects for the columns that don't exist, and delete the
1243             # objects if they don't apply anymore
1244 28         88 foreach my $uc_name ( keys %uc ) {
1245             my %constraint_objs =
1246 0         0 map { $_->column_name => $_ }
  0         0  
1247             UR::DataSource::RDBMS::UniqueConstraintColumn->get(
1248             data_source => $data_source_id,
1249             table_name => $qualified_table_name,
1250             constraint_name => $uc_name,
1251             );
1252              
1253 0         0 foreach my $col_name ( @{$uc{$uc_name}} ) {
  0         0  
1254 0 0       0 if ($constraint_objs{$col_name} ) {
1255 0         0 delete $constraint_objs{$col_name};
1256             } else {
1257 0         0 my $uc = UR::DataSource::RDBMS::UniqueConstraintColumn->$creation_method(
1258             data_source => $data_source_id,
1259             table_name => $qualified_table_name,
1260             constraint_name => $uc_name,
1261             column_name => $col_name,
1262             );
1263 0         0 1;
1264             }
1265             }
1266 0         0 foreach my $obj ( values %constraint_objs ) {
1267 0         0 $obj->delete();
1268             }
1269             }
1270             }
1271              
1272 28         176 return $data_was_changed_for_this_table;
1273             }
1274              
1275             sub _make_foreign_key_fingerprint {
1276 25     25   49 my($self,$fk) = @_;
1277              
1278 25         137 my @column_objects_with_name = map { [ $_->column_name, $_ ] }
  25         110  
1279             $fk->get_related_column_objects();
1280 25         69 my @fk_cols = map { $_->[1] }
1281 25         67 sort {$a->[0] cmp $b->[0]}
  0         0  
1282             @column_objects_with_name;
1283             my $fingerprint =
1284             join(':',
1285             $fk->table_name,
1286             $fk->r_table_name,
1287 25         104 map { $_->column_name, $_->r_column_name } @fk_cols
  25         66  
1288             );
1289 25         88 return $fingerprint;
1290             }
1291              
1292              
1293             sub _resolve_owner_and_table_from_table_name {
1294 4851     4851   5148 my($self, $table_name) = @_;
1295              
1296 4851 100       7892 return (undef, undef) unless $table_name;
1297 4773 100       7895 if ($table_name =~ m/(\w+)\.(\w+)/) {
1298 27         107 return($1,$2);
1299             }
1300             else {
1301 4746         11424 return($self->owner, $table_name);
1302             }
1303             }
1304              
1305             sub _resolve_table_and_column_from_column_name {
1306 6858     6858   7945 my($self, $column_name) = @_;
1307              
1308 6858 100       23775 if ($column_name =~ m/(\w+)\.(\w+)$/) {
1309 4364         17200 return ($1, $2);
1310             } else {
1311 2494         5588 return (undef, $column_name);
1312             }
1313             }
1314              
1315             # Derived classes should define a method to return a ref to an array of hash refs
1316             # describing all the bitmap indicies in the DB. Each hash ref should contain
1317             # these keys: table_name, column_name, index_name
1318             # If the DB dosen't support bitmap indicies, it should return an empty listref
1319             # This is used by the part that writes class defs based on the DB schema, and
1320             # possibly by sync_database()
1321             # Implemented methods should take one optional argument: a table name
1322             #
1323             # FIXME The API for bitmap_index and unique_index methods here aren't the same as
1324             # the other data_dictionary methods. These two return hashrefs of massaged
1325             # data while the others return DBI statement handles.
1326             sub get_bitmap_index_details_from_data_dictionary {
1327 0     0 0 0 my $class = shift;
1328 0         0 Carp::confess("Class $class didn't define its own bitmap_index_info() method");
1329             }
1330              
1331              
1332             # Derived classes should define a method to return a ref to a hash keyed by constraint
1333             # names. Each value holds a listref of hashrefs containing these keys:
1334             # CONSTRAINT_NAME and COLUMN_NAME
1335             sub get_unique_index_details_from_data_dictionary {
1336 0     0 0 0 my $class = shift;
1337 0         0 Carp::confess("Class $class didn't define its own unique_index_info() method");
1338             }
1339              
1340              
1341             sub _resolve_table_name_for_class_name {
1342 17     17   51 my($self, $class_name) = @_;
1343              
1344 17         580 for my $parent_class_name ($class_name, $class_name->inheritance) {
1345 19         65 my $parent_class = $parent_class_name->__meta__; # UR::Object::Type->get(class_name => $parent_class_name);
1346 19 50       83 next unless $parent_class;
1347 19 100       106 if (my $table_name = $parent_class->table_name) {
1348 17         46 return $table_name;
1349             }
1350             }
1351 0         0 return;
1352             }
1353              
1354             # For when there's no metaDB info for a class' table, it walks up the
1355             # ancestry of the class, and uses the ID properties to get the column
1356             # names, and assummes they must be the table primary keys.
1357             #
1358             # From there, it guesses the sequence name
1359             sub _resolve_sequence_name_from_class_id_properties {
1360 11     11   25 my($self, $class_name) = @_;
1361              
1362 11         82 my $class_meta = $class_name->__meta__;
1363 11         112 for my $meta ($class_meta, $class_meta->ancestry_class_metas) {
1364 13 100       70 next unless $meta->table_name;
1365 11         36 my @primary_keys = grep { $_ } # Only interested in the properties with columns defined
1366 11         73 map { $_->column_name }
  11         54  
1367             $meta->direct_id_property_metas;
1368 11 50       61 if (@primary_keys > 1) {
    50          
1369 0         0 Carp::croak("Tables with multiple primary keys (i.e. " .
1370             $meta->table_name . ": " .
1371             join(',',@primary_keys) .
1372             ") cannot have a surrogate key created from a sequence.");
1373             }
1374             elsif (@primary_keys == 1) {
1375 11         44 my $sequence = $self->_get_sequence_name_for_table_and_column($meta->table_name, $primary_keys[0]);
1376 11 50       84 return $sequence if $sequence;
1377             }
1378             }
1379              
1380             }
1381              
1382              
1383             sub _resolve_sequence_name_for_class_name {
1384 17     17   43 my($self, $class_name) = @_;
1385              
1386 17         100 my $table_name = $self->_resolve_table_name_for_class_name($class_name);
1387              
1388 17 50       49 unless ($table_name) {
1389 0         0 Carp::croak("Could not determine a table name for class $class_name");
1390             }
1391              
1392 17         142 my $table_meta = UR::DataSource::RDBMS::Table->get(
1393             table_name => $table_name,
1394             data_source => $self->_my_data_source_id);
1395              
1396 17         37 my $sequence;
1397 17 100       57 if ($table_meta) {
1398 6         35 my @primary_keys = $table_meta->primary_key_constraint_column_names;
1399 6 50       23 if (@primary_keys == 0) {
1400 0         0 Carp::croak("No primary keys found for table " . $table_name . "\n");
1401             }
1402 6         101 $sequence = $self->_get_sequence_name_for_table_and_column($table_name, $primary_keys[0]);
1403              
1404             } else {
1405             # No metaDB info... try and make a guess based on the class' ID properties
1406 11         112 $sequence = $self->_resolve_sequence_name_from_class_id_properties($class_name);
1407             }
1408 17         55 return $sequence;
1409             }
1410              
1411             our %sequence_for_class_name;
1412             sub autogenerate_new_object_id_for_class_name_and_rule {
1413             # The sequences in the database are named by a naming convention which allows us to connect them to the table
1414             # whose surrogate keys they fill. Look up the sequence and get a unique value from it for the object.
1415             # If and when we save, we should not get any integrity constraint violation errors.
1416              
1417 59     59 1 93 my $self = shift;
1418 59         76 my $class_name = shift;
1419 59         78 my $rule = shift; # Not used for the moment...
1420              
1421 59 50       278 if ($self->use_dummy_autogenerated_ids) {
1422 0         0 return $self->next_dummy_autogenerated_id;
1423             }
1424              
1425 59   100     315 my $sequence = $sequence_for_class_name{$class_name} || $class_name->__meta__->id_generator;
1426            
1427 59         86 my $new_id = eval {
1428             # FIXME Child classes really should use the same sequence generator as its parent
1429             # if it doesn't specify its own.
1430             # It'll be hard to distinguish the case of a class meta not explicitly mentioning its
1431             # sequence name, but there's a sequence generator in the schema for it (the current
1432             # mechanism), and when we should defer to the parent's sequence...
1433 59 100       137 unless ($sequence) {
1434 17         121 $sequence = $self->_resolve_sequence_name_for_class_name($class_name);
1435              
1436 17 50       57 if (!$sequence) {
1437 0         0 Carp::croak("No identity generator found for class " . $class_name . "\n");
1438             }
1439              
1440 17         54 $sequence_for_class_name{$class_name} = $sequence;
1441             }
1442              
1443 59         237 $self->__signal_observers__('sequence_nextval', $sequence);
1444              
1445 59         338 $self->_get_next_value_from_sequence($sequence);
1446             };
1447              
1448 59 100       155 unless (defined $new_id) {
1449 3         6 my $dbh = $self->get_default_handle;
1450 3         14 $self->__signal_observers__('sequence_nextval_failed', '', $sequence, $dbh->errstr);
1451 130     130   842 no warnings 'uninitialized';
  130         209  
  130         221326  
1452 1         7 Carp::croak("Can't get next value for sequence $sequence. Exception: $@. DBI error: ".$dbh->errstr);
1453             }
1454              
1455 56         197 return $new_id;
1456             }
1457              
1458             sub _get_sequence_name_for_table_and_column {
1459 0     0   0 my($self,$table_name,$column_name) = @_;
1460              
1461             # The default is to take the column name (should be a primary key from a table) and
1462             # change the _ID at the end of the column name with _SEQ
1463             # if column_name is all uppercase, make the sequence name end in upper case _SEQ
1464 0 0       0 my $replacement = $column_name eq uc($column_name) ? '_SEQ' : '_seq';
1465 0         0 $column_name =~ s/_ID/$replacement/i;
1466 0         0 return $column_name;
1467             }
1468              
1469             sub resolve_order_by_clause {
1470 1447     1447 0 2077 my($self, $query_plan) = @_;
1471              
1472 1447         5599 my $order_by_columns = $query_plan->order_by_column_list;
1473 1447 100       3574 return '' unless (@$order_by_columns);
1474              
1475 1423         4886 my $query_class_meta = $query_plan->class_name->__meta__;
1476              
1477             my @order_by_parts = map {
1478 1423         2863 my $order_by_property_meta = $query_plan->property_meta_for_column($_);
  2174         5750  
1479 2174 50       4453 unless ($order_by_property_meta) {
1480 0         0 Carp::croak("Cannot resolve property metadata for order-by column '$_' of class "
1481             . $query_class_meta->class_name);
1482             }
1483 2174         8929 $self->_resolve_order_by_clause_for_column($_, $query_plan, $order_by_property_meta);
1484             }
1485             @$order_by_columns;
1486              
1487 1423         5439 return 'order by ' . join(', ',@order_by_parts);
1488             }
1489              
1490             sub _resolve_order_by_clause_for_column {
1491 10     10   18 my($self, $column_name, $query_plan) = @_;
1492              
1493 10 50       35 return $query_plan->order_by_column_is_descending($column_name)
1494             ? $column_name . ' DESC'
1495             : $column_name;
1496             }
1497              
1498             sub _resolve_limit_value_from_query_plan {
1499 3     3   6 my($self, $query_plan) = @_;
1500 3         12 return $query_plan->limit;
1501             }
1502              
1503             sub _resolve_offset_value_from_query_plan {
1504 1425     1425   1942 my($self, $query_plan) = @_;
1505 1425         3357 return $query_plan->offset;
1506             }
1507              
1508             sub resolve_limit_offset_clause {
1509 1425     1425 0 1909 my($self, $query_plan) = @_;
1510              
1511 1425         4781 my $limit_value = $self->_resolve_limit_value_from_query_plan($query_plan);
1512 1425 100       3368 my $limit = defined($limit_value)
1513             ? sprintf('limit %d', $limit_value)
1514             : '';
1515 1425 100       4627 my $offset = $self->_resolve_offset_value_from_query_plan($query_plan)
1516             ? sprintf('offset %d', $query_plan->offset)
1517             : '';
1518              
1519 1425 100 100     4252 if ($limit && $offset) {
1520 5         17 return join(' ', $limit, $offset);
1521             } else {
1522 1420   66     5883 return $limit || $offset;
1523             }
1524             }
1525              
1526             sub do_sql {
1527 3     3 0 7 my $self = shift;
1528 3         5 my $sql = shift;
1529              
1530 3         12 my $dbh = $self->get_default_handle;
1531 3         27 my $rv = $dbh->do($sql);
1532 3 50       43 unless ($rv) {
1533 3         12 $self->__signal_observers__('do_failed', 'do', $sql, $dbh->errstr);
1534 1         5 Carp::croak("DBI do() failed: ".$dbh->errstr);
1535             }
1536 0         0 return $rv;
1537             }
1538              
1539              
1540             sub create_iterator_closure_for_rule {
1541 1459     1459 1 2136 my ($self, $rule) = @_;
1542              
1543 1459         3910 my ($rule_template, @values) = $rule->template_and_values();
1544 1459         6660 my $query_plan = $self->_resolve_query_plan($rule_template);
1545              
1546             #
1547             # the template has general class data
1548             #
1549              
1550 1459         3134 my $class_name = $query_plan->{class_name};
1551              
1552 1459         1976 my @lob_column_names = @{ $query_plan->{lob_column_names} };
  1459         3358  
1553 1459         1983 my @lob_column_positions = @{ $query_plan->{lob_column_positions} };
  1459         2965  
1554 1459         2335 my $query_config = $query_plan->{query_config};
1555              
1556 1459         1986 my $post_process_results_callback = $query_plan->{post_process_results_callback};
1557              
1558             #
1559             # the template has explicit template data
1560             #
1561              
1562 1459         2268 my $select_clause = $query_plan->{select_clause};
1563 1459         1876 my $select_hint = $query_plan->{select_hint};
1564 1459         2199 my $from_clause = $query_plan->{from_clause};
1565 1459         2146 my $where_clause = $query_plan->{where_clause};
1566 1459         2032 my $connect_by_clause = $query_plan->{connect_by_clause};
1567 1459         2058 my $group_by_clause = $query_plan->{group_by_clause};
1568              
1569 1459         2080 my $sql_params = $query_plan->{sql_params};
1570 1459         1966 my $filter_specs = $query_plan->{filter_specs};
1571              
1572 1459         1663 my @property_names_in_resultset_order = @{ $query_plan->{property_names_in_resultset_order} };
  1459         3857  
1573              
1574             # TODO: we get 90% of the way to a full where clause in the template, but
1575             # actually have to build it here since ther is no way to say "in (?)" and pass an arrayref :(
1576             # It _is_ possible, however, to process all of the filter specs with a constant number of params.
1577             # This would optimize the common case.
1578 1459         2278 my @all_sql_params = @$sql_params;
1579 1459         2862 for my $filter_spec (@$filter_specs) {
1580 1851         3767 my ($expr_sql, $operator, $value_position) = @$filter_spec;
1581 1851         2705 my $value = $values[$value_position];
1582 1851         6662 my ($more_sql, @more_params) =
1583             $self->_extend_sql_for_column_operator_and_value($expr_sql, $operator, $value);
1584              
1585 1851 50       5642 $where_clause .= ($where_clause ? "\nand " : ($connect_by_clause ? "start with " : "where "));
    100          
1586              
1587 1851 100       3376 if ($more_sql) {
1588 1839         2254 $where_clause .= $more_sql;
1589 1839         4683 push @all_sql_params, @more_params;
1590             }
1591             else {
1592             # error
1593 12         50 return;
1594             }
1595             }
1596              
1597             # The full SQL statement for the template, besides the filter logic, is built here.
1598 1447         5672 my $order_by_clause = $self->resolve_order_by_clause($query_plan);
1599              
1600 1447         1717 my $limit_offset_clause;
1601 1447 100       5675 $limit_offset_clause = $self->resolve_limit_offset_clause($query_plan) if $self->does_support_limit_offset($rule);
1602              
1603 1447         2284 my $sql = "\nselect ";
1604 1447 100       3044 if ($select_hint) {
1605 3         3 my $hint = '';
1606 3         6 foreach (@$select_hint) {
1607 4         8 $hint .= ' ' . $_;
1608             }
1609 3         25 $hint =~ s/\/\*\s?|\s?\*\///g; # remove embedded comment marks
1610 3         9 $sql .= "/*$hint */ ";
1611             }
1612 1447         3269 $sql .= $select_clause;
1613 1447         3238 $sql .= "\nfrom $from_clause";
1614 1447 100 66     8150 $sql .= "\n$where_clause" if defined($where_clause) and length($where_clause);
1615 1447 50       3055 $sql .= "\n$connect_by_clause" if $connect_by_clause;
1616 1447 100       2964 $sql .= "\n$group_by_clause" if $group_by_clause;
1617 1447 100       4042 $sql .= "\n$order_by_clause" if $order_by_clause;
1618 1447 100       2702 $sql .= "\n$limit_offset_clause" if $limit_offset_clause;
1619              
1620 1447         5242 $self->__signal_change__('query',$sql);
1621              
1622 1434         5141 my $dbh = $self->get_default_handle;
1623 1434         7570 my $sth = $dbh->prepare($sql,$query_plan->{query_config});
1624 1434 100       3826 unless ($sth) {
1625 4         16 $self->__signal_observers__('query_failed', 'prepare', $sql, $dbh->errstr);
1626 2         13 $self->error_message("Failed to prepare SQL $sql\n" . $dbh->errstr . "\n");
1627 2         8 Carp::confess($self->error_message);
1628             }
1629 1430 100       6229 unless ($sth->execute(@all_sql_params)) {
1630 1         15 $self->__signal_observers__('query_failed', 'execute', $sql, $dbh->errstr);
1631 1         15 $self->error_message("Failed to execute SQL $sql\n" . $sth->errstr . "\n" . Data::Dumper::Dumper(\@all_sql_params) . "\n");
1632 0         0 Carp::confess($self->error_message);
1633             }
1634              
1635 1429 50       3455 die unless $sth; # FIXME - this has no effect, right?
1636              
1637             # buffers for the iterator
1638 1429         1904 my $next_db_row;
1639             my $pending_db_object_data;
1640              
1641             my $ur_test_fill_db = $self->alternate_db_dsn
1642             &&
1643             $self->_create_sub_for_copying_to_alternate_db(
1644             $self->alternate_db_dsn,
1645             $query_plan->{loading_templates}
1646 1429   66     6326 );
1647              
1648             my $iterator = sub {
1649 3973 100   3973   7512 unless ($sth) {
1650             ##$DB::single = 1;
1651 22         30 return;
1652             }
1653              
1654 3951         12378 $next_db_row = $sth->fetchrow_arrayref;
1655             #$self->__signal_change__('fetch',$next_db_row); # FIXME: commented out because it may make fetches too slow
1656              
1657 3951 100       7333 unless ($next_db_row) {
1658 1396         4523 $sth->finish;
1659 1396         1882 $sth = undef;
1660 1396         3866 return;
1661             }
1662              
1663             # this handles things like BLOBS, which have a special interface to get the 'real' data
1664 2555 50       4227 if ($post_process_results_callback) {
1665 0         0 $next_db_row = $post_process_results_callback->($next_db_row);
1666             }
1667              
1668             # this is used for automated re-testing against a private database
1669 2555 100       4133 $ur_test_fill_db && $ur_test_fill_db->($next_db_row);
1670              
1671 2555         4778 return $next_db_row;
1672 1429         7635 }; # end of iterator closure
1673              
1674 1429         9430 Sub::Name::subname('UR::DataSource::RDBMS::__datasource_iterator(closure)__', $iterator);
1675 1429         8721 return $iterator;
1676             }
1677              
1678             sub _create_sub_for_copying_to_alternate_db {
1679 70     70   117 my($self, $connect_string, $loading_templates) = @_;
1680              
1681 70         261 my $ds_type = $self->ur_datasource_class_for_dbi_connect_string($connect_string);
1682             my $dbh = $ds_type->_create_dbh_for_alternate_db($connect_string)
1683 70   33     334 || do {
1684             Carp::carp("Cannot connect to alternate DB for copying: $DBI::errstr");
1685       0     return sub {}
1686             };
1687              
1688 70         285 my @saving_templates = $self->_resolve_loading_templates_for_alternate_db($loading_templates);
1689              
1690 70         160 foreach my $tmpl ( @saving_templates ) {
1691 90         415 my $class_meta = $tmpl->{data_class_name}->__meta__;
1692 90         375 $ds_type->mk_table_for_class_meta($class_meta, $dbh);
1693             }
1694              
1695 70         181 my @inserter_for_each_table = map { $self->_make_insert_closures_for_loading_template_for_alternate_db($_, $dbh) }
  90         367  
1696             @saving_templates;
1697              
1698             # Iterate through all the inserters, prerequisites first, for each row
1699             # returned from the database. Each inserter may return false, which means
1700             # it did not save anything to the alternate DB, for example if it
1701             # is asked to save an object with a dummy ID (< 0). In that case, no
1702             # subsequent inserters will be processed for that row
1703             return Sub::Name::subname '__altdb_inserter' => sub {
1704 78     78   169 foreach my $inserter ( @inserter_for_each_table ) {
1705 146 100       273 last unless &$inserter;
1706             }
1707 70         1090 };
1708             }
1709              
1710             sub _make_insert_closures_for_loading_template_for_alternate_db {
1711 90     90   164 my($self, $template, $dbh) = @_;
1712              
1713 90         112 my %seen_ids; # don't insert the same object more than once
1714              
1715 90         219 my $class_name = $template->{data_class_name};
1716 90         361 my $class_meta = $class_name->__meta__;
1717 90         358 my $table_name = $class_meta->table_name;
1718             my $columns_string = join(', ',
1719 228         692 map { $class_meta->column_for_property($_) }
1720 90         115 @{ $template->{property_names} } );
  90         190  
1721             my $insert_sql = "insert into $table_name ($columns_string) values ("
1722             . join(',',
1723 90         233 map { '?' } @{ $template->{property_names} } )
  228         357  
  90         136  
1724             . ')';
1725              
1726 90   33     574 my $insert_sth = $dbh->prepare($insert_sql)
1727             || Carp::croak("Prepare for insert on alternate DB table $table_name failed: ".$dbh->errstr);
1728              
1729             my $check_id_exists_sql = "select count(*) from $table_name where "
1730             . join(' and ',
1731 102         321 map { "$_ = ?" }
1732 102         243 map { $class_meta->column_for_property($_) }
1733 90         5689 @{ $template->{id_property_names} });
  90         211  
1734 90   33     377 my $check_id_exists_sth = $dbh->prepare($check_id_exists_sql)
1735             || Carp::croak("Prepare for check ID select on alternate DB table $table_name failed: ".$dbh->errstr);
1736 90         4614 my @id_column_positions = @{$template->{id_column_positions}};
  90         283  
1737              
1738 90         111 my @column_positions = @{$template->{column_positions}};
  90         176  
1739              
1740 90         195 my $id_resolver = $template->{id_resolver};
1741 90         264 my $check_id_is_not_null = _create_sub_to_check_if_id_is_not_null(@id_column_positions);
1742              
1743 90         384 my @prerequisites = $self->_make_insert_closures_for_prerequisite_tables($class_meta, $template);
1744              
1745 90         153 my $object_num = $template->{object_num};
1746             my $inserter = Sub::Name::subname "__altdb_inserter_obj${object_num}_${class_name}" => sub {
1747 104     104   135 my($next_db_row) = @_;
1748              
1749 104         366 my $id = $id_resolver->(@$next_db_row[@id_column_positions]);
1750              
1751 104 100       245 return if _object_was_saved_to_database_by_this_process($class_name, $id);
1752              
1753 100 100 100     240 if ($check_id_is_not_null->($next_db_row) and ! $seen_ids{$id}++) {
1754 92         7267 $check_id_exists_sth->execute( @$next_db_row[@id_column_positions]);
1755 92         180 my($count) = @{ $check_id_exists_sth->fetchrow_arrayref() };
  92         983  
1756 92 100       204 unless ($count) {
1757 72         220 my @column_values = @$next_db_row[@column_positions];
1758 72 50       659015 $insert_sth->execute(@column_values)
1759             || Carp::croak("Inserting to alternate DB for $class_name failed");
1760             }
1761             }
1762 100         504 return 1;
1763 90         978 };
1764              
1765 90         404 return (@prerequisites, $inserter);
1766             }
1767              
1768              
1769              
1770             # not a method
1771             sub _create_sub_to_check_if_id_is_not_null {
1772 134     134   216 my(@id_columns) = @_;
1773              
1774             return sub {
1775 142     142   173 my $next_db_row = $_[0];
1776 142         197 foreach my $col ( @id_columns ) {
1777 150 100       970 return 1 if defined $next_db_row->[$col];
1778             }
1779 8         25 return 0;
1780 134         608 };
1781             }
1782              
1783             my %cached_fk_data_for_table;
1784             sub _make_insert_closures_for_prerequisite_tables {
1785 90     90   116 my($self, $class_meta, $loading_template) = @_;
1786              
1787 90   66     316 $cached_fk_data_for_table{$class_meta->table_name} ||= $self->_load_fk_data_for_class_meta($class_meta);
1788              
1789 90         130 my %column_idx_for_column_name;
1790 90         176 for (my $i = 0; $i < @{ $loading_template->{property_names} }; $i++) {
  318         605  
1791 228         478 my $column_name = $class_meta->column_for_property( $loading_template->{property_names}->[$i] );
1792             $column_idx_for_column_name{ $column_name }
1793 228         480 = $loading_template->{column_positions}->[$i];
1794             }
1795              
1796 90         248 my $class_name = $class_meta->class_name;
1797              
1798 48         190 return map { $self->_make_prerequisite_insert_closure_for_fk($class_name, \%column_idx_for_column_name, $_) }
1799 90         119 @{ $cached_fk_data_for_table{ $class_meta->table_name } };
  90         218  
1800             }
1801              
1802              
1803             sub _load_fk_data_for_class_meta {
1804 12     12   17 my($self, $class_meta) = @_;
1805              
1806 12         31 my ($db_owner, $table_name_without_owner) = $self->_resolve_owner_and_table_from_table_name($class_meta->table_name);
1807              
1808 12         16 my @fk_data;
1809 12         49 my $fk_sth = $self->get_foreign_key_details_from_data_dictionary('','','','', $db_owner, $table_name_without_owner);
1810 12         19 my %seen_fk_names;
1811 12   66     121 while( $fk_sth and my $row = $fk_sth->fetchrow_hashref ) {
1812              
1813 6         120 foreach my $key (qw(UK_TABLE_CAT UK_TABLE_SCHEM UK_TABLE_NAME UK_COLUMN_NAME FK_TABLE_CAT FK_TABLE_SCHEM FK_TABLE_NAME FK_COLUMN_NAME)) {
1814 130     130   720 no warnings 'uninitialized';
  130         200  
  130         254261  
1815 48         76 $row->{$key} =~ s/"|'//g; # Postgres puts quotes around entities that look like keywords
1816             }
1817 6 50 66     23 if (!@fk_data or $row->{ORDINAL_POSITION} == 1
      0        
      33        
1818             or ( $row->{FK_NAME} and !$seen_fk_names{ $row->{FK_NAME} }++)
1819             ) {
1820             # part of a new FK
1821 6         11 push @fk_data, [];
1822             }
1823              
1824 6         9 push @{ $fk_data[-1] }, { %$row };
  6         88  
1825             }
1826 12         504 return \@fk_data;
1827             }
1828              
1829             # return true if this list of FK columns exists for inheritance:
1830             # this table's FKs matches the given class' ID properties, and the FK points
1831             # to every ID property of the parent class
1832             sub _fk_represents_inheritance {
1833 48     48   57 my($load_class_name, $fk_column_list) = @_;
1834              
1835 48         179 my $load_class_meta = $load_class_name->__meta__;
1836              
1837 56         162 my %is_pk_column_for_class = map { $_ => 1 }
1838 56         97 grep { $_ }
1839 48         144 map { $load_class_meta->column_for_property($_) }
  56         120  
1840             $load_class_name->__meta__->id_property_names;
1841              
1842 48 100       154 if (scalar(@$fk_column_list) != scalar(values %is_pk_column_for_class)) {
1843             # differing number of columns vs ID properties
1844 8         28 return '';
1845             }
1846              
1847 40         88 foreach my $fk ( @$fk_column_list ) {
1848 40 100       236 return '' unless $is_pk_column_for_class{ $fk->{FK_COLUMN_NAME} };
1849             }
1850              
1851 4         8 my %checked;
1852 4         131 foreach my $parent_class_name ( $load_class_meta->inheritance ) {
1853 20 50       43 next if ($checked{$parent_class_name}++);
1854              
1855 20         15 my $parent_class_meta = eval { $parent_class_name->__meta__ };
  20         89  
1856 20 100       41 next unless $parent_class_meta; # for non-ur classes
1857 0         0 my @pk_columns_for_parent = grep { $_ }
1858 16         30 map { $parent_class_meta->column_for_property($_) }
  16         30  
1859             $parent_class_meta->id_property_names;
1860 16 50       40 next if (scalar(@$fk_column_list) != scalar(@pk_columns_for_parent));
1861              
1862 0         0 foreach my $parent_pk_column ( @pk_columns_for_parent ) {
1863 0 0       0 return '' unless $is_pk_column_for_class{ $parent_pk_column };
1864             }
1865             }
1866              
1867 4         27 return 1;
1868             }
1869              
1870             sub _make_prerequisite_insert_closure_for_fk {
1871 48     48   103 my($self, $load_class_name, $column_idx_for_column_name, $fk_column_list) = @_;
1872              
1873 48         148 my $pk_class_name = $self->_lookup_fk_target_class_name($fk_column_list);
1874              
1875             # fks for inheritance are handled inside _resolve_loading_templates_for_alternate_db
1876 48 100       165 return () if _fk_represents_inheritance($load_class_name, $fk_column_list);
1877              
1878 44         188 my $pk_class_meta = $pk_class_name->__meta__;
1879              
1880 44         86 my %pk_to_fk_column_name_map = map { @$_{'UK_COLUMN_NAME','FK_COLUMN_NAME'} }
  44         186  
1881             @$fk_column_list;
1882 44         105 my @fk_columns = map { $column_idx_for_column_name->{$_} }
1883 44         150 map { $pk_to_fk_column_name_map{$_} }
  44         95  
1884             $pk_class_meta->id_property_names;
1885              
1886 44 50 33     94 if (grep { !defined } @fk_columns
  44         278  
1887             or
1888             !@fk_columns
1889             ) {
1890             Carp::croak(sprintf(q(Couldn't determine column order for inserting prerequisites of %s with foreign key "%s" refering to table %s with columns (%s)),
1891             $load_class_name,
1892             $fk_column_list->[0]->{FK_NAME},
1893             $fk_column_list->[0]->{UK_TABLE_NAME},
1894 0         0 join(', ', map { $_->{UK_COLUMN_NAME} } @$fk_column_list)
  0         0  
1895             ));
1896             }
1897              
1898 44         140 my $id_resolver = $pk_class_meta->get_composite_id_resolver();
1899 44         125 my $check_id_is_not_null = _create_sub_to_check_if_id_is_not_null(@fk_columns);
1900              
1901             return Sub::Name::subname "__altdb_prereq_inserter_${pk_class_name}" => sub {
1902 42     42   93 my($next_db_row) = @_;
1903 42 100       127 if ($check_id_is_not_null->($next_db_row)) {
1904 38         173 my $id = $id_resolver->(@$next_db_row[@fk_columns]);
1905              
1906 38 100       108 return if _object_was_saved_to_database_by_this_process($pk_class_name, $id);
1907              
1908             # here we _do_ want to recurse back in. That way if these prerequisites
1909             # have prerequisites of their own, they'll be loaded in the recursive call.
1910 36         160 $pk_class_name->get($id);
1911             }
1912 40         123 return 1;
1913             }
1914 44         560 }
1915              
1916             # not a method
1917             sub _object_was_saved_to_database_by_this_process {
1918 142     142   258 my($class_name, $id) = @_;
1919              
1920             # Fast common case
1921             return 1 if exists ($objects_in_database_saved_by_this_process{$class_name})
1922             &&
1923 142 100 66     485 exists($objects_in_database_saved_by_this_process{$class_name}->{$id});
1924              
1925 136         302 foreach my $saved_class ( keys %objects_in_database_saved_by_this_process ) {
1926 218 100 66     1636 next unless ($class_name->isa($saved_class) || $saved_class->isa($class_name));
1927 52 50       119 return 1 if exists($objects_in_database_saved_by_this_process{$saved_class}->{$id});
1928             }
1929 136         305 return;
1930             }
1931              
1932             # given a UR::DataSource::RDBMS::FkConstraint, find the table this fk refers to
1933             # (the table with the pk_columns), then find which class goes with that table.
1934             sub _lookup_fk_target_class_name {
1935 48     48   65 my($self, $fk_column_list) = @_;
1936              
1937 48         108 my $pk_owner = $fk_column_list->[0]->{UK_TABLE_SCHEM};
1938 48         81 my $pk_table_name = $fk_column_list->[0]->{UK_TABLE_NAME};
1939 48 50       138 my $pk_table_name_with_owner = $pk_owner ? join('.', $pk_owner, $pk_table_name) : $pk_table_name;
1940 48   33     180 my $pk_class_name = $self->_lookup_class_for_table_name( $pk_table_name_with_owner )
1941             || $self->_lookup_class_for_table_name( $pk_table_name );
1942              
1943 48 50       131 unless ($pk_class_name) {
1944             # didn't find it. Maybe the target class isn't loaded yet
1945             # try looking up the class on the other side of the FK
1946             # and determine which property matches this FK
1947              
1948 0         0 my $fk_owner = $fk_column_list->[0]->{FK_TABLE_SCHEM};
1949 0         0 my $fk_table_name = $fk_column_list->[0]->{FK_TABLE_NAME};
1950 0 0       0 my $fk_table_name_with_owner = $fk_owner ? join('.', $fk_owner, $fk_table_name) : $fk_table_name;
1951              
1952 0   0     0 my $fk_class_name = $self->_lookup_class_for_table_name( $fk_table_name_with_owner )
1953             || $self->_lookup_class_for_table_name( $fk_table_name );
1954 0 0       0 if ($fk_class_name) {
1955             # get all the relation property target classes loaded
1956 0 0       0 my @relation_property_metas = grep { $_->id_by and $_->data_type }
  0         0  
1957             $fk_class_name->__meta__->properties();
1958 0         0 foreach my $prop_meta ( @relation_property_metas ) {
1959 0         0 eval { $prop_meta->data_type->__meta__ };
  0         0  
1960             }
1961              
1962             # try looking up again
1963 0   0     0 $pk_class_name = $self->_lookup_class_for_table_name( $pk_table_name_with_owner )
1964             || $self->_lookup_class_for_table_name( $pk_table_name );
1965             }
1966             }
1967 48 50       90 unless ($pk_class_name) {
1968             Carp::croak(
1969             sprintf(q(Couldn't determine class with table %s involved in foreign key "%s" from table %s with columns (%s)),
1970             $pk_table_name,
1971             $fk_column_list->[0]->{FK_NAME},
1972             $fk_column_list->[0]->{FK_TABLE_NAME},
1973 0         0 join(', ', map { $_->{FK_COLUMN_NAME} } @$fk_column_list),
  0         0  
1974             ));
1975             }
1976 48         98 return $pk_class_name;
1977             }
1978              
1979             # Given a query plan's loading templates, return a new list of look-alike
1980             # loading templates. This new list may look different from the original
1981             # list in the case of table inheritance: it separates out each class' table
1982             # and the columns that goes with it.
1983             sub _resolve_loading_templates_for_alternate_db {
1984 70     70   132 my($self, $original_loading_templates) = @_;
1985              
1986 70         87 my @loading_templates;
1987 70         188 foreach my $loading_template ( @$original_loading_templates ) {
1988 86         204 my $load_class_name = $loading_template->{data_class_name};
1989              
1990 86         127 my %column_for_property_name;
1991 86         171 for (my $i = 0; $i < @{ $loading_template->{property_names} }; $i++) {
  314         545  
1992             $column_for_property_name{ $loading_template->{property_names}->[$i] }
1993 228         391 = $loading_template->{column_positions}->[$i];
1994             }
1995              
1996             my @involved_class_metas = reverse
1997 86         330 grep { $_->table_name }
  262         528  
1998             $load_class_name->__meta__->all_class_metas;
1999 86         219 foreach my $class_meta ( @involved_class_metas ) {
2000 102         226 my @id_property_names = map { $_->property_name }
2001 90         334 grep { $_->column_name }
  102         322  
2002             $class_meta->direct_id_property_metas;
2003 90         166 my @id_column_positions = map { $column_for_property_name{$_} } @id_property_names;
  102         192  
2004 228         338 my @property_names = map { $_->property_name }
2005 90         486 grep { $_->column_name }
  324         521  
2006             $class_meta->direct_property_metas;
2007 90         164 my @column_positions = map { $column_for_property_name{$_} } @property_names;
  228         295  
2008             my $this_template = {
2009             id_property_names => \@id_property_names,
2010             id_column_positions => \@id_column_positions,
2011             property_names => \@property_names,
2012             column_positions => \@column_positions,
2013             table_alias => $class_meta->table_name,
2014             data_class_name => $class_meta->class_name,
2015             final_class_name => $loading_template->{final_class_name},
2016             object_num => $loading_template->{object_num},
2017 90         378 id_resolver => $class_meta->get_composite_id_resolver,
2018             };
2019 90         313 push @loading_templates, $this_template
2020             }
2021             }
2022 70         143 return @loading_templates;
2023             }
2024              
2025             sub _create_dbh_for_alternate_db {
2026 70     70   135 my($self, $connect_string) = @_;
2027              
2028             # Support an extension of the connect string to allow user and password.
2029             # URI::DB supports these kinds of things, too.
2030 70         177 $connect_string =~ s/user=(\w+);?//;
2031 70         144 my $user = $1;
2032 70         130 $connect_string =~ s/password=(\w+);?//;
2033 70         120 my $password = $1;
2034              
2035             # Don't use $self->default_handle_class here
2036             # Generally, it'll be UR::DBI, which respects the setting for UR_DBI_NO_COMMIT.
2037             # Tests are usually run with no-commit on, and we still want to fill the
2038             # test db in that case
2039 70         77 my $handle_class = 'DBI';
2040 70   50     642 $handle_class->connect($connect_string, $user || '', $password || '', { AutoCommit => 1, PrintWarn => 0 });
      50        
2041             }
2042              
2043             # Create the table behind this class in the specified database.
2044             # used by the functionality behind the UR_TEST_FILLDB env var
2045             sub mk_table_for_class_meta {
2046 90     90 0 210 my($self, $class_meta, $dbh) = @_;
2047 90 50       453 return 1 unless $class_meta->has_table;
2048              
2049 90   33     233 $dbh ||= $self->get_default_handle;
2050              
2051 90         219 my $table_name = $class_meta->table_name();
2052 90         307 $self->_assure_schema_exists_for_table($table_name, $dbh);
2053              
2054             # we only care about properties backed up by a real column
2055 90         235 my @props = grep { $_->column_name } $class_meta->direct_property_metas();
  324         524  
2056              
2057 90         224 my $sql = "create table IF NOT EXISTS $table_name (";
2058              
2059 90         112 my @cols;
2060 90         148 foreach my $prop ( @props ) {
2061 228         358 my $col = $prop->column_name;
2062 228         461 my $type = $self->data_source_type_for_ur_data_type($prop->data_type);
2063 228         475 my $len = $prop->data_length;
2064 228         378 my $nullable = $prop->is_optional;
2065              
2066 228         344 my $string = "$col" . " " . $type;
2067 228 100       429 $string .= " NOT NULL" unless $nullable;
2068 228         328 push @cols, $string;
2069             }
2070 90         216 $sql .= join(',',@cols);
2071              
2072 90         438 my @id_cols = $class_meta->direct_id_column_names();
2073 90 50       330 $sql .= ", PRIMARY KEY (" . join(',',@id_cols) . ")" if (@id_cols);
2074              
2075             # Should we also check for the unique properties?
2076              
2077 90         113 $sql .= ")";
2078 90 50       661 unless ($dbh->do($sql) ) {
2079 0         0 $self->error_message("Can't create table $table_name: ".$DBI::errstr."\nSQL: $sql");
2080 0         0 return undef;
2081             }
2082              
2083 90         522088 1;
2084             }
2085              
2086             sub _assure_schema_exists_for_table {
2087 0     0   0 my($self, $table_name, $dbh) = @_;
2088              
2089 0   0     0 $dbh ||= $self->get_default_handle;
2090              
2091 0         0 my($schema_name, undef) = $self->_extract_schema_and_table_name($table_name);
2092 0 0       0 if ($schema_name) {
2093 0 0       0 $dbh->do("CREATE SCHEMA IF NOT EXISTS $schema_name")
2094             || Carp::croak("Could not create schema $schema_name: ".$dbh->errstr);
2095             }
2096             }
2097              
2098             sub _extract_schema_and_table_name {
2099 90     90   101 my($self, $string) = @_;
2100              
2101 90         211 my($schema_name, $table_name) = $string =~ m/(.*)\.(\w+)$/;
2102 90         172 return ($schema_name, $table_name);
2103             }
2104              
2105             sub _default_sql_like_escape_string {
2106 1887     1887   5427 return '\\'; # Most RDBMSs support an 'escape' as part of a 'like' operator, except mysql
2107             }
2108              
2109             sub _format_sql_like_escape_string {
2110 1887     1887   2741 my $class = shift;
2111 1887         2567 my $escape = shift;
2112 1887         4252 return "'$escape'";
2113             }
2114              
2115             # This method is used when generating SQL for a rule template, in the joins
2116             # and also on a per-query basis to turn specific values into a where clause
2117             sub _extend_sql_for_column_operator_and_value {
2118 1890     1890   3072 my($self, $expr_sql, $op, $val, $escape) = @_;
2119              
2120 1890         5180 my $class = $self->_sql_generation_class_for_operator($op);
2121              
2122 1890   33     10582 $escape ||= $self->_default_sql_like_escape_string;
2123 1890         5261 $escape = $self->_format_sql_like_escape_string($escape);
2124 1890         9513 return $class->generate_sql_for($expr_sql, $val, $escape);
2125             }
2126              
2127             sub _sql_generation_class_for_operator {
2128 1890     1890   2547 my($self, $op) = @_;
2129 1890         6095 my $suffix = UR::Util::class_suffix_for_operator($op);
2130 1890         47366 my @classes = $self->inheritance;
2131 1890         3925 foreach my $class ( @classes ) {
2132 4448         9484 my $op_class_name = join('::', $class, 'Operator', $suffix);
2133              
2134 4448 100       8619 return $op_class_name if UR::Util::use_package_optimistically($op_class_name);
2135             }
2136 0         0 Carp::croak("Can't load SQL generation class for operator $op: $@");
2137             }
2138              
2139             sub _value_is_null {
2140 1544     1544   2240 my ($class, $value) = @_;
2141 1544 100       4084 return 1 if not defined $value;
2142 1539 100       3708 return 1 if $value eq '';
2143 1533 0 33     4703 return 1 if (ref($value) eq 'HASH' and $value->{operator} eq '=' and (!defied($value->{value}) or $value->{value} eq ''));
      0        
      33        
2144 1533         4402 return 0;
2145             }
2146              
2147             sub _resolve_ids_from_class_name_and_sql {
2148 8     8   8 my $self = shift;
2149              
2150 8         7 my $class_name = shift;
2151 8         8 my $sql = shift;
2152              
2153 8         8 my $query;
2154             my @params;
2155 8 100       16 if (ref($sql) eq "ARRAY") {
2156 2         1 ($query, @params) = @{$sql};
  2         5  
2157             } else {
2158 6         7 $query = $sql;
2159             }
2160              
2161 8         21 my $class_meta = $class_name->__meta__;
2162             my @id_columns = map
2163 8         21 { $class_meta->property_meta_for_name($_)->column_name }
  11         27  
2164             $class_meta->id_property_names;
2165              
2166             # query for the ids
2167              
2168 8         22 my $dbh = $self->get_default_handle();
2169              
2170 8         24 my $sth = $dbh->prepare($query);
2171              
2172 8 50       17 unless ($sth) {
2173 0         0 Carp::croak("Could not prepare query $query: $DBI::errstr");
2174             }
2175 8 100       60 unless ($sth->{NUM_OF_PARAMS} == scalar(@params)) {
2176             Carp::croak('The number of params supplied ('
2177             . scalar(@params)
2178             . ') does not match the number of placeholders (' . $sth->{NUM_OF_PARAMS}
2179 1         178 . ") in the supplied sql: $query");
2180             }
2181              
2182 7         28 $sth->execute(@params);
2183              
2184             # After execute, we can see if the SQL contained all the required primary keys
2185 10         92 my @id_column_idx = map { $sth->{NAME_lc_hash}->{$_} }
2186 7         13 map { lc }
  10         20  
2187             @id_columns;
2188 7 100       11 if (grep { ! defined } @id_column_idx) {
  10         21  
2189 3         6 @id_columns = sort @id_columns;
2190 3         5 my @missing_ids = sort grep { ! defined($sth->{NAME_lc_hash}->{lc($_)}) } @id_columns;
  5         19  
2191 3         590 Carp::croak("The SQL supplied is missing one or more ID columns.\n\tExpected: "
2192             . join(', ', @id_columns)
2193             . ' but some were missing: '
2194             . join(', ', @missing_ids)
2195             . " for query: $query");
2196             }
2197              
2198 4         38 my $id_resolver = $class_name->__meta__->get_composite_id_resolver();
2199              
2200 4         15 my $id_values = $sth->fetchall_arrayref(\@id_column_idx);
2201 4         8 return [ map { $id_resolver->(@$_) } @$id_values ];
  17         24  
2202             }
2203              
2204             sub _sync_database {
2205 52     52   95 my $self = shift;
2206 52         133 my %params = @_;
2207              
2208 52 50       188 unless (ref($self)) {
2209 0 0       0 if ($self->isa("UR::Singleton")) {
2210 0         0 $self = $self->_singleton_object;
2211             }
2212             else {
2213 0         0 die "Called as a class-method on a non-singleton datasource!";
2214             }
2215             }
2216              
2217 52         131 my $changed_objects = delete $params{changed_objects};
2218 52         78 my %objects_by_class_name;
2219 52         112 for my $obj (@$changed_objects) {
2220 117         159 my $class_name = ref($obj);
2221 117   100     414 $objects_by_class_name{$class_name} ||= [];
2222 117         112 push @{ $objects_by_class_name{$class_name} }, $obj;
  117         183  
2223              
2224 117 100       331 if ($self->alternate_db_dsn) {
2225 6         17 $objects_in_database_saved_by_this_process{$class_name}->{$obj->id} = 1;
2226             }
2227             }
2228              
2229 52         248 my $dbh = $self->get_default_handle;
2230              
2231             #
2232             # Determine what commands need to be executed on the database
2233             # to sync those changes, and categorize them by type and table.
2234             #
2235              
2236             # As we iterate through changes, keep track of all of the involved tables.
2237 52         136 my %all_tables; # $all_tables{$table_name} = $number_of_commands;
2238              
2239             # Make a hash for each type of command keyed by table name.
2240             my %insert; # $insert{$table_name} = [ $change1, $change2, ...];
2241 0         0 my %update; # $update{$table_name} = [ $change1, $change2, ...];
2242 0         0 my %delete; # $delete{$table_name} = [ $change1, $change2, ...];
2243              
2244             # Make a master hash referencing each of the above.
2245             # $explicit_commands_by_type_and_table{'insert'}{$table} = [ $change1, $change2 ...]
2246 52         290 my %explicit_commands_by_type_and_table = (
2247             'insert' => \%insert,
2248             'update' => \%update,
2249             'delete' => \%delete
2250             );
2251              
2252             # Build the above data structures.
2253             {
2254 130     130   758 no warnings;
  130         212  
  130         441028  
  52         82  
2255 52         219 for my $class_name (sort keys %objects_by_class_name) {
2256 69         94 for my $obj (@{ $objects_by_class_name{$class_name} }) {
  69         160  
2257 117         504 my @commands = $self->_default_save_sql_for_object($obj);
2258 117 100       352 next unless @commands;
2259              
2260 111         218 for my $change (@commands)
2261             {
2262             #$commands{$change} = $change;
2263              
2264             # Example change:
2265             # { type => 'update', table_name => $table_name,
2266             # column_names => \@changed_cols, sql => $sql,
2267             # params => \@values, class => $table_class, id => $id };
2268              
2269             # There are often multiple changes per object, espeically
2270             # when the object is spread across multiple tables because of
2271             # inheritance. We classify each change by the table and
2272             # the class immediately associated with the table, even if
2273             # the class in an abstract parent class on the object.
2274 127         232 my $table_name = $change->{table_name};
2275 127         192 my $id = $change->{id};
2276 127         215 $all_tables{$table_name}++;
2277              
2278 127 100       501 if ($change->{type} eq 'insert')
    100          
    50          
2279             {
2280 39         55 push @{ $insert{$table_name} }, $change;
  39         174  
2281             }
2282             elsif ($change->{type} eq 'update')
2283             {
2284 54         85 push @{ $update{$table_name} }, $change;
  54         212  
2285             }
2286             elsif ($change->{type} eq 'delete')
2287             {
2288 34         42 push @{ $delete{$table_name} }, $change;
  34         109  
2289             }
2290             else
2291             {
2292 0         0 print "UNKNOWN COMMAND TYPE $change->{type} $change->{sql}\n";
2293             }
2294             }
2295             }
2296             }
2297             }
2298              
2299             # Determine which tables require a lock;
2300              
2301 52         94 my %tables_requiring_lock;
2302 52         147 for my $table_name (keys %all_tables) {
2303 61         244 my $table_object = $self->_get_table_object($table_name);
2304              
2305 61 50       214 unless ($table_object) {
2306 0         0 warn "looking up schema for RDBMS table $table_name...\n";
2307 0         0 $table_object = $self->refresh_database_metadata_for_table_name($table_name);
2308 0 0       0 unless ($table_object) {
2309 0         0 die "Failed to generate table data for $table_name!";
2310             }
2311             }
2312              
2313 61 50       283 if (my @bitmap_index_names = $table_object->bitmap_index_names) {
2314 0         0 my $changes;
2315 0 0 0     0 if ($changes = $insert{$table_name} or $changes = $delete{$table_name}) {
    0          
2316 0         0 $tables_requiring_lock{$table_name} = 1;
2317             }
2318             elsif (not $tables_requiring_lock{$table_name}) {
2319 0         0 $changes = $update{$table_name};
2320 0         0 my @column_names = sort map { @{ $_->{column_names} } } @$changes;
  0         0  
  0         0  
2321 0         0 my $last_column_name = "";
2322 0         0 for my $column_name (@column_names) {
2323 0 0       0 next if $column_name eq $last_column_name;
2324 0         0 my $column_obj = UR::DataSource::RDBMS::TableColumn->get(
2325             data_source => $table_object->data_source,
2326             table_name => $table_name,
2327             column_name => $column_name,
2328             );
2329 0 0       0 if ($column_obj->bitmap_index_names) {
2330 0         0 $tables_requiring_lock{$table_name} = 1;
2331 0         0 last;
2332             }
2333 0         0 $last_column_name = $column_name;
2334             }
2335             }
2336             }
2337             }
2338              
2339             #
2340             # Make a mapping of prerequisites for each command,
2341             # and a reverse mapping of dependants for each command.
2342             #
2343              
2344 52         119 my %all_table_commands;
2345             my %prerequisites;
2346 0         0 my %dependants;
2347              
2348 52         165 for my $table_name (keys %all_tables) {
2349 61         239 my $table = $self->_get_table_object($table_name);
2350              
2351 61         320 my @fk = $table->fk_constraints;
2352              
2353 61         99 my $matched_table_name;
2354 61 100       240 if ($insert{$table_name})
2355             {
2356 31         51 $matched_table_name = 1;
2357 31         104 $all_table_commands{"insert $table_name"} = 1;
2358             }
2359              
2360 61 100       230 if ($update{$table_name})
2361             {
2362 34         67 $matched_table_name = 1;
2363 34         129 $all_table_commands{"update $table_name"} = 1;
2364             }
2365              
2366 61 100       170 if ($delete{$table_name})
2367             {
2368 9         15 $matched_table_name = 1;
2369 9         24 $all_table_commands{"delete $table_name"} = 1;
2370             }
2371              
2372 61 50       170 unless ($matched_table_name) {
2373 0         0 Carp::carp("Possible metadata inconsistency: A change on table $table_name was not an insert, update or delete!");
2374             }
2375              
2376 61         91 my $tmparray;
2377              
2378             # handle multiple differnt ops on the same table
2379 61 100 66     243 if ($insert{$table_name} and $update{$table_name}) {
2380             # insert before update
2381 6   50     51 $tmparray = $prerequisites{"update $table_name"}{"insert $table_name"} ||= [];
2382 6   50     45 $tmparray = $dependants{"insert $table_name"}{"update $table_name"} ||= [];
2383             }
2384 61 100 66     209 if ($delete{$table_name} and $update{$table_name}) {
2385             # update before delete
2386 7   50     54 $tmparray = $prerequisites{"delete $table_name"}{"update $table_name"} ||= [];
2387 7   50     52 $tmparray = $dependants{"update $table_name"}{"delete $table_name"} ||= [];
2388             }
2389 61 50 66     196 if ($delete{$table_name} and $insert{$table_name} and not $update{$table_name}) {
      66        
2390             # delete before insert
2391 0   0     0 $tmparray = $prerequisites{"insert $table_name"}{"delete $table_name"} ||= [];
2392 0   0     0 $tmparray = $dependants{"delete $table_name"}{"insert $table_name"} ||= [];
2393             }
2394            
2395             # Go through the constraints.
2396 61         174 for my $fk (@fk)
2397             {
2398 19         72 my $r_table_name = $fk->r_table_name;
2399              
2400             # RULES:
2401             # insert r_table_name before insert table_name
2402             # insert r_table_name before update table_name
2403             # delete table_name before delete r_table_name
2404             # update table_name before delete r_table_name
2405              
2406 19 100 66     95 if ($insert{$table_name} and $insert{$r_table_name})
2407             {
2408 3   50     20 $tmparray = $prerequisites{"insert $table_name"}{"insert $r_table_name"} ||= [];
2409 3         8 push @$tmparray, $fk;
2410              
2411 3   50     19 $tmparray = $dependants{"insert $r_table_name"}{"insert $table_name"} ||= [];
2412 3         9 push @$tmparray, $fk;
2413             }
2414              
2415 19 100 66     81 if ($update{$table_name} and $insert{$r_table_name})
2416             {
2417 2   50     15 $tmparray = $prerequisites{"update $table_name"}{"insert $r_table_name"} ||= [];
2418 2         4 push @$tmparray, $fk;
2419              
2420 2   50     11 $tmparray = $dependants{"insert $r_table_name"}{"update $table_name"} ||= [];
2421 2         4 push @$tmparray, $fk;
2422             }
2423              
2424 19 50 66     62 if ($delete{$r_table_name} and $delete{$table_name})
2425             {
2426 3   50     19 $tmparray = $prerequisites{"delete $r_table_name"}{"delete $table_name"} ||= [];
2427 3         8 push @$tmparray, $fk;
2428              
2429 3   50     17 $tmparray = $dependants{"delete $table_name"}{"delete $r_table_name"} ||= [];
2430 3         5 push @$tmparray, $fk;
2431             }
2432              
2433 19 50 66     68 if ($delete{$r_table_name} and $update{$table_name})
2434             {
2435 3   100     15 $tmparray = $prerequisites{"delete $r_table_name"}{"update $table_name"} ||= [];
2436 3         5 push @$tmparray, $fk;
2437              
2438 3   100     16 $tmparray = $dependants{"update $table_name"}{"delete $r_table_name"} ||= [];
2439 3         9 push @$tmparray, $fk;
2440             }
2441             }
2442             }
2443              
2444             #
2445             # Use the above mapping to build an ordered list of general commands.
2446             # Note that the general command is something like "insert EMPLOYEES",
2447             # while the explicit command is an exact insert statement with params.
2448             #
2449              
2450 52         105 my @general_commands_in_order;
2451             my %self_referencing_table_commands;
2452              
2453 52         187 my %all_unresolved = %all_table_commands;
2454 52         78 my $unresolved_count;
2455 52         78 my $last_unresolved_count = 0;
2456 52         96 my @ready_to_add = ();
2457              
2458 52         180 while ($unresolved_count = scalar(keys(%all_unresolved)))
2459             {
2460 66 50       190 if ($unresolved_count == $last_unresolved_count)
2461             {
2462             # We accomplished nothing on the last iteration.
2463             # We are in an infinite loop unless something is done.
2464             # Rather than die with an error, issue a warning and attempt to
2465             # brute-force the sync.
2466              
2467             # Process something with minimal deps as a work-around.
2468             my @ordered_by_least_number_of_prerequisites =
2469 0         0 sort{ scalar(keys(%{$prerequisites{$a}})) <=> scalar(keys(%{$prerequisites{$b}})) }
  0         0  
  0         0  
2470 0         0 grep { $prerequisites{$_} }
  0         0  
2471             keys %all_unresolved;
2472              
2473 0         0 @ready_to_add = ($ordered_by_least_number_of_prerequisites[0]);
2474 0         0 warn "Circular dependency! Pushing @ready_to_add to brute-force the save.\n";
2475             #print STDERR Data::Dumper::Dumper(\%objects_by_class_name, \%prerequisites, \%dependants ) . "\n";
2476             }
2477             else
2478             {
2479             # This is the normal case. It is either the first iteration,
2480             # or we are on additional iterations with some progress made
2481             # in the last iteration.
2482              
2483             # Find commands which have no unresolved prerequisites.
2484             @ready_to_add =
2485 66         145 grep { not $prerequisites{$_} }
  101         253  
2486             keys %all_unresolved;
2487              
2488             # If there are none of the above, find commands
2489             # with only self-referencing prerequisites.
2490 66 100       183 unless (@ready_to_add)
2491             {
2492             # Find commands with only circular dependancies.
2493             @ready_to_add =
2494             # The circular prerequisite must be the only prerequisite on the table.
2495 1         2 grep { scalar(keys(%{$prerequisites{$_}})) == 1 }
  1         3  
2496              
2497             # The prerequisite must be the same as the the table itself.
2498 1         3 grep { $prerequisites{$_}{$_} }
2499              
2500             # There must be prerequisites for the given table,
2501 1         2 grep { $prerequisites{$_} }
  1         2  
2502              
2503             # Look at all of the unresolved table commands.
2504             keys %all_unresolved;
2505              
2506             # Note this for below.
2507             # It records the $fk object which is circular.
2508 1         2 for my $table_command (@ready_to_add)
2509             {
2510 1         2 $self_referencing_table_commands{$table_command} = $prerequisites{$table_command}{$table_command};
2511             }
2512             }
2513             }
2514              
2515             # Record our current unresolved count for comparison on the next iteration.
2516 66         90 $last_unresolved_count = $unresolved_count;
2517              
2518 66         128 for my $db_command (@ready_to_add)
2519             {
2520             # Put it in the list.
2521 74         103 push @general_commands_in_order, $db_command;
2522              
2523             # Delete it from the main hash of command/table pairs
2524             # for which dependencies are not resolved.
2525 74         118 delete $all_unresolved{$db_command};
2526              
2527             # Find anything which depended on this command occurring first
2528             # and remove this command from that command's prerequisite list.
2529 74         101 for my $dependant (keys %{ $dependants{$db_command} })
  74         224  
2530             {
2531             # Tell it to take us out of its list of prerequisites.
2532 23 50       59 delete $prerequisites{$dependant}{$db_command} if $prerequisites{$dependant};
2533              
2534             # Get rid of the prereq entry if it is empty;
2535 23 100       21 delete $prerequisites{$dependant} if (keys(%{ $prerequisites{$dependant} }) == 0);
  23         75  
2536             }
2537              
2538             # Note that nothing depends on this command any more since it has been queued.
2539 74         212 delete $dependants{$db_command};
2540             }
2541             }
2542              
2543             # Go through the ordered list of general commands (ie "insert TABLE_NAME")
2544             # and build the list of explicit commands.
2545 52         81 my @explicit_commands_in_order;
2546 52         104 for my $general_command (@general_commands_in_order)
2547             {
2548 74         380 my ($dml_type,$table_name) = split(/\s+/,$general_command);
2549              
2550              
2551 74 100       194 if (my $circular_fk_list = $self_referencing_table_commands{$general_command})
2552             {
2553             # A circular foreign key requires that the
2554             # items be inserted in a specific order.
2555             my (@rcol_sets) =
2556 1         3 map { [ $_->column_names ] }
  1         5  
2557             @$circular_fk_list;
2558              
2559             # Get the IDs and objects which need to be saved.
2560 1         2 my @cmds = @{ $explicit_commands_by_type_and_table{$dml_type}{$table_name} };
  1         6  
2561 1         2 my @ids = map { $_->{id} } @cmds;
  10         18  
2562              
2563             # my @objs = $cmds[0]->{class}->is_loaded(\@ids);
2564             my $is_loaded_class =
2565             ($dml_type eq 'delete')
2566             ? $cmds[0]->{class}->ghost_class
2567 1 50       15 : $cmds[0]->{class};
2568              
2569 1         21 my @objs = $is_loaded_class->is_loaded(\@ids);
2570 1         2 my %objs = map { $_->id => $_ } @objs;
  5         7  
2571              
2572             # Produce the explicit command list in dep order.
2573 1         3 my %unsorted_cmds = map { $_->{id} => $_ } @cmds;
  10         13  
2574 1         2 my $add;
2575             my @local_explicit_commands;
2576 0         0 my %adding;
2577             $add = sub {
2578 5     5   6 my ($cmd) = @_;
2579 5 50       11 if ($adding{$cmd}) {
2580             ##$DB::single = 1;
2581 0 0       0 Carp::confess("Circular foreign key!") unless $main::skip_croak;
2582             }
2583 5         7 $adding{$cmd} = 1;
2584 5         6 my $obj = $objs{$cmd->{id}};
2585 5         13 my $class_meta = $obj->class->__meta__;
2586 5         7 for my $rcol_set (@rcol_sets) {
2587 5         15 my @ordered_values = map { $obj->$_ }
2588 5         7 map { $class_meta->property_for_column($_) }
  5         14  
2589             @$rcol_set;
2590 5         12 my $pid = $obj->class->__meta__->resolve_composite_id_from_ordered_values(@ordered_values);
2591 5 50       10 if (defined $pid) { # This recursive foreign key dep may have been optional
2592 5         8 my $pcmd = delete $unsorted_cmds{$pid};
2593 5 100       25 $add->($pcmd) if $pcmd;
2594             }
2595             }
2596 5         7 delete $adding{$cmd};
2597 5         8 push @local_explicit_commands, $cmd;
2598 1         6 };
2599 1         2 for my $cmd (@cmds) {
2600 10 100       16 next unless $unsorted_cmds{$cmd->{id}};
2601 1         9 $add->(delete $unsorted_cmds{$cmd->{id}});
2602             }
2603              
2604 1 50       3 if ($dml_type eq 'delete') {
2605 1         3 @local_explicit_commands = reverse @local_explicit_commands;
2606             }
2607              
2608 1         4 push @explicit_commands_in_order, @local_explicit_commands;
2609             }
2610             else
2611             {
2612             # Order is irrelevant on non-self-referencing tables.
2613 73         112 push @explicit_commands_in_order, @{ $explicit_commands_by_type_and_table{$dml_type}{$table_name} };
  73         230  
2614             }
2615             }
2616              
2617 52         93 my %table_objects_by_class_name;
2618             my %column_objects_by_class_and_column_name;
2619              
2620             # Make statement handles.
2621 0         0 my %sth;
2622 52         98 for my $cmd (@explicit_commands_in_order)
2623             {
2624 121         234 my $sql = $cmd->{sql};
2625              
2626 121 100       297 unless ($sth{$sql})
2627             {
2628 77         131 my $class_name = $cmd->{class};
2629              
2630             # get the db handle to use for this class
2631 77         121 my $dbh = $cmd->{dbh};
2632 77         362 my $sth = $dbh->prepare($sql);
2633 77         300 $sth{$sql} = $sth;
2634              
2635 77 100       208 unless ($sth)
2636             {
2637 4         14 $self->__signal_observers__('commit_failed', 'prepare', $sql, $dbh->errstr);
2638 2         11 $self->error_message("Error preparing SQL:\n$sql\n" . $dbh->errstr . "\n");
2639 2         33 return;
2640             }
2641              
2642 73         136 my $tables = $table_objects_by_class_name{$class_name};
2643 73         378 my $class_object = $class_name->__meta__;
2644 73 100       194 unless ($tables) {
2645 57         75 my $tables;
2646 57         403 my @all_table_names = $class_object->all_table_names;
2647 57         124 for my $table_name (@all_table_names) {
2648 64         207 my $table = $self->_get_table_object($table_name);
2649            
2650 64         161 push @$tables, $table;
2651 64   100     363 $column_objects_by_class_and_column_name{$class_name} ||= {};
2652 64         89 my $columns = $column_objects_by_class_and_column_name{$class_name};
2653 64 100       193 unless (%$columns) {
2654 57         262 for my $column ($table->columns) {
2655 154         314 $columns->{$column->column_name} = $column;
2656             }
2657             }
2658             }
2659 57         154 $table_objects_by_class_name{$class_name} = $tables;
2660             }
2661              
2662 73         92 my @column_objects;
2663 73         83 foreach my $column_name ( @{ $cmd->{column_names} } ) {
  73         209  
2664 107         191 my $column = $column_objects_by_class_and_column_name{$class_name}->{$column_name};
2665 107 100       219 unless ($column) {
2666             FIND_IN_ANCESTRY:
2667 2         21 for my $ancestor_class_name ($class_object->ancestry_class_names) {
2668 4         7 $column = $column_objects_by_class_and_column_name{$ancestor_class_name}->{$column_name};
2669 4 50       7 if ($column) {
2670 0         0 $column_objects_by_class_and_column_name{$class_name}->{$column_name} = $column;
2671 0         0 last FIND_IN_ANCESTRY;
2672             }
2673             }
2674             }
2675             # If we didn't find a column object, then $column will be undef
2676             # and we'll have to guess what it looks like
2677 107         172 push @column_objects, $column;
2678             }
2679              
2680             # print "Column Types: @column_types\n";
2681              
2682 73         425 $self->_alter_sth_for_selecting_blob_columns($sth,\@column_objects);
2683             }
2684             }
2685              
2686             # DBI docs say that if AutoCommit is on, then starting a transaction will temporarily
2687             # turn it off. When the handle gets commit() or rollback(), it will get turned back
2688             # on automatically by DBI
2689 48 50 33     759 if ($dbh->{AutoCommit}
2690             and
2691 0         0 ! eval { $dbh->begin_work; 1 }
  0         0  
2692             ) {
2693 0         0 Carp::croak(sprintf('Cannot begin transaction on data source %s: %s',
2694             $self->id, $dbh->errstr));
2695             }
2696              
2697             # Set a savepoint if possible.
2698 48         118 my $savepoint;
2699 48 50       294 if ($self->can_savepoint) {
2700 0         0 $savepoint = $self->_last_savepoint;
2701 0 0       0 if ($savepoint) {
2702 0         0 $savepoint++;
2703             }
2704             else {
2705 0         0 $savepoint=1;
2706             }
2707 0         0 my $sp_name = "sp".$savepoint;
2708 0 0       0 unless ($self->set_savepoint($sp_name)) {
2709 0         0 $self->error_message("Failed to set a savepoint on "
2710             . $self->class
2711             . ": "
2712             . $dbh->errstr
2713             );
2714 0         0 return;
2715             }
2716 0         0 $self->_last_savepoint($savepoint);
2717             }
2718              
2719             # Do any explicit table locking necessary.
2720 48 50       259 if (my @tables_requiring_lock = sort keys %tables_requiring_lock) {
2721 0         0 $self->debug_message("Locking tables: @tables_requiring_lock.");
2722 0         0 my $max_failed_attempts = 10;
2723 0         0 for my $table_name (@tables_requiring_lock) {
2724 0         0 my $table = $self->_get_table_object($table_name);
2725 0         0 my $dbh = $table->dbh;
2726 0         0 my $sth = $dbh->prepare("lock table $table_name in exclusive mode");
2727 0         0 my $failed_attempts = 0;
2728 0         0 my @err;
2729 0         0 for (1) {
2730 0 0       0 unless ($sth->execute) {
2731 0         0 $failed_attempts++;
2732 0         0 $self->warning_message(
2733             "Failed to lock $table_name (attempt # $failed_attempts): "
2734             . $sth->errstr
2735             );
2736 0         0 push @err, $sth->errstr;
2737 0 0       0 unless ($failed_attempts >= $max_failed_attempts) {
2738 0         0 redo;
2739             }
2740             }
2741             }
2742 0 0       0 if ($failed_attempts > 1) {
2743 0         0 my $err = join("\n",@err);
2744 0 0       0 if ($failed_attempts >= $max_failed_attempts) {
2745 0         0 $self->error_message(
2746             "Could not obtain an exclusive table lock on table "
2747             . $table_name . " after $failed_attempts attempts"
2748             );
2749 0         0 $self->rollback_to_savepoint($savepoint);
2750 0         0 return;
2751             }
2752             }
2753             }
2754             }
2755              
2756             # Execute the commands in the correct order.
2757              
2758 48         62 my @failures;
2759 48         72 my $last_failure_count = 0;
2760 48         58 my @previous_failure_sets;
2761              
2762             # If there are failures, we fall-back to brute force and send
2763             # a message to support to debug the inefficiency.
2764 48         65 my $skip_fault_tolerance_check = 1;
2765              
2766 48         106 for (1) {
2767 48         75 @failures = ();
2768 48         96 for my $cmd (@explicit_commands_in_order) {
2769 117 100       239 unless ($sth{$cmd->{sql}}->execute(@{$cmd->{params}}))
  117         474  
2770             {
2771 1         15 my $dbh = $cmd->{dbh};
2772             # my $dbh = UR::Context->resolve_data_source_for_object($cmd->{class})->get_default_handle;
2773 1         7 $self->__signal_observers__('commit_failed', 'execute', $cmd->{sql}, $dbh->errstr);
2774 1         13 push @failures, {cmd => $cmd, error_message => $sth{$cmd->{sql}}->errstr};
2775 0 0       0 last if $skip_fault_tolerance_check;
2776             }
2777 116         445 $sth{$cmd->{sql}}->finish();
2778             }
2779              
2780 47 50       183 if (@failures) {
2781             # There have been some failures. In case the error has to do with
2782             # a failure to correctly determine dependencies in the code above,
2783             # we will retry the set of failed commands. This repeats as long
2784             # as some progress is made on each iteration.
2785 0 0 0     0 if ( (@failures == $last_failure_count) or $skip_fault_tolerance_check) {
2786             # We've tried this exact set of comands before and failed.
2787             # This is a real error. Stop retrying and report.
2788 0         0 for my $error (@failures)
2789             {
2790             $self->error_message($self->id . ": Error executing SQL:\n$error->{cmd}{sql}\n" .
2791 0 0       0 "PARAMS: " . join(', ',map { defined($_) ? "'$_'" : '(undef)' } @{$error->{cmd}{params}}) . "\n" .
  0         0  
2792 0         0 $error->{error_message} . "\n");
2793             }
2794 0         0 last;
2795             }
2796             else {
2797             # We've failed, but we haven't retried this exact set of commands
2798             # and found the exact same failures. This is either the first failure,
2799             # or we had failures before and had success on the last brute-force
2800             # approach to sorting commands. Try again.
2801 0         0 push @previous_failure_sets, \@failures;
2802 0         0 @explicit_commands_in_order = map { $_->{cmd} } @failures;
  0         0  
2803 0         0 $last_failure_count = scalar(@failures);
2804 0         0 $self->warning_message("RETRYING SAVE");
2805 0         0 redo;
2806             }
2807             }
2808             }
2809              
2810             # Rollback to savepoint if there are errors.
2811 47 50       152 if (@failures) {
2812 0 0 0     0 if (!$savepoint or $savepoint eq "NONE") {
2813             # A failure on a database which does not support savepoints.
2814             # We must rollback the entire transacation.
2815             # This is only a problem for a mixed raw-sql and UR::Object environment.
2816 0         0 $dbh->rollback;
2817             }
2818             else {
2819 0         0 $self->_reverse_sync_database();
2820             }
2821             # Return false, indicating failure.
2822 0         0 return;
2823             }
2824              
2825 47 50       389 unless ($self->_set_specified_objects_saved_uncommitted($changed_objects)) {
2826 0         0 Carp::confess("Error setting objects to a saved state after sync_database. Exiting.");
2827 0         0 return;
2828             }
2829              
2830 47 50 33     250 if (exists $params{'commit_on_success'} and ($params{'commit_on_success'} eq '1')) {
2831             # Commit the current transaction.
2832             # The handles will automatically update their objects to
2833             # a committed state from the one set above.
2834             # It will throw an exception on failure.
2835 0         0 $dbh->commit;
2836             }
2837              
2838             # Though we succeeded, see if we had to use the fault-tolerance code to
2839             # do so, and warn software support. This should never occur.
2840 47 50       140 if (@previous_failure_sets) {
2841 0         0 my $msg = "Dependency failure saving: " . Dumper(\@explicit_commands_in_order)
2842             . "\n\nThe following error sets were produced:\n"
2843             . Dumper(\@previous_failure_sets) . "\n\n" . Carp::cluck() . "\n\n";
2844              
2845 0         0 $self->warning_message($msg);
2846 0 0       0 $UR::Context::current->send_email(
2847             To => UR::Context::Process->support_email,
2848             Subject => 'sync_database dependency sort failure',
2849             Message => $msg
2850             ) or $self->warning_message("Failed to send error email!");
2851             }
2852              
2853 47         277 return 1;
2854             }
2855              
2856             # this is necessary for overriding data source names when looking up table metadata with
2857             # bifurcated oracle/postgres syncs in testing.
2858             sub _my_data_source_id {
2859 893     893   1180 my $self = shift;
2860 893 50       3912 return ref($self) ? $self->id : $self;
2861             }
2862              
2863             sub _get_table_object {
2864 356     356   565 my($self, $ds_table) = @_;
2865            
2866 356         902 my $data_source_id = $self->_my_data_source_id;
2867            
2868 356   100     1653 my $table = UR::DataSource::RDBMS::Table->get(
2869             table_name => $ds_table,
2870             data_source => $data_source_id)
2871             ||
2872             UR::DataSource::RDBMS::Table->get(
2873             table_name => $ds_table,
2874             data_source => 'UR::DataSource::Meta');
2875 356         846 return $table;
2876             }
2877              
2878             sub _alter_sth_for_selecting_blob_columns {
2879 73     73   134 my($self, $sth, $column_objects) = @_;
2880              
2881 73         212 return;
2882             }
2883              
2884              
2885             sub _reverse_sync_database {
2886 0     0   0 my $self = shift;
2887              
2888 0 0       0 unless ($self->can_savepoint) {
2889             # This will not respect manual DML
2890             # Developers must not use this back door on non-savepoint databases.
2891 0         0 $self->get_default_handle->rollback;
2892 0         0 return "NONE";
2893             }
2894              
2895 0         0 my $savepoint = $self->_last_savepoint;
2896 0 0       0 unless ($savepoint) {
2897 0         0 Carp::confess("No savepoint set!");
2898             }
2899              
2900 0         0 my $sp_name = "sp".$savepoint;
2901 0 0       0 unless ($self->rollback_to_savepoint($sp_name)) {
2902 0         0 $self->error_message("Error removing savepoint $savepoint " . $self->get_default_handle->errstr);
2903 0         0 return 1;
2904             }
2905              
2906 0         0 $self->_last_savepoint(undef);
2907 0         0 return $savepoint;
2908             }
2909              
2910             # Given a table object and a list of primary key values, return
2911             # a where clause to match a row. Some values may be undef (NULL)
2912             # and it properly writes "column IS NULL". As a side effect, the
2913             # @$values list is altered to remove the undef value
2914             sub _matching_where_clause {
2915 88     88   147 my($self,$table_obj,$values) = @_;
2916              
2917 88 50       207 unless ($table_obj) {
2918 0         0 Carp::confess("No table passed to _matching_where_clause for $self!");
2919             }
2920              
2921 88         308 my @pks = $table_obj->primary_key_constraint_column_names;
2922              
2923 88         172 my @where;
2924             # in @$values, the updated data values always seem to be before the where clause
2925             # values but still in the right order, so start at the right place
2926 88         171 my $skip = scalar(@$values) - scalar(@pks);
2927 88         329 for (my($pk_idx,$values_idx) = (0,$skip); $pk_idx < @pks;) {
2928 125 50       250 if (defined $values->[$values_idx]) {
2929 125         263 push(@where, $pks[$pk_idx] . ' = ?');
2930 125         138 $pk_idx++;
2931 125         376 $values_idx++;
2932             } else {
2933 0         0 push(@where, $pks[$pk_idx] . ' IS NULL');
2934 0         0 splice(@$values, $values_idx, 1);
2935 0         0 $pk_idx++;
2936             }
2937             }
2938              
2939 88         286 return join(' and ', @where);
2940             }
2941              
2942             sub _id_values_for_primary_key {
2943 88     88   137 my ($self,$table_obj,$object_to_save) = @_;
2944              
2945 88 50 33     495 unless ($table_obj && $object_to_save) {
2946 0         0 Carp::confess("Both table and object_to_save should be passed for $self!");
2947             }
2948              
2949 88         120 my $class_obj; # = $object_to_save->__meta__;
2950 88         299 foreach my $possible_class_obj ($object_to_save->__meta__->all_class_metas) {
2951 98 100       320 next unless ($possible_class_obj->table_name);
2952              
2953 88 50       202 if ( $possible_class_obj->table_name eq $table_obj->table_name ) {
2954              
2955 88         117 $class_obj = $possible_class_obj;
2956 88         170 last;
2957             }
2958             }
2959 88 50       238 unless (defined $class_obj) {
2960 0         0 Carp::croak("Can't find class object with table " . $table_obj->table_name . " while searching inheritance for object of class ".$self->class);
2961             }
2962              
2963 88         339 my @pk_cols = $table_obj->primary_key_constraint_column_names;
2964 88         202 my %pk_cols = map { $_ => 1 } @pk_cols;
  125         311  
2965             # this previously went to $object_to_save->__meta__, which is nearly the same thing but not quite
2966 88         358 my @values = $class_obj->resolve_ordered_values_from_composite_id($object_to_save->id);
2967 88         403 my @columns = $class_obj->direct_id_column_names;
2968              
2969 88         176 foreach my $col_in_class ( @columns ) {
2970 125 50       308 unless ($pk_cols{$col_in_class}) {
2971 0         0 my $table_name = $table_obj->table_name;
2972 0         0 my $class_name = $class_obj->class_name;
2973 0         0 Carp::croak("While committing, metadata for table $table_name does not match class $class_name.\n Table primary key columns are " .
2974             join(', ',@pk_cols) .
2975             "\n class ID property columns " .
2976             join(', ', @columns));
2977             }
2978             }
2979              
2980 88         111 my $i=0;
2981 88         109 my %column_index = map { $_ => $i++ } @columns;
  125         327  
2982 88         135 my @bad_pk_cols = grep { ! exists($column_index{$_}) } @pk_cols;
  125         260  
2983 88 50       201 if (@bad_pk_cols) {
2984 0         0 my $table_name = $table_obj->table_name;
2985 0         0 Carp::croak("Metadata for table $table_name is inconsistent with class ".$class_obj->class_name.".\n"
2986             . "Column(s) named " . join(',',@bad_pk_cols) . " appear as primary key constraint columns, "
2987             . "but do not appear as ID column names. Check the dd_pk_constraint_columns data in the "
2988             . "MetaDB and the ID properties of the class definition");
2989             }
2990              
2991 88         239 my @id_values_in_pk_order = @values[@column_index{@pk_cols}];
2992              
2993 88         341 return @id_values_in_pk_order;
2994             }
2995              
2996             sub _lookup_class_for_table_name {
2997 242     242   1505 my $self = shift;
2998 242         326 my $table_name = shift;
2999              
3000 242         935 my @table_class_obj = grep { $_->class_name !~ /::Ghost$/ } UR::Object::Type->is_loaded(data_source_id => $self->id, table_name => $table_name);
  251         750  
3001              
3002             # Like _get_table_object, we need to look in the data source and if the
3003             # object wasn't found then in 'UR::DataSource::Meta' in order to mimic
3004             # behavior elsewhere.
3005 242 100       689 unless (@table_class_obj) {
3006 64         239 @table_class_obj = grep { $_->class_name !~ /::Ghost$/ } UR::Object::Type->is_loaded(data_source_id => 'UR::DataSource::Meta', table_name => $table_name);
  16         60  
3007             }
3008 242         330 my $table_class;
3009             my $table_class_obj;
3010 242 100       794 if (@table_class_obj == 1) {
    50          
3011 194         308 $table_class_obj = $table_class_obj[0];
3012 194         449 return $table_class_obj->class_name;
3013             } elsif (@table_class_obj > 1) {
3014 0         0 Carp::confess("Got more than one class object for $table_name, this should not happen: @table_class_obj");
3015             }
3016             }
3017              
3018              
3019             sub _default_save_sql_for_object {
3020 136     136   304 my $self = shift;
3021 136         179 my $object_to_save = shift;
3022 136         258 my %params = @_;
3023              
3024 136         586 my ($class,$id) = ($object_to_save->class, $object_to_save->id);
3025              
3026 136         446 my $class_object = $object_to_save->__meta__;
3027              
3028             # This object may have uncommitted changes already saved.
3029             # If so, work from the last saved data.
3030             # Normally, we go with the last committed data.
3031              
3032 136 100       482 my $compare_version = ($object_to_save->{'db_saved_uncommitted'} ? 'db_saved_uncommitted' : 'db_committed');
3033              
3034             # Determine what the overall save action for the object is,
3035             # and get a specific change summary if we're doing an update.
3036              
3037 136         137 my ($action,$change_summary);
3038 136 100       869 if ($object_to_save->isa('UR::Object::Ghost'))
    100          
3039             {
3040 46         65 $action = 'delete';
3041             }
3042             elsif ($object_to_save->{$compare_version})
3043             {
3044 44         70 $action = 'update';
3045 44         305 $change_summary = $object_to_save->property_diff($object_to_save->{$compare_version});
3046             }
3047             else
3048             {
3049 46         83 $action = 'insert';
3050             }
3051              
3052             # Handle each table. There is usually only one, unless,
3053             # there is inheritance within the schema.
3054             my @save_table_names =
3055 136         837 grep { not /[^\w\.]/ } # remove any views from the list
  144         607  
3056             List::MoreUtils::uniq($class_object->all_table_names);
3057              
3058 136 100       975 @save_table_names = reverse @save_table_names unless ($object_to_save->isa('UR::Entity::Ghost'));
3059              
3060 136         179 my @commands;
3061 136         227 for my $table_name (@save_table_names)
3062             {
3063             # Get general info on the table we're working-with.
3064              
3065 144 50       796 my $dsn = ref($self) ? $self->_my_data_source_id: $self; # The data source name
3066              
3067 144         468 my $table = $self->_get_table_object($table_name);
3068              
3069 144 100       395 unless ($table) {
3070 26         270 $self->generate_schema_for_class_meta($class_object,1);
3071             # try again...
3072 26         139 $table = $self->_get_table_object($table_name);
3073 26 50       92 unless ($table) {
3074 0         0 Carp::croak("No table $table_name found for data source $dsn");
3075             }
3076             }
3077              
3078 144         1205 my $table_class = $self->_lookup_class_for_table_name($table_name);
3079 144 50       371 if (!$table_class) {
3080 0         0 Carp::croak("NO CLASS FOR $table_name\n");
3081             }
3082            
3083              
3084 144         521 my $data_source = $UR::Context::current->resolve_data_source_for_object($object_to_save);
3085 144 50       382 unless ($data_source) {
3086 0         0 Carp::croak("Couldn't resolve data source for object ".$object_to_save->__display_name__.":\n"
3087             . Data::Dumper::Dumper($object_to_save));
3088             }
3089              
3090             # The "action" now can vary on a per-table basis.
3091              
3092 144         210 my $table_action = $action;
3093              
3094             # Handle re-classification of objects.
3095             # We skip deletion and turn insert into update in these cases.
3096              
3097 144 100 100     661 if ( ($table_class ne $class) and ( ($table_class . "::Ghost") ne $class) ) {
3098 18 50       99 if ($action eq 'delete') {
    100          
3099             # see if the object we're deleting actually exists reclassified
3100 0         0 my $replacement = $table_class->is_loaded($id);
3101 0 0       0 if ($replacement) {
3102 0         0 next;
3103             }
3104             }
3105             elsif ($action eq 'insert') {
3106             # see if the object we're inserting is actually a reclassification
3107             # of a pre-existing object
3108 1         6 my $replacing = $table_class->ghost_class->is_loaded($id);
3109 1 50       4 if ($replacing) {
3110 0         0 $table_action = 'update';
3111 0         0 $change_summary = $object_to_save->property_diff(%$replacing);
3112             }
3113             }
3114             }
3115              
3116             # Determine the $sql and @values needed to save this object.
3117              
3118 144 100       543 if ($table_action eq 'delete')
    100          
    50          
3119             {
3120             # A row loaded from the database with its object deleted.
3121             # Delete the row in the database.
3122              
3123             #grab fk_constraints so we can undef non primary-key nullable fks before delete
3124 46         155 my @non_pk_nullable_fk_columns = $self->get_non_primary_key_nullable_foreign_key_columns_for_table($table);
3125              
3126 46         142 my @values = $self->_id_values_for_primary_key($table,$object_to_save);
3127 46         145 my $where = $self->_matching_where_clause($table, \@values);
3128              
3129 46 100       126 if (@non_pk_nullable_fk_columns) {
3130             #generate an update statement to set nullable fk columns to null pre delete
3131 21         26 my $update_sql = "UPDATE ";
3132 21         45 $update_sql .= "$table_name SET ";
3133 21         25 $update_sql .= join(", ", map { "$_=?"} @non_pk_nullable_fk_columns);
  21         51  
3134 21         33 $update_sql .= " WHERE $where";
3135 21         36 my @update_values = @values;
3136 21         29 for (@non_pk_nullable_fk_columns){
3137 21         32 unshift @update_values, undef;
3138             }
3139 21         78 my $update_command = { type => 'update',
3140             table_name => $table_name,
3141             column_names => \@non_pk_nullable_fk_columns,
3142             sql => $update_sql,
3143             params => \@update_values,
3144             class => $table_class,
3145             id => $id,
3146             dbh => $data_source->get_default_handle
3147             };
3148 21         46 push @commands, $update_command;
3149             }
3150              
3151              
3152 46         64 my $sql = " DELETE FROM ";
3153 46         101 $sql .= "$table_name WHERE $where";
3154              
3155 46         157 push @commands, { type => 'delete',
3156             table_name => $table_name,
3157             column_names => undef,
3158             sql => $sql,
3159             params => \@values,
3160             class => $table_class,
3161             id => $id,
3162             dbh => $data_source->get_default_handle
3163             };
3164              
3165             #print Data::Dumper::Dumper \@commands;
3166             }
3167             elsif ($table_action eq 'update')
3168             {
3169             # Pre-existing row.
3170             # Update in the database if there are columns which have changed.
3171              
3172 52         78 my $changes_for_this_table;
3173 52 100       144 if (@save_table_names > 1)
3174             {
3175             my @changes =
3176 8         29 map { $_ => $change_summary->{$_} }
3177 16         53 grep { $class_object->table_for_property($_) eq $table_name }
  16         64  
3178             keys %$change_summary;
3179 16         41 $changes_for_this_table = {@changes};
3180             }
3181             else
3182             {
3183             # Shortcut and use the overall changes summary when
3184             # there is only one table.
3185 36         61 $changes_for_this_table = $change_summary;
3186             }
3187              
3188 52         76 my(@changed_cols,@values);
3189 52         184 for my $property (keys %$changes_for_this_table)
3190             {
3191 50         290 my $column_name = $class_object->column_for_property($property);
3192 50 50       140 Carp::croak("No column in table $table_name for property $property?") unless $column_name;
3193 50         75 push @changed_cols, $column_name;
3194 50         130 push @values, $changes_for_this_table->{$property};
3195             }
3196              
3197 52 100       144 if (@changed_cols)
3198             {
3199 50 50 33     266 my @changed_values = map { defined ($_) && $object_to_save->can($_)
3200             ? $object_to_save->$_
3201             : undef }
3202 38 50       75 map { $class_object->property_for_column($_) || undef }
  50         245  
3203             @changed_cols;
3204              
3205 38         214 my @id_values = $self->_id_values_for_primary_key($table,$object_to_save);
3206              
3207 38 50       128 if (scalar(@changed_cols) != scalar(@changed_values)) {
3208 130     130   795 no warnings 'uninitialized';
  130         206  
  130         38021  
3209 0         0 my $mapping = join("\n", map { " $_ => ".$class_object->property_for_column($_) } @changed_cols);
  0         0  
3210 0         0 Carp::croak("Column count mismatch while updating table $table_name. "
3211             . "The table metadata expects to see ".scalar(@changed_cols)
3212             . " columns, but ".scalar(@values)." were retrieved from the object of type "
3213             . $object_to_save->class . ".\nCurrent column => property mapping:\n$mapping\n"
3214             . "There is probably a mismatch between the database column metadata and the column_name "
3215             . "property metadata");
3216             }
3217              
3218 38         110 my @all_values = ( @changed_values, @id_values );
3219 38         203 my $where = $self->_matching_where_clause($table, \@all_values);
3220              
3221 38         75 my $sql = " UPDATE ";
3222 38         108 $sql .= "$table_name SET " . join(",", map { "$_ = ?" } @changed_cols) . " WHERE $where";
  50         196  
3223              
3224 38         229 push @commands, { type => 'update',
3225             table_name => $table_name,
3226             column_names => \@changed_cols,
3227             sql => $sql,
3228             params => \@all_values,
3229             class => $table_class,
3230             id => $id,
3231             dbh => $data_source->get_default_handle
3232             };
3233             }
3234             }
3235             elsif ($table_action eq 'insert')
3236             {
3237             # An object without a row in the database.
3238             # Insert into the database.
3239              
3240             my @changed_cols = reverse sort
3241 98         203 map { $class_object->column_for_property($_->property_name) }
3242 98         241 grep { ! $_->is_transient }
3243 98   50     272 grep { ($class_object->table_for_property($_->property_name) || '') eq $table_name }
3244 46         361 grep { $_->column_name }
  179         366  
3245             List::MoreUtils::uniq($class_object->all_property_metas());
3246              
3247 46         148 my $sql = " INSERT INTO ";
3248 46         393 $sql .= "$table_name ("
3249             . join(",", @changed_cols)
3250             . ") VALUES ("
3251             . join(',', split(//,'?' x scalar(@changed_cols))) . ")";
3252              
3253             my @values = map {
3254             # when there is a column but no property, use NULL as the value
3255 98 50 33     474 defined($_) && $object_to_save->can($_)
3256             ? $object_to_save->$_
3257             : undef
3258             }
3259 46 50       97 map { $class_object->property_for_column($_) || undef }
  98         308  
3260             (@changed_cols);
3261              
3262 46 50       167 if (scalar(@changed_cols) != scalar(@values)) {
3263 130     130   626 no warnings 'uninitialized';
  130         221  
  130         236668  
3264 0         0 my $mapping = join("\n", map { " $_ => ".$class_object->property_for_column($_) } @changed_cols);
  0         0  
3265 0         0 Carp::croak("Column count mismatch while inserting into table $table_name. "
3266             . "The table metadata expects to see ".scalar(@changed_cols)
3267             . " columns, but ".scalar(@values)." were retrieved from the object of type "
3268             . $object_to_save->class . ".\nCurrent column => property mapping:\n$mapping\n"
3269             . "There is probably a mismatch between the database column metadata and the column_name "
3270             . "property metadata");
3271             }
3272              
3273             #grab fk_constraints so we can undef non primary-key nullable fks before delete
3274 46         297 my %non_pk_nullable_fk_columns = map { $_ => 1 }
  4         22  
3275             $self->get_non_primary_key_nullable_foreign_key_columns_for_table($table);
3276              
3277 46 100       130 if (%non_pk_nullable_fk_columns){
3278 4         9 my @insert_values;
3279             my %update_values;
3280 4         23 for (my $i = 0; $i < @changed_cols; $i++){
3281 8         13 my $col = $changed_cols[$i];
3282 8 100       18 if ($non_pk_nullable_fk_columns{$col}) {
3283 4         12 push @insert_values, undef;
3284 4         20 $update_values{$col} = $values[$i];
3285             }else{
3286 4         20 push @insert_values, $values[$i];
3287             }
3288             }
3289              
3290 4         30 push @commands, { type => 'insert',
3291             table_name => $table_name,
3292             column_names => \@changed_cols,
3293             sql => $sql,
3294             params => \@insert_values,
3295             class => $table_class,
3296             id => $id,
3297             dbh => $data_source->get_default_handle
3298             };
3299              
3300             ##$DB::single = 1;
3301             # %update_values can be empty if the Metadb is out of date, and has a fk constraint column
3302             # that no longer exists in the class metadata
3303 4 50       21 if (%update_values) {
3304 4         19 my @pk_values = $self->_id_values_for_primary_key($table, $object_to_save);
3305 4         22 my $where = $self->_matching_where_clause($table, \@pk_values);
3306            
3307 4         20 my @update_cols = keys %update_values;
3308 4         12 my @update_values = ((map {$update_values{$_}} @update_cols), @pk_values);
  4         19  
3309            
3310            
3311              
3312 4         11 my $update_sql = " UPDATE ";
3313 4         16 $update_sql .= "$table_name SET ". join(",", map { "$_ = ?" } @update_cols) . " WHERE $where";
  4         24  
3314              
3315 4         33 push @commands, { type => 'update',
3316             table_name => $table_name,
3317             column_names => \@update_cols,
3318             sql => $update_sql,
3319             params => \@update_values,
3320             class => $table_class,
3321             id => $id,
3322             dbh => $data_source->get_default_handle
3323             };
3324             }
3325             }
3326             else
3327             {
3328 42         234 push @commands, { type => 'insert',
3329             table_name => $table_name,
3330             column_names => \@changed_cols,
3331             sql => $sql,
3332             params => \@values,
3333             class => $table_class,
3334             id => $id,
3335             dbh => $data_source->get_default_handle
3336             };
3337             }
3338              
3339             }
3340             else
3341             {
3342 0         0 die "Unknown action $table_action for $object_to_save" . Dumper($object_to_save) . "\n";
3343             }
3344              
3345             } # next table
3346              
3347 136         698 return @commands;
3348             }
3349              
3350             sub _do_on_default_dbh {
3351 134     134   175 my $self = shift;
3352 134         152 my $method = shift;
3353              
3354 134 100       349 return 1 unless $self->has_default_handle();
3355              
3356 133         262 my $dbh = $self->get_default_handle;
3357 133 50       495 unless ($dbh->$method(@_)) {
3358 0         0 $self->error_message("DataSource ".$self->get_name." failed to $method: ".$dbh->errstr);
3359 0         0 return undef;
3360             }
3361              
3362 133         422 return 1;
3363             }
3364              
3365             sub commit {
3366 115     115 1 188 my $self = shift;
3367 115 100       581 if ($self->has_default_handle) {
3368 114 50       326 if (my $dbh = $self->get_default_handle) {
3369 114 50       571 if ($dbh->{AutoCommit} ) {
3370 0         0 $self->debug_message('Ignoring ineffective commit because AutoCommit is on');
3371 0         0 return 1;
3372             }
3373             }
3374             }
3375 115         541 $self->_do_on_default_dbh('commit', @_);
3376             }
3377              
3378             sub rollback {
3379 17     17 1 22 my $self = shift;
3380 17 50       71 if ($self->has_default_handle) {
3381 17 50       49 if (my $dbh = $self->get_default_handle) {
3382 17 50       79 if ($dbh->{AutoCommit} ) {
3383 0         0 $self->debug_message('Ignoring ineffective rollback because AutoCommit is on');
3384 0         0 return 1;
3385             }
3386             }
3387             }
3388 17         64 $self->_do_on_default_dbh('rollback', @_);
3389             }
3390              
3391             sub disconnect {
3392 2     2 0 744 my $self = shift;
3393 2 50 33     26 if (! ref($self) and $self->isa('UR::Singleton')) {
3394 2         43 $self = $self->_singleton_object;
3395             }
3396 2         16 my $rv = $self->_do_on_default_dbh('disconnect', @_);
3397 2         30 $self->__invalidate_get_default_handle__;
3398 2         9 $self->is_connected(0);
3399 2         6 return $rv;
3400             }
3401              
3402             sub _generate_class_data_for_loading {
3403 3117     3117   3930 my ($self, $class_meta) = @_;
3404              
3405 3117         11160 my $parent_class_data = $self->SUPER::_generate_class_data_for_loading($class_meta);
3406              
3407 3117         9715 my @class_hierarchy = ($class_meta->class_name,$class_meta->ancestry_class_names);
3408 3117         4301 my $order_by_columns;
3409 3117         3356 do {
3410 3117         3627 my @id_column_names;
3411 3117         5320 for my $inheritance_class_name (@class_hierarchy) {
3412 3152         8513 my $inheritance_class_object = UR::Object::Type->get($inheritance_class_name);
3413 3152 100       9236 unless ($inheritance_class_object->table_name) {
3414 35         69 next;
3415             }
3416             @id_column_names =
3417             map {
3418 4735         9777 my $t = $inheritance_class_object->table_name;
3419 4735         20113 ($t) = ($t =~ /(\S+)\s*$/);
3420 4735         14466 $t . '.' . $_
3421             }
3422 4735         7947 grep { defined }
3423             map {
3424 4735         12126 my $p = $inheritance_class_object->property_meta_for_name($_);
3425 4735 50       8880 Carp::croak("No property $_ found for " . $inheritance_class_object->class_name) unless $p;
3426 4735         9331 $p->column_name;
3427             }
3428 4735         9752 map { $_->property_name }
3429 3117         13528 grep { $_->column_name }
  4735         11853  
3430             $inheritance_class_object->direct_id_property_metas;
3431              
3432 3117 50       9042 last if (@id_column_names);
3433             }
3434 3117         4992 $order_by_columns = \@id_column_names;
3435             };
3436              
3437 3117         4140 my @all_table_properties;
3438             my @direct_table_properties;
3439 3117         12998 my $first_table_name = $class_meta->first_table_name;
3440 3117         3351 my $sub_classification_method_name;
3441 3117         3714 my ($sub_classification_meta_class_name, $subclassify_by);
3442              
3443 0         0 my @base_joins;
3444 0         0 my $prev_table_name;
3445 0         0 my $prev_id_column_name;
3446              
3447 0         0 my %seen;
3448 3117         4091 for my $co ( $class_meta, @{ $parent_class_data->{parent_class_objects} } ) {
  3117         7290  
3449 10285 100       23094 next if $seen{ $co->class_name }++;
3450 10283         22200 my $table_name = $co->first_table_name;
3451 10283 100       18612 next unless $table_name;
3452              
3453             #$first_table_name ||= $co->table_name;
3454 3347   66     12409 $sub_classification_method_name ||= $co->sub_classification_method_name;
3455 3347   33     11518 $sub_classification_meta_class_name ||= $co->sub_classification_meta_class_name;
3456 3347   100     11489 $subclassify_by ||= $co->subclassify_by;
3457              
3458 3347     14068   12759 my $sort_sub = sub ($$) { return $_[0]->property_name cmp $_[1]->property_name };
  14068         21840  
3459             push @all_table_properties,
3460 12023         22563 map { [$co, $_, $table_name, 0 ] }
3461             sort $sort_sub
3462 3347 100 66     9880 grep { (defined $_->column_name && $_->column_name ne '') or
  17737   100     27415  
3463             (defined $_->calculate_sql && $_->calculate_sql ne '') }
3464             UR::Object::Property->get( class_name => $co->class_name );
3465              
3466 3347 100       23746 @direct_table_properties = @all_table_properties if $class_meta eq $co;
3467             }
3468              
3469 3117         3859 my @lob_column_names;
3470             my @lob_column_positions;
3471 3117         3703 my $pos = 0;
3472 3117         4912 for my $class_property (@all_table_properties) {
3473 12023         12401 my ($sql_class,$sql_property,$sql_table_name) = @$class_property;
3474 12023   100     20922 my $data_type = $sql_property->data_type || '';
3475 12023 50       25224 if ($data_type =~ /LOB$/i) {
3476 0         0 push @lob_column_names, $sql_property->column_name;
3477 0         0 push @lob_column_positions, $pos;
3478             }
3479 12023         12665 $pos++;
3480             }
3481              
3482 3117         3583 my $query_config;
3483             my $post_process_results_callback;
3484 3117 50       6568 if (@lob_column_names) {
3485 0         0 $query_config = $self->_prepare_for_lob;
3486 0 0       0 if ($query_config) {
3487 0         0 my $results_row_arrayref;
3488             my @lob_ids;
3489 0         0 my @lob_values;
3490             $post_process_results_callback = sub {
3491 0     0   0 $results_row_arrayref = shift;
3492 0         0 my $dbh = $self->get_default_handle;
3493 0         0 @lob_ids = @$results_row_arrayref[@lob_column_positions];
3494 0         0 @lob_values = $self->_post_process_lob_values($dbh,\@lob_ids);
3495 0         0 @$results_row_arrayref[@lob_column_positions] = @lob_values;
3496 0         0 $results_row_arrayref;
3497 0         0 };
3498             }
3499             }
3500              
3501 3117         51508 my $class_data = {
3502             %$parent_class_data,
3503              
3504             all_table_properties => \@all_table_properties,
3505             direct_table_properties => \@direct_table_properties,
3506              
3507             first_table_name => $first_table_name,
3508             sub_classification_method_name => $sub_classification_method_name,
3509             sub_classification_meta_class_name => $sub_classification_meta_class_name,
3510             subclassify_by => $subclassify_by,
3511              
3512             base_joins => \@base_joins,
3513             order_by_columns => $order_by_columns,
3514              
3515             lob_column_names => \@lob_column_names,
3516             lob_column_positions => \@lob_column_positions,
3517              
3518             query_config => $query_config,
3519             post_process_results_callback => $post_process_results_callback,
3520             };
3521              
3522 3117         20242 return $class_data;
3523             }
3524              
3525             sub _select_clause_for_table_property_data {
3526 655     655   967 my $self = shift;
3527 655         2809 my $column_data = $self->_select_clause_columns_for_table_property_data(@_);
3528 655         2503 my $select_clause = join(', ',@$column_data);
3529 655         1760 return $select_clause;
3530             }
3531              
3532             sub _select_clause_columns_for_table_property_data {
3533 734     734   1023 my $self = shift;
3534              
3535 734         937 my @column_data;
3536 734         1410 for my $class_property (@_) {
3537 3241         4073 my ($sql_class,$sql_property,$sql_table_name) = @$class_property;
3538 3241   33     4403 $sql_table_name ||= $sql_class->table_name;
3539 3241         9185 my ($select_table_name) = ($sql_table_name =~ /(\S+)\s*$/s);
3540              
3541             # FIXME - maybe a better way would be for these sql-calculated properties, the column_name()
3542             # or maybe some other related property name) is actually calculated, so this logic
3543             # gets encapsulated in there?
3544 3241 100       6193 if (my $sql_function = $sql_property->calculate_sql) {
3545 1 50       5 my @calculate_from = ref($sql_property->calculate_from) eq 'ARRAY' ? @{$sql_property->calculate_from} : ( $sql_property->calculate_from );
  1         2  
3546 1         2 foreach my $sql_column_name ( @calculate_from ) {
3547 1         29 $sql_function =~ s/($sql_column_name)/$sql_table_name\.$1/g;
3548             }
3549 1         3 push(@column_data, $sql_function);
3550             } else {
3551 3240         6447 push(@column_data, $select_table_name . "." . $sql_property->column_name);
3552             }
3553             }
3554 734         1542 return \@column_data;
3555             }
3556              
3557              
3558             # These seem to be standard for most RDBMSs
3559             my %ur_data_type_for_vendor_data_type = (
3560             # DB type UR Type
3561             'VARCHAR' => ['Text', undef],
3562             'CHAR' => ['Text', 1],
3563             'CHARACTER' => ['Text', 1],
3564             'XML' => ['Text', undef],
3565              
3566             'INTEGER' => ['Integer', undef],
3567             'UNSIGNED INTEGER' => ['Integer', undef],
3568             'SIGNED INTEGER' => ['Integer', undef],
3569             'INT' => ['Integer', undef],
3570             'LONG' => ['Integer', undef],
3571             'BIGINT' => ['Integer', undef],
3572             'SMALLINT' => ['Integer', undef],
3573              
3574             'FLOAT' => ['Number', undef],
3575             'NUMBER' => ['Number', undef],
3576             'DOUBLE' => ['Number', undef],
3577             'DECIMAL' => ['Number', undef],
3578             'REAL' => ['Number', undef],
3579              
3580             'BOOL' => ['Boolean', undef],
3581             'BOOLEAN' => ['Boolean', undef],
3582             'BIT' => ['Boolean', undef],
3583              
3584             'DATE' => ['DateTime', undef],
3585             'DATETIME' => ['DateTime', undef],
3586             'TIMESTAMP' => ['DateTime', undef],
3587             'TIME' => ['DateTime', undef],
3588             );
3589              
3590             sub normalize_vendor_type {
3591 6     6 0 7 my ($class, $type) = @_;
3592 6         5 $type = uc($type);
3593 6         9 $type =~ s/\(\d+\)$//;
3594 6         7 return $type;
3595             }
3596              
3597             sub ur_data_type_for_data_source_data_type {
3598 3     3 0 2 my($class,$type) = @_;
3599              
3600 3         4 $type = $class->normalize_vendor_type($type);
3601 3         4 my $urtype = $ur_data_type_for_vendor_data_type{$type};
3602 3 50       4 unless (defined $urtype) {
3603 0         0 $urtype = $class->SUPER::ur_data_type_for_data_source_data_type($type);
3604             }
3605 3         5 return $urtype;
3606             }
3607              
3608              
3609             sub _vendor_data_type_for_ur_data_type {
3610 228     228   1381 return ( TEXT => 'VARCHAR',
3611             STRING => 'VARCHAR',
3612             INTEGER => 'INTEGER',
3613             DECIMAL => 'INTEGER',
3614             NUMBER => 'FLOAT',
3615             BOOLEAN => 'INTEGER',
3616             DATETIME => 'DATETIME',
3617             TIMESTAMP => 'TIMESTAMP',
3618             __default__ => 'VARCHAR',
3619             );
3620             }
3621              
3622             sub data_source_type_for_ur_data_type {
3623 228     228 0 236 my($class, $type) = @_;
3624              
3625 228 50 66     792 if ($type and $type->isa('UR::Value')) {
3626 0         0 ($type) =~ m/UR::Value::(\w+)/;
3627             }
3628 228         1480 my %types = $class->_vendor_data_type_for_ur_data_type();
3629             return $type && $types{uc($type)}
3630             ? $types{uc($type)}
3631 228 100 66     1067 : $types{__default__};
3632             }
3633              
3634              
3635             # Given two properties with different 'is', return a 2-element list of
3636             # SQL functions to apply to perform a comparison in the DB. 0th element
3637             # gets applied to the left side, 1st element to the right. This implementation
3638             # uses printf formats where the %s gets fed an SQL expression like
3639             # "table.column"
3640             #
3641             # SQLite basically treats everything as strings, so needs no conversion.
3642             # other DBs will have their own conversions
3643             #
3644             # $sql_clause will be one of "join", "where"
3645             sub cast_for_data_conversion {
3646 1029     1029 0 1985 my($class, $left_type, $right_type, $operator, $sql_clause) = @_;
3647              
3648 1029         3254 return ('%s', '%s');
3649             }
3650              
3651             sub do_after_fork_in_child {
3652 0     0 0 0 my $self = shift->_singleton_object;
3653 0         0 my $dbhs = $self->_all_dbh_hashref;
3654 0         0 for my $k (keys %$dbhs) {
3655 0 0       0 if ($dbhs->{$k}) {
3656 0         0 $dbhs->{$k}->{InactiveDestroy} = 1;
3657 0         0 delete $dbhs->{$k};
3658             }
3659             }
3660              
3661             # reset our state back to being "disconnected"
3662 0         0 $self->__invalidate_get_default_handle__;
3663 0         0 $self->_all_dbh_hashref({});
3664 0         0 $self->is_connected(0);
3665              
3666             # now force a reconnect
3667 0         0 $self->get_default_handle();
3668 0         0 return 1;
3669             }
3670              
3671             sub parse_view_and_alias_from_inline_view {
3672 184     184 0 328 my($self, $sql) = @_;
3673              
3674 184 100 100     2087 return ($sql and $sql =~ m/^(.*?)(?:\s+as)?\s+(\w+)\s*$/s)
3675             ? ($1, $2)
3676             : ();
3677             }
3678              
3679             1;
3680              
3681             =pod
3682              
3683             =head1 NAME
3684              
3685             UR::DataSource::RDBMS - Abstract base class for RDBMS-type data sources
3686              
3687             =head1 DESCRIPTION
3688              
3689             This class implements the interface UR uses to query RDBMS databases with
3690             DBI. It encapsulates the system's knowledge of classes/properties relation
3691             to tables/columns, and how to generate SQL to create, retrieve, update and
3692             delete table rows that represent object instances.
3693              
3694             =head1 SEE ALSO
3695              
3696             UR::DataSource, UR::DataSource::Oracle, UR::DataSource::Pg, UR::DataSource::SQLite
3697             UR::DataSource::MySQL
3698              
3699             =cut