is replaced with the table name.
|
1157
|
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
Throws an error if any of the given column names do not yet exist on |
|
1159
|
|
|
|
|
|
|
the result source. |
|
1160
|
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
See also L. |
|
1162
|
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
=cut |
|
1164
|
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
sub add_unique_constraints :DBIC_method_is_indirect_sugar { |
|
1166
|
516
|
|
|
516
|
1
|
18664
|
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; |
|
1167
|
|
|
|
|
|
|
|
|
1168
|
516
|
|
|
|
|
1179
|
my $self = shift; |
|
1169
|
516
|
|
|
|
|
1634
|
my @constraints = @_; |
|
1170
|
|
|
|
|
|
|
|
|
1171
|
516
|
100
|
66
|
|
|
2795
|
if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) { |
|
|
1548
|
|
|
|
|
4882
|
|
|
1172
|
|
|
|
|
|
|
# with constraint name |
|
1173
|
258
|
|
|
|
|
1696
|
while (my ($name, $constraint) = splice @constraints, 0, 2) { |
|
1174
|
516
|
|
|
|
|
9395
|
$self->add_unique_constraint($name => $constraint); |
|
1175
|
|
|
|
|
|
|
} |
|
1176
|
|
|
|
|
|
|
} |
|
1177
|
|
|
|
|
|
|
else { |
|
1178
|
|
|
|
|
|
|
# no constraint name |
|
1179
|
258
|
|
|
|
|
876
|
foreach my $constraint (@constraints) { |
|
1180
|
516
|
|
|
|
|
9000
|
$self->add_unique_constraint($constraint); |
|
1181
|
|
|
|
|
|
|
} |
|
1182
|
|
|
|
|
|
|
} |
|
1183
|
312
|
|
|
312
|
|
251449
|
} |
|
|
312
|
|
|
|
|
812
|
|
|
|
312
|
|
|
|
|
2456
|
|
|
1184
|
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
=head2 name_unique_constraint |
|
1186
|
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
=over 4 |
|
1188
|
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
=item Arguments: \@colnames |
|
1190
|
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
=item Return Value: Constraint name |
|
1192
|
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
=back |
|
1194
|
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
$source->table('mytable'); |
|
1196
|
|
|
|
|
|
|
$source->name_unique_constraint(['col1', 'col2']); |
|
1197
|
|
|
|
|
|
|
# returns |
|
1198
|
|
|
|
|
|
|
'mytable_col1_col2' |
|
1199
|
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
Return a name for a unique constraint containing the specified |
|
1201
|
|
|
|
|
|
|
columns. The name is created by joining the table name and each column |
|
1202
|
|
|
|
|
|
|
name, using an underscore character. |
|
1203
|
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
For example, a constraint on a table named C containing the columns |
|
1205
|
|
|
|
|
|
|
C and C would result in a constraint name of C. |
|
1206
|
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
This is used by L if you do not specify the |
|
1208
|
|
|
|
|
|
|
optional constraint name. |
|
1209
|
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
=cut |
|
1211
|
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
sub name_unique_constraint { |
|
1213
|
2717
|
|
|
2717
|
1
|
7994
|
my ($self, $cols) = @_; |
|
1214
|
|
|
|
|
|
|
|
|
1215
|
2717
|
|
|
|
|
54407
|
my $name = $self->name; |
|
1216
|
2717
|
100
|
|
|
|
9919
|
$name = $$name if (ref $name eq 'SCALAR'); |
|
1217
|
2717
|
|
|
|
|
7125
|
$name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier |
|
1218
|
|
|
|
|
|
|
|
|
1219
|
2717
|
|
|
|
|
14924
|
return join '_', $name, @$cols; |
|
1220
|
|
|
|
|
|
|
} |
|
1221
|
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
=head2 unique_constraints |
|
1223
|
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
=over 4 |
|
1225
|
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
=item Arguments: none |
|
1227
|
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
=item Return Value: Hash of unique constraint data |
|
1229
|
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
=back |
|
1231
|
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
$source->unique_constraints(); |
|
1233
|
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
Read-only accessor which returns a hash of unique constraints on this |
|
1235
|
|
|
|
|
|
|
source. |
|
1236
|
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
The hash is keyed by constraint name, and contains an arrayref of |
|
1238
|
|
|
|
|
|
|
column names as values. |
|
1239
|
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
=cut |
|
1241
|
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
sub unique_constraints { |
|
1243
|
|
|
|
|
|
|
return %{shift->_unique_constraints||{}}; |
|
1244
|
|
|
|
|
|
|
} |
|
1245
|
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
=head2 unique_constraint_names |
|
1247
|
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
=over 4 |
|
1249
|
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
=item Arguments: none |
|
1251
|
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
=item Return Value: Unique constraint names |
|
1253
|
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
=back |
|
1255
|
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
$source->unique_constraint_names(); |
|
1257
|
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
Returns the list of unique constraint names defined on this source. |
|
1259
|
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
=cut |
|
1261
|
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
sub unique_constraint_names { |
|
1263
|
|
|
|
|
|
|
my ($self) = @_; |
|
1264
|
|
|
|
|
|
|
|
|
1265
|
|
|
|
|
|
|
my %unique_constraints = $self->unique_constraints; |
|
1266
|
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
return keys %unique_constraints; |
|
1268
|
|
|
|
|
|
|
} |
|
1269
|
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
=head2 unique_constraint_columns |
|
1271
|
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
=over 4 |
|
1273
|
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
=item Arguments: $constraintname |
|
1275
|
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
=item Return Value: List of constraint columns |
|
1277
|
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
=back |
|
1279
|
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
$source->unique_constraint_columns('myconstraint'); |
|
1281
|
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
Returns the list of columns that make up the specified unique constraint. |
|
1283
|
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
=cut |
|
1285
|
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
sub unique_constraint_columns { |
|
1287
|
|
|
|
|
|
|
my ($self, $constraint_name) = @_; |
|
1288
|
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
my %unique_constraints = $self->unique_constraints; |
|
1290
|
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
$self->throw_exception( |
|
1292
|
|
|
|
|
|
|
"Unknown unique constraint $constraint_name on '" . $self->name . "'" |
|
1293
|
|
|
|
|
|
|
) unless exists $unique_constraints{$constraint_name}; |
|
1294
|
|
|
|
|
|
|
|
|
1295
|
|
|
|
|
|
|
return @{ $unique_constraints{$constraint_name} }; |
|
1296
|
|
|
|
|
|
|
} |
|
1297
|
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
=head2 sqlt_deploy_callback |
|
1299
|
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
=over |
|
1301
|
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
=item Arguments: $callback_name | \&callback_code |
|
1303
|
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
=item Return Value: $callback_name | \&callback_code |
|
1305
|
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
=back |
|
1307
|
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
__PACKAGE__->result_source->sqlt_deploy_callback('mycallbackmethod'); |
|
1309
|
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
or |
|
1311
|
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
__PACKAGE__->result_source->sqlt_deploy_callback(sub { |
|
1313
|
|
|
|
|
|
|
my ($source_instance, $sqlt_table) = @_; |
|
1314
|
|
|
|
|
|
|
... |
|
1315
|
|
|
|
|
|
|
} ); |
|
1316
|
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
An accessor to set a callback to be called during deployment of |
|
1318
|
|
|
|
|
|
|
the schema via L or |
|
1319
|
|
|
|
|
|
|
L. |
|
1320
|
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
The callback can be set as either a code reference or the name of a |
|
1322
|
|
|
|
|
|
|
method in the current result class. |
|
1323
|
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
Defaults to L. |
|
1325
|
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
Your callback will be passed the $source object representing the |
|
1327
|
|
|
|
|
|
|
ResultSource instance being deployed, and the |
|
1328
|
|
|
|
|
|
|
L object being created from it. The |
|
1329
|
|
|
|
|
|
|
callback can be used to manipulate the table object or add your own |
|
1330
|
|
|
|
|
|
|
customised indexes. If you need to manipulate a non-table object, use |
|
1331
|
|
|
|
|
|
|
the L. |
|
1332
|
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
See L
|
|
1334
|
|
|
|
|
|
|
Your SQL> for examples. |
|
1335
|
|
|
|
|
|
|
|
|
1336
|
|
|
|
|
|
|
This sqlt deployment callback can only be used to manipulate |
|
1337
|
|
|
|
|
|
|
SQL::Translator objects as they get turned into SQL. To execute |
|
1338
|
|
|
|
|
|
|
post-deploy statements which SQL::Translator does not currently |
|
1339
|
|
|
|
|
|
|
handle, override L in your Schema class |
|
1340
|
|
|
|
|
|
|
and call L. |
|
1341
|
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
=head2 default_sqlt_deploy_hook |
|
1343
|
|
|
|
|
|
|
|
|
1344
|
|
|
|
|
|
|
This is the default deploy hook implementation which checks if your |
|
1345
|
|
|
|
|
|
|
current Result class has a C method, and if present |
|
1346
|
|
|
|
|
|
|
invokes it B. This is to preserve the |
|
1347
|
|
|
|
|
|
|
semantics of C which was originally designed to expect |
|
1348
|
|
|
|
|
|
|
the Result class name and the |
|
1349
|
|
|
|
|
|
|
L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being |
|
1350
|
|
|
|
|
|
|
deployed. |
|
1351
|
|
|
|
|
|
|
|
|
1352
|
|
|
|
|
|
|
=cut |
|
1353
|
|
|
|
|
|
|
|
|
1354
|
|
|
|
|
|
|
sub default_sqlt_deploy_hook { |
|
1355
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
1356
|
|
|
|
|
|
|
|
|
1357
|
0
|
|
|
|
|
0
|
my $class = $self->result_class; |
|
1358
|
|
|
|
|
|
|
|
|
1359
|
0
|
0
|
0
|
|
|
0
|
if ($class and $class->can('sqlt_deploy_hook')) { |
|
1360
|
0
|
|
|
|
|
0
|
$class->sqlt_deploy_hook(@_); |
|
1361
|
|
|
|
|
|
|
} |
|
1362
|
|
|
|
|
|
|
} |
|
1363
|
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
sub _invoke_sqlt_deploy_hook { |
|
1365
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
|
1366
|
0
|
0
|
|
|
|
0
|
if ( my $hook = $self->sqlt_deploy_callback) { |
|
1367
|
0
|
|
|
|
|
0
|
$self->$hook(@_); |
|
1368
|
|
|
|
|
|
|
} |
|
1369
|
|
|
|
|
|
|
} |
|
1370
|
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
=head2 result_class |
|
1372
|
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
=over 4 |
|
1374
|
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
=item Arguments: $classname |
|
1376
|
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
=item Return Value: $classname |
|
1378
|
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
=back |
|
1380
|
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
use My::Schema::ResultClass::Inflator; |
|
1382
|
|
|
|
|
|
|
... |
|
1383
|
|
|
|
|
|
|
|
|
1384
|
|
|
|
|
|
|
use My::Schema::Artist; |
|
1385
|
|
|
|
|
|
|
... |
|
1386
|
|
|
|
|
|
|
__PACKAGE__->result_class('My::Schema::ResultClass::Inflator'); |
|
1387
|
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
Set the default result class for this source. You can use this to create |
|
1389
|
|
|
|
|
|
|
and use your own result inflator. See L |
|
1390
|
|
|
|
|
|
|
for more details. |
|
1391
|
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
Please note that setting this to something like |
|
1393
|
|
|
|
|
|
|
L will make every result unblessed |
|
1394
|
|
|
|
|
|
|
and make life more difficult. Inflators like those are better suited to |
|
1395
|
|
|
|
|
|
|
temporary usage via L. |
|
1396
|
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
=head2 resultset |
|
1398
|
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
=over 4 |
|
1400
|
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
=item Arguments: none |
|
1402
|
|
|
|
|
|
|
|
|
1403
|
|
|
|
|
|
|
=item Return Value: L<$resultset|DBIx::Class::ResultSet> |
|
1404
|
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
=back |
|
1406
|
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
Returns a resultset for the given source. This will initially be created |
|
1408
|
|
|
|
|
|
|
on demand by calling |
|
1409
|
|
|
|
|
|
|
|
|
1410
|
|
|
|
|
|
|
$self->resultset_class->new($self, $self->resultset_attributes) |
|
1411
|
|
|
|
|
|
|
|
|
1412
|
|
|
|
|
|
|
but is cached from then on unless resultset_class changes. |
|
1413
|
|
|
|
|
|
|
|
|
1414
|
|
|
|
|
|
|
=head2 resultset_class |
|
1415
|
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
=over 4 |
|
1417
|
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
=item Arguments: $classname |
|
1419
|
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
=item Return Value: $classname |
|
1421
|
|
|
|
|
|
|
|
|
1422
|
|
|
|
|
|
|
=back |
|
1423
|
|
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
package My::Schema::ResultSet::Artist; |
|
1425
|
|
|
|
|
|
|
use base 'DBIx::Class::ResultSet'; |
|
1426
|
|
|
|
|
|
|
... |
|
1427
|
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
# In the result class |
|
1429
|
|
|
|
|
|
|
__PACKAGE__->resultset_class('My::Schema::ResultSet::Artist'); |
|
1430
|
|
|
|
|
|
|
|
|
1431
|
|
|
|
|
|
|
# Or in code |
|
1432
|
|
|
|
|
|
|
$source->resultset_class('My::Schema::ResultSet::Artist'); |
|
1433
|
|
|
|
|
|
|
|
|
1434
|
|
|
|
|
|
|
Set the class of the resultset. This is useful if you want to create your |
|
1435
|
|
|
|
|
|
|
own resultset methods. Create your own class derived from |
|
1436
|
|
|
|
|
|
|
L, and set it here. If called with no arguments, |
|
1437
|
|
|
|
|
|
|
this method returns the name of the existing resultset class, if one |
|
1438
|
|
|
|
|
|
|
exists. |
|
1439
|
|
|
|
|
|
|
|
|
1440
|
|
|
|
|
|
|
=head2 resultset_attributes |
|
1441
|
|
|
|
|
|
|
|
|
1442
|
|
|
|
|
|
|
=over 4 |
|
1443
|
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
=item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES> |
|
1445
|
|
|
|
|
|
|
|
|
1446
|
|
|
|
|
|
|
=item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES> |
|
1447
|
|
|
|
|
|
|
|
|
1448
|
|
|
|
|
|
|
=back |
|
1449
|
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
# In the result class |
|
1451
|
|
|
|
|
|
|
__PACKAGE__->resultset_attributes({ order_by => [ 'id' ] }); |
|
1452
|
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
# Or in code |
|
1454
|
|
|
|
|
|
|
$source->resultset_attributes({ order_by => [ 'id' ] }); |
|
1455
|
|
|
|
|
|
|
|
|
1456
|
|
|
|
|
|
|
Store a collection of resultset attributes, that will be set on every |
|
1457
|
|
|
|
|
|
|
L produced from this result source. |
|
1458
|
|
|
|
|
|
|
|
|
1459
|
|
|
|
|
|
|
B: C comes with its own set of issues and |
|
1460
|
|
|
|
|
|
|
bugs! Notably the contents of the attributes are B, which |
|
1461
|
|
|
|
|
|
|
greatly hinders composability (things like L
|
|
1462
|
|
|
|
|
|
|
|DBIx::Class::ResultSet/current_source_alias> can not possibly be respected). |
|
1463
|
|
|
|
|
|
|
While C isn't deprecated per se, you are strongly urged |
|
1464
|
|
|
|
|
|
|
to seek alternatives. |
|
1465
|
|
|
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
Since relationships use attributes to link tables together, the "default" |
|
1467
|
|
|
|
|
|
|
attributes you set may cause unpredictable and undesired behavior. Furthermore, |
|
1468
|
|
|
|
|
|
|
the defaults B, so you are stuck with them. |
|
1469
|
|
|
|
|
|
|
|
|
1470
|
|
|
|
|
|
|
In most cases, what you should actually be using are project-specific methods: |
|
1471
|
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
package My::Schema::ResultSet::Artist; |
|
1473
|
|
|
|
|
|
|
use base 'DBIx::Class::ResultSet'; |
|
1474
|
|
|
|
|
|
|
... |
|
1475
|
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
# BAD IDEA! |
|
1477
|
|
|
|
|
|
|
#__PACKAGE__->resultset_attributes({ prefetch => 'tracks' }); |
|
1478
|
|
|
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
# GOOD IDEA! |
|
1480
|
|
|
|
|
|
|
sub with_tracks { shift->search({}, { prefetch => 'tracks' }) } |
|
1481
|
|
|
|
|
|
|
|
|
1482
|
|
|
|
|
|
|
# in your code |
|
1483
|
|
|
|
|
|
|
$schema->resultset('Artist')->with_tracks->... |
|
1484
|
|
|
|
|
|
|
|
|
1485
|
|
|
|
|
|
|
This gives you the flexibility of not using it when you don't need it. |
|
1486
|
|
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
|
For more complex situations, another solution would be to use a virtual view |
|
1488
|
|
|
|
|
|
|
via L. |
|
1489
|
|
|
|
|
|
|
|
|
1490
|
|
|
|
|
|
|
=cut |
|
1491
|
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
sub resultset { |
|
1493
|
14222
|
|
|
14222
|
1
|
69311
|
my $self = shift; |
|
1494
|
14222
|
50
|
|
|
|
44429
|
$self->throw_exception( |
|
1495
|
|
|
|
|
|
|
'resultset does not take any arguments. If you want another resultset, '. |
|
1496
|
|
|
|
|
|
|
'call it on the schema instead.' |
|
1497
|
|
|
|
|
|
|
) if scalar @_; |
|
1498
|
|
|
|
|
|
|
|
|
1499
|
|
|
|
|
|
|
$self->resultset_class->new( |
|
1500
|
|
|
|
|
|
|
$self, |
|
1501
|
|
|
|
|
|
|
{ |
|
1502
|
14222
|
|
|
14222
|
|
28673
|
( dbic_internal_try { %{$self->schema->default_resultset_attributes} } ), |
|
|
14222
|
|
|
|
|
43471
|
|
|
1503
|
14222
|
|
|
|
|
286084
|
%{$self->{resultset_attributes}}, |
|
|
14222
|
|
|
|
|
95916
|
|
|
1504
|
|
|
|
|
|
|
}, |
|
1505
|
|
|
|
|
|
|
); |
|
1506
|
|
|
|
|
|
|
} |
|
1507
|
|
|
|
|
|
|
|
|
1508
|
|
|
|
|
|
|
=head2 name |
|
1509
|
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
=over 4 |
|
1511
|
|
|
|
|
|
|
|
|
1512
|
|
|
|
|
|
|
=item Arguments: none |
|
1513
|
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
=item Result value: $name |
|
1515
|
|
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
|
=back |
|
1517
|
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
Returns the name of the result source, which will typically be the table |
|
1519
|
|
|
|
|
|
|
name. This may be a scalar reference if the result source has a non-standard |
|
1520
|
|
|
|
|
|
|
name. |
|
1521
|
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
=head2 source_name |
|
1523
|
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
=over 4 |
|
1525
|
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
=item Arguments: $source_name |
|
1527
|
|
|
|
|
|
|
|
|
1528
|
|
|
|
|
|
|
=item Result value: $source_name |
|
1529
|
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
=back |
|
1531
|
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
Set an alternate name for the result source when it is loaded into a schema. |
|
1533
|
|
|
|
|
|
|
This is useful if you want to refer to a result source by a name other than |
|
1534
|
|
|
|
|
|
|
its class name. |
|
1535
|
|
|
|
|
|
|
|
|
1536
|
|
|
|
|
|
|
package ArchivedBooks; |
|
1537
|
|
|
|
|
|
|
use base qw/DBIx::Class/; |
|
1538
|
|
|
|
|
|
|
__PACKAGE__->table('books_archive'); |
|
1539
|
|
|
|
|
|
|
__PACKAGE__->source_name('Books'); |
|
1540
|
|
|
|
|
|
|
|
|
1541
|
|
|
|
|
|
|
# from your schema... |
|
1542
|
|
|
|
|
|
|
$schema->resultset('Books')->find(1); |
|
1543
|
|
|
|
|
|
|
|
|
1544
|
|
|
|
|
|
|
=head2 from |
|
1545
|
|
|
|
|
|
|
|
|
1546
|
|
|
|
|
|
|
=over 4 |
|
1547
|
|
|
|
|
|
|
|
|
1548
|
|
|
|
|
|
|
=item Arguments: none |
|
1549
|
|
|
|
|
|
|
|
|
1550
|
|
|
|
|
|
|
=item Return Value: FROM clause |
|
1551
|
|
|
|
|
|
|
|
|
1552
|
|
|
|
|
|
|
=back |
|
1553
|
|
|
|
|
|
|
|
|
1554
|
|
|
|
|
|
|
my $from_clause = $source->from(); |
|
1555
|
|
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
Returns an expression of the source to be supplied to storage to specify |
|
1557
|
|
|
|
|
|
|
retrieval from this source. In the case of a database, the required FROM |
|
1558
|
|
|
|
|
|
|
clause contents. |
|
1559
|
|
|
|
|
|
|
|
|
1560
|
|
|
|
|
|
|
=cut |
|
1561
|
|
|
|
|
|
|
|
|
1562
|
0
|
|
|
0
|
1
|
0
|
sub from { die 'Virtual method!' } |
|
1563
|
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
=head2 source_info |
|
1565
|
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
Stores a hashref of per-source metadata. No specific key names |
|
1567
|
|
|
|
|
|
|
have yet been standardized, the examples below are purely hypothetical |
|
1568
|
|
|
|
|
|
|
and don't actually accomplish anything on their own: |
|
1569
|
|
|
|
|
|
|
|
|
1570
|
|
|
|
|
|
|
__PACKAGE__->source_info({ |
|
1571
|
|
|
|
|
|
|
"_tablespace" => 'fast_disk_array_3', |
|
1572
|
|
|
|
|
|
|
"_engine" => 'InnoDB', |
|
1573
|
|
|
|
|
|
|
}); |
|
1574
|
|
|
|
|
|
|
|
|
1575
|
|
|
|
|
|
|
=head2 schema |
|
1576
|
|
|
|
|
|
|
|
|
1577
|
|
|
|
|
|
|
=over 4 |
|
1578
|
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
=item Arguments: L<$schema?|DBIx::Class::Schema> |
|
1580
|
|
|
|
|
|
|
|
|
1581
|
|
|
|
|
|
|
=item Return Value: L<$schema|DBIx::Class::Schema> |
|
1582
|
|
|
|
|
|
|
|
|
1583
|
|
|
|
|
|
|
=back |
|
1584
|
|
|
|
|
|
|
|
|
1585
|
|
|
|
|
|
|
my $schema = $source->schema(); |
|
1586
|
|
|
|
|
|
|
|
|
1587
|
|
|
|
|
|
|
Sets and/or returns the L object to which this |
|
1588
|
|
|
|
|
|
|
result source instance has been attached to. |
|
1589
|
|
|
|
|
|
|
|
|
1590
|
|
|
|
|
|
|
=cut |
|
1591
|
|
|
|
|
|
|
|
|
1592
|
|
|
|
|
|
|
sub schema { |
|
1593
|
118706
|
100
|
|
118706
|
1
|
356841
|
if (@_ > 1) { |
|
1594
|
|
|
|
|
|
|
# invoke the mark-diverging logic |
|
1595
|
51524
|
|
|
|
|
135487
|
$_[0]->set_rsrc_instance_specific_attribute( schema => $_[1] ); |
|
1596
|
|
|
|
|
|
|
} |
|
1597
|
|
|
|
|
|
|
else { |
|
1598
|
67182
|
100
|
|
|
|
165988
|
$_[0]->get_rsrc_instance_specific_attribute( 'schema' ) || do { |
|
1599
|
92
|
|
100
|
|
|
292
|
my $name = $_[0]->{source_name} || '_unnamed_'; |
|
1600
|
92
|
|
|
|
|
232
|
my $err = 'Unable to perform storage-dependent operations with a detached result source ' |
|
1601
|
|
|
|
|
|
|
. "(source '$name' is not associated with a schema)."; |
|
1602
|
|
|
|
|
|
|
|
|
1603
|
|
|
|
|
|
|
$err .= ' You need to use $schema->thaw() or manually set' |
|
1604
|
|
|
|
|
|
|
. ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.' |
|
1605
|
92
|
100
|
|
|
|
215
|
if $_[0]->{_detached_thaw}; |
|
1606
|
|
|
|
|
|
|
|
|
1607
|
92
|
|
|
|
|
315
|
DBIx::Class::Exception->throw($err); |
|
1608
|
|
|
|
|
|
|
}; |
|
1609
|
|
|
|
|
|
|
} |
|
1610
|
|
|
|
|
|
|
} |
|
1611
|
|
|
|
|
|
|
|
|
1612
|
|
|
|
|
|
|
=head2 storage |
|
1613
|
|
|
|
|
|
|
|
|
1614
|
|
|
|
|
|
|
=over 4 |
|
1615
|
|
|
|
|
|
|
|
|
1616
|
|
|
|
|
|
|
=item Arguments: none |
|
1617
|
|
|
|
|
|
|
|
|
1618
|
|
|
|
|
|
|
=item Return Value: L<$storage|DBIx::Class::Storage> |
|
1619
|
|
|
|
|
|
|
|
|
1620
|
|
|
|
|
|
|
=back |
|
1621
|
|
|
|
|
|
|
|
|
1622
|
|
|
|
|
|
|
$source->storage->debug(1); |
|
1623
|
|
|
|
|
|
|
|
|
1624
|
|
|
|
|
|
|
Returns the L for the current schema. |
|
1625
|
|
|
|
|
|
|
|
|
1626
|
|
|
|
|
|
|
=cut |
|
1627
|
|
|
|
|
|
|
|
|
1628
|
|
|
|
|
|
|
sub storage :DBIC_method_is_indirect_sugar { |
|
1629
|
0
|
|
|
0
|
1
|
0
|
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; |
|
1630
|
0
|
|
|
|
|
0
|
$_[0]->schema->storage |
|
1631
|
312
|
|
|
312
|
|
252277
|
} |
|
|
312
|
|
|
|
|
3467
|
|
|
|
312
|
|
|
|
|
121151
|
|
|
1632
|
|
|
|
|
|
|
|
|
1633
|
|
|
|
|
|
|
=head2 add_relationship |
|
1634
|
|
|
|
|
|
|
|
|
1635
|
|
|
|
|
|
|
=over 4 |
|
1636
|
|
|
|
|
|
|
|
|
1637
|
|
|
|
|
|
|
=item Arguments: $rel_name, $related_source_name, \%cond, \%attrs? |
|
1638
|
|
|
|
|
|
|
|
|
1639
|
|
|
|
|
|
|
=item Return Value: 1/true if it succeeded |
|
1640
|
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
=back |
|
1642
|
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
$source->add_relationship('rel_name', 'related_source', $cond, $attrs); |
|
1644
|
|
|
|
|
|
|
|
|
1645
|
|
|
|
|
|
|
L describes a series of methods which |
|
1646
|
|
|
|
|
|
|
create pre-defined useful types of relationships. Look there first |
|
1647
|
|
|
|
|
|
|
before using this method directly. |
|
1648
|
|
|
|
|
|
|
|
|
1649
|
|
|
|
|
|
|
The relationship name can be arbitrary, but must be unique for each |
|
1650
|
|
|
|
|
|
|
relationship attached to this result source. 'related_source' should |
|
1651
|
|
|
|
|
|
|
be the name with which the related result source was registered with |
|
1652
|
|
|
|
|
|
|
the current schema. For example: |
|
1653
|
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
$schema->source('Book')->add_relationship('reviews', 'Review', { |
|
1655
|
|
|
|
|
|
|
'foreign.book_id' => 'self.id', |
|
1656
|
|
|
|
|
|
|
}); |
|
1657
|
|
|
|
|
|
|
|
|
1658
|
|
|
|
|
|
|
The condition C<$cond> needs to be an L-style |
|
1659
|
|
|
|
|
|
|
representation of the join between the tables. For example, if you're |
|
1660
|
|
|
|
|
|
|
creating a relation from Author to Book, |
|
1661
|
|
|
|
|
|
|
|
|
1662
|
|
|
|
|
|
|
{ 'foreign.author_id' => 'self.id' } |
|
1663
|
|
|
|
|
|
|
|
|
1664
|
|
|
|
|
|
|
will result in the JOIN clause |
|
1665
|
|
|
|
|
|
|
|
|
1666
|
|
|
|
|
|
|
author me JOIN book foreign ON foreign.author_id = me.id |
|
1667
|
|
|
|
|
|
|
|
|
1668
|
|
|
|
|
|
|
You can specify as many foreign => self mappings as necessary. |
|
1669
|
|
|
|
|
|
|
|
|
1670
|
|
|
|
|
|
|
Valid attributes are as follows: |
|
1671
|
|
|
|
|
|
|
|
|
1672
|
|
|
|
|
|
|
=over 4 |
|
1673
|
|
|
|
|
|
|
|
|
1674
|
|
|
|
|
|
|
=item join_type |
|
1675
|
|
|
|
|
|
|
|
|
1676
|
|
|
|
|
|
|
Explicitly specifies the type of join to use in the relationship. Any |
|
1677
|
|
|
|
|
|
|
SQL join type is valid, e.g. C or C. It will be placed in |
|
1678
|
|
|
|
|
|
|
the SQL command immediately before C. |
|
1679
|
|
|
|
|
|
|
|
|
1680
|
|
|
|
|
|
|
=item proxy |
|
1681
|
|
|
|
|
|
|
|
|
1682
|
|
|
|
|
|
|
An arrayref containing a list of accessors in the foreign class to proxy in |
|
1683
|
|
|
|
|
|
|
the main class. If, for example, you do the following: |
|
1684
|
|
|
|
|
|
|
|
|
1685
|
|
|
|
|
|
|
CD->might_have(liner_notes => 'LinerNotes', undef, { |
|
1686
|
|
|
|
|
|
|
proxy => [ qw/notes/ ], |
|
1687
|
|
|
|
|
|
|
}); |
|
1688
|
|
|
|
|
|
|
|
|
1689
|
|
|
|
|
|
|
Then, assuming LinerNotes has an accessor named notes, you can do: |
|
1690
|
|
|
|
|
|
|
|
|
1691
|
|
|
|
|
|
|
my $cd = CD->find(1); |
|
1692
|
|
|
|
|
|
|
# set notes -- LinerNotes object is created if it doesn't exist |
|
1693
|
|
|
|
|
|
|
$cd->notes('Notes go here'); |
|
1694
|
|
|
|
|
|
|
|
|
1695
|
|
|
|
|
|
|
=item accessor |
|
1696
|
|
|
|
|
|
|
|
|
1697
|
|
|
|
|
|
|
Specifies the type of accessor that should be created for the |
|
1698
|
|
|
|
|
|
|
relationship. Valid values are C (for when there is only a single |
|
1699
|
|
|
|
|
|
|
related object), C (when there can be many), and C (for |
|
1700
|
|
|
|
|
|
|
when there is a single related object, but you also want the relationship |
|
1701
|
|
|
|
|
|
|
accessor to double as a column accessor). For C accessors, an |
|
1702
|
|
|
|
|
|
|
add_to_* method is also created, which calls C for the |
|
1703
|
|
|
|
|
|
|
relationship. |
|
1704
|
|
|
|
|
|
|
|
|
1705
|
|
|
|
|
|
|
=back |
|
1706
|
|
|
|
|
|
|
|
|
1707
|
|
|
|
|
|
|
Throws an exception if the condition is improperly supplied, or cannot |
|
1708
|
|
|
|
|
|
|
be resolved. |
|
1709
|
|
|
|
|
|
|
|
|
1710
|
|
|
|
|
|
|
=cut |
|
1711
|
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
sub add_relationship { |
|
1713
|
|
|
|
|
|
|
my ($self, $rel, $f_source_name, $cond, $attrs) = @_; |
|
1714
|
|
|
|
|
|
|
|
|
1715
|
|
|
|
|
|
|
local $self->{__in_rsrc_setter_callstack} = 1 |
|
1716
|
|
|
|
|
|
|
unless $self->{__in_rsrc_setter_callstack}; |
|
1717
|
|
|
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
$self->throw_exception("Can't create relationship without join condition") |
|
1719
|
|
|
|
|
|
|
unless $cond; |
|
1720
|
|
|
|
|
|
|
$attrs ||= {}; |
|
1721
|
|
|
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
# Check foreign and self are right in cond |
|
1723
|
|
|
|
|
|
|
if ( (ref $cond ||'') eq 'HASH') { |
|
1724
|
|
|
|
|
|
|
$_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'") |
|
1725
|
|
|
|
|
|
|
for keys %$cond; |
|
1726
|
|
|
|
|
|
|
|
|
1727
|
|
|
|
|
|
|
$_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'") |
|
1728
|
|
|
|
|
|
|
for values %$cond; |
|
1729
|
|
|
|
|
|
|
} |
|
1730
|
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
my %rels = %{ $self->_relationships }; |
|
1732
|
|
|
|
|
|
|
$rels{$rel} = { class => $f_source_name, |
|
1733
|
|
|
|
|
|
|
source => $f_source_name, |
|
1734
|
|
|
|
|
|
|
cond => $cond, |
|
1735
|
|
|
|
|
|
|
attrs => $attrs }; |
|
1736
|
|
|
|
|
|
|
$self->_relationships(\%rels); |
|
1737
|
|
|
|
|
|
|
|
|
1738
|
|
|
|
|
|
|
return $self; |
|
1739
|
|
|
|
|
|
|
} |
|
1740
|
|
|
|
|
|
|
|
|
1741
|
|
|
|
|
|
|
=head2 relationships |
|
1742
|
|
|
|
|
|
|
|
|
1743
|
|
|
|
|
|
|
=over 4 |
|
1744
|
|
|
|
|
|
|
|
|
1745
|
|
|
|
|
|
|
=item Arguments: none |
|
1746
|
|
|
|
|
|
|
|
|
1747
|
|
|
|
|
|
|
=item Return Value: L<@rel_names|DBIx::Class::Relationship> |
|
1748
|
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
=back |
|
1750
|
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
my @rel_names = $source->relationships(); |
|
1752
|
|
|
|
|
|
|
|
|
1753
|
|
|
|
|
|
|
Returns all relationship names for this source. |
|
1754
|
|
|
|
|
|
|
|
|
1755
|
|
|
|
|
|
|
=cut |
|
1756
|
|
|
|
|
|
|
|
|
1757
|
|
|
|
|
|
|
sub relationships { |
|
1758
|
|
|
|
|
|
|
keys %{$_[0]->_relationships}; |
|
1759
|
|
|
|
|
|
|
} |
|
1760
|
|
|
|
|
|
|
|
|
1761
|
|
|
|
|
|
|
=head2 relationship_info |
|
1762
|
|
|
|
|
|
|
|
|
1763
|
|
|
|
|
|
|
=over 4 |
|
1764
|
|
|
|
|
|
|
|
|
1765
|
|
|
|
|
|
|
=item Arguments: L<$rel_name|DBIx::Class::Relationship> |
|
1766
|
|
|
|
|
|
|
|
|
1767
|
|
|
|
|
|
|
=item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship> |
|
1768
|
|
|
|
|
|
|
|
|
1769
|
|
|
|
|
|
|
=back |
|
1770
|
|
|
|
|
|
|
|
|
1771
|
|
|
|
|
|
|
Returns a hash of relationship information for the specified relationship |
|
1772
|
|
|
|
|
|
|
name. The keys/values are as specified for L. |
|
1773
|
|
|
|
|
|
|
|
|
1774
|
|
|
|
|
|
|
=cut |
|
1775
|
|
|
|
|
|
|
|
|
1776
|
|
|
|
|
|
|
sub relationship_info { |
|
1777
|
|
|
|
|
|
|
#my ($self, $rel) = @_; |
|
1778
|
|
|
|
|
|
|
return shift->_relationships->{+shift}; |
|
1779
|
|
|
|
|
|
|
} |
|
1780
|
|
|
|
|
|
|
|
|
1781
|
|
|
|
|
|
|
=head2 has_relationship |
|
1782
|
|
|
|
|
|
|
|
|
1783
|
|
|
|
|
|
|
=over 4 |
|
1784
|
|
|
|
|
|
|
|
|
1785
|
|
|
|
|
|
|
=item Arguments: L<$rel_name|DBIx::Class::Relationship> |
|
1786
|
|
|
|
|
|
|
|
|
1787
|
|
|
|
|
|
|
=item Return Value: 1/0 (true/false) |
|
1788
|
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
=back |
|
1790
|
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
Returns true if the source has a relationship of this name, false otherwise. |
|
1792
|
|
|
|
|
|
|
|
|
1793
|
|
|
|
|
|
|
=cut |
|
1794
|
|
|
|
|
|
|
|
|
1795
|
|
|
|
|
|
|
sub has_relationship { |
|
1796
|
|
|
|
|
|
|
#my ($self, $rel) = @_; |
|
1797
|
|
|
|
|
|
|
return exists shift->_relationships->{+shift}; |
|
1798
|
|
|
|
|
|
|
} |
|
1799
|
|
|
|
|
|
|
|
|
1800
|
|
|
|
|
|
|
=head2 reverse_relationship_info |
|
1801
|
|
|
|
|
|
|
|
|
1802
|
|
|
|
|
|
|
=over 4 |
|
1803
|
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
=item Arguments: L<$rel_name|DBIx::Class::Relationship> |
|
1805
|
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
=item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship> |
|
1807
|
|
|
|
|
|
|
|
|
1808
|
|
|
|
|
|
|
=back |
|
1809
|
|
|
|
|
|
|
|
|
1810
|
|
|
|
|
|
|
Looks through all the relationships on the source this relationship |
|
1811
|
|
|
|
|
|
|
points to, looking for one whose condition is the reverse of the |
|
1812
|
|
|
|
|
|
|
condition on this relationship. |
|
1813
|
|
|
|
|
|
|
|
|
1814
|
|
|
|
|
|
|
A common use of this is to find the name of the C relation |
|
1815
|
|
|
|
|
|
|
opposing a C relation. For definition of these look in |
|
1816
|
|
|
|
|
|
|
L. |
|
1817
|
|
|
|
|
|
|
|
|
1818
|
|
|
|
|
|
|
The returned hashref is keyed by the name of the opposing |
|
1819
|
|
|
|
|
|
|
relationship, and contains its data in the same manner as |
|
1820
|
|
|
|
|
|
|
L. |
|
1821
|
|
|
|
|
|
|
|
|
1822
|
|
|
|
|
|
|
=cut |
|
1823
|
|
|
|
|
|
|
|
|
1824
|
|
|
|
|
|
|
sub reverse_relationship_info { |
|
1825
|
990
|
|
|
990
|
1
|
3637
|
my ($self, $rel) = @_; |
|
1826
|
|
|
|
|
|
|
|
|
1827
|
|
|
|
|
|
|
# This may be a partial schema or something else equally esoteric |
|
1828
|
|
|
|
|
|
|
# in which case this will throw |
|
1829
|
|
|
|
|
|
|
# |
|
1830
|
990
|
|
|
|
|
3338
|
my $other_rsrc = $self->related_source($rel); |
|
1831
|
|
|
|
|
|
|
|
|
1832
|
|
|
|
|
|
|
# Some custom rels may not resolve without a $schema |
|
1833
|
|
|
|
|
|
|
# |
|
1834
|
|
|
|
|
|
|
my $our_resolved_relcond = dbic_internal_try { |
|
1835
|
990
|
|
|
990
|
|
4629
|
$self->resolve_relationship_condition( |
|
1836
|
|
|
|
|
|
|
rel_name => $rel, |
|
1837
|
|
|
|
|
|
|
|
|
1838
|
|
|
|
|
|
|
# an API where these are optional would be too cumbersome, |
|
1839
|
|
|
|
|
|
|
# instead always pass in some dummy values |
|
1840
|
|
|
|
|
|
|
DUMMY_ALIASPAIR, |
|
1841
|
|
|
|
|
|
|
) |
|
1842
|
990
|
|
|
|
|
8901
|
}; |
|
1843
|
|
|
|
|
|
|
|
|
1844
|
|
|
|
|
|
|
# only straight-equality is compared |
|
1845
|
|
|
|
|
|
|
return {} |
|
1846
|
990
|
100
|
|
|
|
5616
|
unless $our_resolved_relcond->{identity_map_matches_condition}; |
|
1847
|
|
|
|
|
|
|
|
|
1848
|
989
|
|
|
|
|
25208
|
my( $our_registered_source_name, $our_result_class) = |
|
1849
|
|
|
|
|
|
|
( $self->source_name, $self->result_class ); |
|
1850
|
|
|
|
|
|
|
|
|
1851
|
989
|
|
|
|
|
2943
|
my $ret = {}; |
|
1852
|
|
|
|
|
|
|
|
|
1853
|
|
|
|
|
|
|
# Get all the relationships for that source that related to this source |
|
1854
|
|
|
|
|
|
|
# whose foreign column set are our self columns on $rel and whose self |
|
1855
|
|
|
|
|
|
|
# columns are our foreign columns on $rel |
|
1856
|
989
|
|
|
|
|
19730
|
foreach my $other_rel ($other_rsrc->relationships) { |
|
1857
|
|
|
|
|
|
|
|
|
1858
|
|
|
|
|
|
|
# this will happen when we have a self-referential class |
|
1859
|
|
|
|
|
|
|
next if ( |
|
1860
|
8894
|
100
|
66
|
|
|
41363
|
$other_rel eq $rel |
|
1861
|
|
|
|
|
|
|
and |
|
1862
|
|
|
|
|
|
|
$self == $other_rsrc |
|
1863
|
|
|
|
|
|
|
); |
|
1864
|
|
|
|
|
|
|
|
|
1865
|
|
|
|
|
|
|
# only consider stuff that points back to us |
|
1866
|
|
|
|
|
|
|
# "us" here is tricky - if we are in a schema registration, we want |
|
1867
|
|
|
|
|
|
|
# to use the source_names, otherwise we will use the actual classes |
|
1868
|
|
|
|
|
|
|
|
|
1869
|
8887
|
|
|
|
|
13712
|
my $roundtripped_rsrc; |
|
1870
|
|
|
|
|
|
|
next unless ( |
|
1871
|
|
|
|
|
|
|
|
|
1872
|
|
|
|
|
|
|
# the schema may be partially loaded |
|
1873
|
8887
|
|
|
8887
|
|
24854
|
$roundtripped_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) } |
|
1874
|
|
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
|
and |
|
1876
|
|
|
|
|
|
|
|
|
1877
|
|
|
|
|
|
|
( |
|
1878
|
|
|
|
|
|
|
|
|
1879
|
|
|
|
|
|
|
( |
|
1880
|
|
|
|
|
|
|
$our_registered_source_name |
|
1881
|
|
|
|
|
|
|
and |
|
1882
|
|
|
|
|
|
|
( |
|
1883
|
|
|
|
|
|
|
$our_registered_source_name |
|
1884
|
|
|
|
|
|
|
eq |
|
1885
|
|
|
|
|
|
|
$roundtripped_rsrc->source_name||'' |
|
1886
|
|
|
|
|
|
|
) |
|
1887
|
|
|
|
|
|
|
) |
|
1888
|
|
|
|
|
|
|
|
|
1889
|
|
|
|
|
|
|
or |
|
1890
|
|
|
|
|
|
|
|
|
1891
|
|
|
|
|
|
|
( |
|
1892
|
|
|
|
|
|
|
$our_result_class |
|
1893
|
|
|
|
|
|
|
eq |
|
1894
|
|
|
|
|
|
|
$roundtripped_rsrc->result_class |
|
1895
|
|
|
|
|
|
|
) |
|
1896
|
|
|
|
|
|
|
) |
|
1897
|
|
|
|
|
|
|
|
|
1898
|
|
|
|
|
|
|
and |
|
1899
|
|
|
|
|
|
|
|
|
1900
|
|
|
|
|
|
|
my $their_resolved_relcond = dbic_internal_try { |
|
1901
|
3155
|
|
|
3155
|
|
12431
|
$other_rsrc->resolve_relationship_condition( |
|
1902
|
|
|
|
|
|
|
rel_name => $other_rel, |
|
1903
|
|
|
|
|
|
|
|
|
1904
|
|
|
|
|
|
|
# an API where these are optional would be too cumbersome, |
|
1905
|
|
|
|
|
|
|
# instead always pass in some dummy values |
|
1906
|
|
|
|
|
|
|
DUMMY_ALIASPAIR, |
|
1907
|
|
|
|
|
|
|
) |
|
1908
|
|
|
|
|
|
|
} |
|
1909
|
8887
|
100
|
100
|
|
|
46085
|
); |
|
|
|
|
66
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
1910
|
|
|
|
|
|
|
|
|
1911
|
|
|
|
|
|
|
|
|
1912
|
|
|
|
|
|
|
$ret->{$other_rel} = $other_rsrc->relationship_info($other_rel) if ( |
|
1913
|
|
|
|
|
|
|
|
|
1914
|
|
|
|
|
|
|
$their_resolved_relcond->{identity_map_matches_condition} |
|
1915
|
|
|
|
|
|
|
|
|
1916
|
|
|
|
|
|
|
and |
|
1917
|
|
|
|
|
|
|
|
|
1918
|
2597
|
|
|
|
|
7977
|
keys %{ $our_resolved_relcond->{identity_map} } |
|
1919
|
|
|
|
|
|
|
== |
|
1920
|
2597
|
|
|
|
|
17090
|
keys %{ $their_resolved_relcond->{identity_map} } |
|
1921
|
|
|
|
|
|
|
|
|
1922
|
|
|
|
|
|
|
and |
|
1923
|
|
|
|
|
|
|
|
|
1924
|
|
|
|
|
|
|
serialize( $our_resolved_relcond->{identity_map} ) |
|
1925
|
|
|
|
|
|
|
eq |
|
1926
|
3155
|
100
|
66
|
|
|
22428
|
serialize( { reverse %{ $their_resolved_relcond->{identity_map} } } ) |
|
|
2597
|
|
100
|
|
|
146032
|
|
|
1927
|
|
|
|
|
|
|
|
|
1928
|
|
|
|
|
|
|
); |
|
1929
|
|
|
|
|
|
|
} |
|
1930
|
|
|
|
|
|
|
|
|
1931
|
989
|
|
|
|
|
12259
|
return $ret; |
|
1932
|
|
|
|
|
|
|
} |
|
1933
|
|
|
|
|
|
|
|
|
1934
|
|
|
|
|
|
|
# optionally takes either an arrayref of column names, or a hashref of already |
|
1935
|
|
|
|
|
|
|
# retrieved colinfos |
|
1936
|
|
|
|
|
|
|
# returns an arrayref of column names of the shortest unique constraint |
|
1937
|
|
|
|
|
|
|
# (matching some of the input if any), giving preference to the PK |
|
1938
|
|
|
|
|
|
|
sub _identifying_column_set { |
|
1939
|
712
|
|
|
712
|
|
2189
|
my ($self, $cols) = @_; |
|
1940
|
|
|
|
|
|
|
|
|
1941
|
712
|
|
|
|
|
16190
|
my %unique = $self->unique_constraints; |
|
1942
|
712
|
100
|
66
|
|
|
5799
|
my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||()); |
|
1943
|
|
|
|
|
|
|
|
|
1944
|
|
|
|
|
|
|
# always prefer the PK first, and then shortest constraints first |
|
1945
|
|
|
|
|
|
|
USET: |
|
1946
|
712
|
|
|
|
|
3798
|
for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) { |
|
|
403
|
|
|
|
|
1409
|
|
|
1947
|
901
|
50
|
33
|
|
|
4335
|
next unless $set && @$set; |
|
1948
|
|
|
|
|
|
|
|
|
1949
|
901
|
|
|
|
|
2492
|
for (@$set) { |
|
1950
|
1116
|
100
|
100
|
|
|
5811
|
next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} ); |
|
1951
|
|
|
|
|
|
|
} |
|
1952
|
|
|
|
|
|
|
|
|
1953
|
|
|
|
|
|
|
# copy so we can mangle it at will |
|
1954
|
671
|
|
|
|
|
5701
|
return [ @$set ]; |
|
1955
|
|
|
|
|
|
|
} |
|
1956
|
|
|
|
|
|
|
|
|
1957
|
41
|
|
|
|
|
251
|
return undef; |
|
1958
|
|
|
|
|
|
|
} |
|
1959
|
|
|
|
|
|
|
|
|
1960
|
|
|
|
|
|
|
sub _minimal_valueset_satisfying_constraint { |
|
1961
|
3231
|
|
|
3231
|
|
7908
|
my $self = shift; |
|
1962
|
3231
|
50
|
|
|
|
18156
|
my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ }; |
|
|
0
|
|
|
|
|
0
|
|
|
1963
|
|
|
|
|
|
|
|
|
1964
|
3231
|
|
66
|
|
|
18419
|
$args->{columns_info} ||= $self->columns_info; |
|
1965
|
|
|
|
|
|
|
|
|
1966
|
|
|
|
|
|
|
my $vals = extract_equality_conditions( |
|
1967
|
|
|
|
|
|
|
$args->{values}, |
|
1968
|
3231
|
100
|
|
|
|
17047
|
($args->{carp_on_nulls} ? 'consider_nulls' : undef ), |
|
1969
|
|
|
|
|
|
|
); |
|
1970
|
|
|
|
|
|
|
|
|
1971
|
3231
|
|
|
|
|
6234
|
my $cols; |
|
1972
|
3231
|
|
|
|
|
77494
|
for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) { |
|
1973
|
4236
|
100
|
100
|
|
|
22976
|
if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) { |
|
|
|
100
|
100
|
|
|
|
|
|
1974
|
2822
|
|
|
|
|
9350
|
$cols->{missing}{$col} = undef; |
|
1975
|
|
|
|
|
|
|
} |
|
1976
|
|
|
|
|
|
|
elsif( ! defined $vals->{$col} ) { |
|
1977
|
2
|
50
|
|
|
|
13
|
$cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef; |
|
1978
|
|
|
|
|
|
|
} |
|
1979
|
|
|
|
|
|
|
else { |
|
1980
|
|
|
|
|
|
|
# we need to inject back the '=' as extract_equality_conditions() |
|
1981
|
|
|
|
|
|
|
# will strip it from literals and values alike, resulting in an invalid |
|
1982
|
|
|
|
|
|
|
# condition in the end |
|
1983
|
1412
|
|
|
|
|
8155
|
$cols->{present}{$col} = { '=' => $vals->{$col} }; |
|
1984
|
|
|
|
|
|
|
} |
|
1985
|
|
|
|
|
|
|
|
|
1986
|
|
|
|
|
|
|
$cols->{fc}{$col} = 1 if ( |
|
1987
|
|
|
|
|
|
|
( ! $cols->{missing} or ! exists $cols->{missing}{$col} ) |
|
1988
|
|
|
|
|
|
|
and |
|
1989
|
4236
|
100
|
100
|
|
|
21323
|
keys %{ $args->{columns_info}{$col}{_filter_info} || {} } |
|
|
1414
|
100
|
100
|
|
|
12567
|
|
|
1990
|
|
|
|
|
|
|
); |
|
1991
|
|
|
|
|
|
|
} |
|
1992
|
|
|
|
|
|
|
|
|
1993
|
|
|
|
|
|
|
$self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s", |
|
1994
|
|
|
|
|
|
|
$args->{constraint_name}, |
|
1995
|
2822
|
|
|
|
|
23627
|
join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ), |
|
|
1962
|
|
|
|
|
8992
|
|
|
1996
|
3231
|
100
|
|
|
|
18583
|
) ) if $cols->{missing}; |
|
1997
|
|
|
|
|
|
|
|
|
1998
|
|
|
|
|
|
|
$self->throw_exception( sprintf ( |
|
1999
|
|
|
|
|
|
|
"Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s", |
|
2000
|
|
|
|
|
|
|
$args->{constraint_name}, |
|
2001
|
2
|
|
|
|
|
31
|
join (', ', map { "'$_'" } sort keys %{$cols->{fc}}), |
|
|
2
|
|
|
|
|
11
|
|
|
2002
|
1269
|
100
|
|
|
|
4528
|
)) if $cols->{fc}; |
|
2003
|
|
|
|
|
|
|
|
|
2004
|
1267
|
100
|
66
|
|
|
5030
|
if ( |
|
2005
|
|
|
|
|
|
|
$cols->{undefined} |
|
2006
|
|
|
|
|
|
|
and |
|
2007
|
|
|
|
|
|
|
!$ENV{DBIC_NULLABLE_KEY_NOWARN} |
|
2008
|
|
|
|
|
|
|
) { |
|
2009
|
|
|
|
|
|
|
carp_unique ( sprintf ( |
|
2010
|
|
|
|
|
|
|
"NULL/undef values supplied for requested unique constraint '%s' (NULL " |
|
2011
|
|
|
|
|
|
|
. 'values in column(s): %s). This is almost certainly not what you wanted, ' |
|
2012
|
|
|
|
|
|
|
. 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.', |
|
2013
|
|
|
|
|
|
|
$args->{constraint_name}, |
|
2014
|
2
|
|
|
|
|
6
|
join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}), |
|
|
2
|
|
|
|
|
20
|
|
|
|
2
|
|
|
|
|
7
|
|
|
2015
|
|
|
|
|
|
|
)); |
|
2016
|
|
|
|
|
|
|
} |
|
2017
|
|
|
|
|
|
|
|
|
2018
|
1267
|
100
|
|
|
|
4893
|
return { map { %{ $cols->{$_}||{} } } qw(present undefined) }; |
|
|
2534
|
|
|
|
|
4264
|
|
|
|
2534
|
|
|
|
|
21665
|
|
|
2019
|
|
|
|
|
|
|
} |
|
2020
|
|
|
|
|
|
|
|
|
2021
|
|
|
|
|
|
|
# Returns the {from} structure used to express JOIN conditions |
|
2022
|
|
|
|
|
|
|
sub _resolve_join { |
|
2023
|
2442
|
|
|
2442
|
|
7838
|
my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_; |
|
2024
|
|
|
|
|
|
|
|
|
2025
|
|
|
|
|
|
|
# we need a supplied one, because we do in-place modifications, no returns |
|
2026
|
2442
|
50
|
|
|
|
8899
|
$self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join') |
|
2027
|
|
|
|
|
|
|
unless ref $seen eq 'HASH'; |
|
2028
|
|
|
|
|
|
|
|
|
2029
|
2442
|
50
|
|
|
|
6310
|
$self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join') |
|
2030
|
|
|
|
|
|
|
unless ref $jpath eq 'ARRAY'; |
|
2031
|
|
|
|
|
|
|
|
|
2032
|
2442
|
|
|
|
|
5845
|
$jpath = [@$jpath]; # copy |
|
2033
|
|
|
|
|
|
|
|
|
2034
|
2442
|
100
|
100
|
|
|
15282
|
if (not defined $join or not length $join) { |
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
2035
|
417
|
|
|
|
|
1882
|
return (); |
|
2036
|
|
|
|
|
|
|
} |
|
2037
|
|
|
|
|
|
|
elsif (ref $join eq 'ARRAY') { |
|
2038
|
|
|
|
|
|
|
return |
|
2039
|
|
|
|
|
|
|
map { |
|
2040
|
534
|
|
|
|
|
1730
|
$self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left); |
|
|
756
|
|
|
|
|
4994
|
|
|
2041
|
|
|
|
|
|
|
} @$join; |
|
2042
|
|
|
|
|
|
|
} |
|
2043
|
|
|
|
|
|
|
elsif (ref $join eq 'HASH') { |
|
2044
|
|
|
|
|
|
|
|
|
2045
|
280
|
|
|
|
|
600
|
my @ret; |
|
2046
|
280
|
|
|
|
|
1028
|
for my $rel (keys %$join) { |
|
2047
|
|
|
|
|
|
|
|
|
2048
|
277
|
50
|
|
|
|
6929
|
my $rel_info = $self->relationship_info($rel) |
|
2049
|
|
|
|
|
|
|
or $self->throw_exception("No such relationship '$rel' on " . $self->source_name); |
|
2050
|
|
|
|
|
|
|
|
|
2051
|
277
|
|
|
|
|
734
|
my $force_left = $parent_force_left; |
|
2052
|
277
|
|
100
|
|
|
2335
|
$force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left'; |
|
|
|
|
100
|
|
|
|
|
|
2053
|
|
|
|
|
|
|
|
|
2054
|
|
|
|
|
|
|
# the actual seen value will be incremented by the recursion |
|
2055
|
|
|
|
|
|
|
my $as = $self->schema->storage->relname_to_table_alias( |
|
2056
|
277
|
|
66
|
|
|
974
|
$rel, ($seen->{$rel} && $seen->{$rel} + 1) |
|
2057
|
|
|
|
|
|
|
); |
|
2058
|
|
|
|
|
|
|
|
|
2059
|
|
|
|
|
|
|
push @ret, ( |
|
2060
|
|
|
|
|
|
|
$self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left), |
|
2061
|
|
|
|
|
|
|
$self->related_source($rel)->_resolve_join( |
|
2062
|
277
|
|
|
|
|
1885
|
$join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left |
|
2063
|
|
|
|
|
|
|
) |
|
2064
|
|
|
|
|
|
|
); |
|
2065
|
|
|
|
|
|
|
} |
|
2066
|
280
|
|
|
|
|
2289
|
return @ret; |
|
2067
|
|
|
|
|
|
|
|
|
2068
|
|
|
|
|
|
|
} |
|
2069
|
|
|
|
|
|
|
elsif (ref $join) { |
|
2070
|
0
|
|
|
|
|
0
|
$self->throw_exception("No idea how to resolve join reftype ".ref $join); |
|
2071
|
|
|
|
|
|
|
} |
|
2072
|
|
|
|
|
|
|
else { |
|
2073
|
1211
|
|
|
|
|
3842
|
my $count = ++$seen->{$join}; |
|
2074
|
1211
|
|
66
|
|
|
3990
|
my $as = $self->schema->storage->relname_to_table_alias( |
|
2075
|
|
|
|
|
|
|
$join, ($count > 1 && $count) |
|
2076
|
|
|
|
|
|
|
); |
|
2077
|
|
|
|
|
|
|
|
|
2078
|
1211
|
50
|
|
|
|
23509
|
my $rel_info = $self->relationship_info($join) |
|
2079
|
|
|
|
|
|
|
or $self->throw_exception("No such relationship $join on " . $self->source_name); |
|
2080
|
|
|
|
|
|
|
|
|
2081
|
1211
|
|
|
|
|
4911
|
my $rel_src = $self->related_source($join); |
|
2082
|
|
|
|
|
|
|
return [ { $as => $rel_src->from, |
|
2083
|
|
|
|
|
|
|
-rsrc => $rel_src, |
|
2084
|
|
|
|
|
|
|
-join_type => $parent_force_left |
|
2085
|
|
|
|
|
|
|
? 'left' |
|
2086
|
|
|
|
|
|
|
: $rel_info->{attrs}{join_type} |
|
2087
|
|
|
|
|
|
|
, |
|
2088
|
|
|
|
|
|
|
-join_path => [@$jpath, { $join => $as } ], |
|
2089
|
|
|
|
|
|
|
-is_single => ( |
|
2090
|
|
|
|
|
|
|
! $rel_info->{attrs}{accessor} |
|
2091
|
|
|
|
|
|
|
or |
|
2092
|
|
|
|
|
|
|
$rel_info->{attrs}{accessor} eq 'single' |
|
2093
|
|
|
|
|
|
|
or |
|
2094
|
|
|
|
|
|
|
$rel_info->{attrs}{accessor} eq 'filter' |
|
2095
|
|
|
|
|
|
|
), |
|
2096
|
|
|
|
|
|
|
-alias => $as, |
|
2097
|
|
|
|
|
|
|
-relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1, |
|
2098
|
|
|
|
|
|
|
}, |
|
2099
|
|
|
|
|
|
|
$self->resolve_relationship_condition( |
|
2100
|
|
|
|
|
|
|
rel_name => $join, |
|
2101
|
|
|
|
|
|
|
self_alias => $alias, |
|
2102
|
|
|
|
|
|
|
foreign_alias => $as, |
|
2103
|
|
|
|
|
|
|
)->{condition}, |
|
2104
|
1211
|
100
|
100
|
|
|
8855
|
]; |
|
|
|
|
100
|
|
|
|
|
|
2105
|
|
|
|
|
|
|
} |
|
2106
|
|
|
|
|
|
|
} |
|
2107
|
|
|
|
|
|
|
|
|
2108
|
|
|
|
|
|
|
sub pk_depends_on { |
|
2109
|
0
|
|
|
0
|
0
|
0
|
carp 'pk_depends_on is a private method, stop calling it'; |
|
2110
|
0
|
|
|
|
|
0
|
my $self = shift; |
|
2111
|
0
|
|
|
|
|
0
|
$self->_pk_depends_on (@_); |
|
2112
|
|
|
|
|
|
|
} |
|
2113
|
|
|
|
|
|
|
|
|
2114
|
|
|
|
|
|
|
# Determines whether a relation is dependent on an object from this source |
|
2115
|
|
|
|
|
|
|
# having already been inserted. Takes the name of the relationship and a |
|
2116
|
|
|
|
|
|
|
# hashref of columns of the related object. |
|
2117
|
|
|
|
|
|
|
sub _pk_depends_on { |
|
2118
|
743
|
|
|
743
|
|
2189
|
my ($self, $rel_name, $rel_data) = @_; |
|
2119
|
|
|
|
|
|
|
|
|
2120
|
743
|
|
|
|
|
14321
|
my $relinfo = $self->relationship_info($rel_name); |
|
2121
|
|
|
|
|
|
|
|
|
2122
|
|
|
|
|
|
|
# don't assume things if the relationship direction is specified |
|
2123
|
|
|
|
|
|
|
return $relinfo->{attrs}{is_foreign_key_constraint} |
|
2124
|
743
|
100
|
|
|
|
5838
|
if exists ($relinfo->{attrs}{is_foreign_key_constraint}); |
|
2125
|
|
|
|
|
|
|
|
|
2126
|
241
|
|
|
|
|
546
|
my $cond = $relinfo->{cond}; |
|
2127
|
241
|
100
|
|
|
|
926
|
return 0 unless ref($cond) eq 'HASH'; |
|
2128
|
|
|
|
|
|
|
|
|
2129
|
|
|
|
|
|
|
# map { foreign.foo => 'self.bar' } to { bar => 'foo' } |
|
2130
|
202
|
|
|
|
|
964
|
my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond }; |
|
|
404
|
|
|
|
|
755
|
|
|
|
404
|
|
|
|
|
1530
|
|
|
|
404
|
|
|
|
|
1227
|
|
|
2131
|
|
|
|
|
|
|
|
|
2132
|
|
|
|
|
|
|
# assume anything that references our PK probably is dependent on us |
|
2133
|
|
|
|
|
|
|
# rather than vice versa, unless the far side is (a) defined or (b) |
|
2134
|
|
|
|
|
|
|
# auto-increment |
|
2135
|
202
|
|
|
|
|
747
|
my $rel_source = $self->related_source($rel_name); |
|
2136
|
|
|
|
|
|
|
|
|
2137
|
202
|
|
|
|
|
753
|
my $colinfos; |
|
2138
|
|
|
|
|
|
|
|
|
2139
|
202
|
|
|
|
|
4195
|
foreach my $p ($self->primary_columns) { |
|
2140
|
|
|
|
|
|
|
return 0 if ( |
|
2141
|
|
|
|
|
|
|
exists $keyhash->{$p} |
|
2142
|
|
|
|
|
|
|
and |
|
2143
|
|
|
|
|
|
|
! defined( $rel_data->{$keyhash->{$p}} ) |
|
2144
|
|
|
|
|
|
|
and |
|
2145
|
|
|
|
|
|
|
! ( $colinfos ||= $rel_source->columns_info ) |
|
2146
|
|
|
|
|
|
|
->{$keyhash->{$p}}{is_auto_increment} |
|
2147
|
|
|
|
|
|
|
) |
|
2148
|
202
|
50
|
33
|
|
|
4746
|
} |
|
|
|
|
33
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
2149
|
|
|
|
|
|
|
|
|
2150
|
0
|
|
|
|
|
0
|
return 1; |
|
2151
|
|
|
|
|
|
|
} |
|
2152
|
|
|
|
|
|
|
|
|
2153
|
|
|
|
|
|
|
sub __strip_relcond :DBIC_method_is_indirect_sugar { |
|
2154
|
0
|
|
|
0
|
|
0
|
DBIx::Class::Exception->throw( |
|
2155
|
|
|
|
|
|
|
'__strip_relcond() has been removed with no replacement, ' |
|
2156
|
|
|
|
|
|
|
. 'ask for advice on IRC if this affected you' |
|
2157
|
|
|
|
|
|
|
); |
|
2158
|
312
|
|
|
312
|
|
624000
|
} |
|
|
312
|
|
|
|
|
1980
|
|
|
|
312
|
|
|
|
|
2582
|
|
|
2159
|
|
|
|
|
|
|
|
|
2160
|
|
|
|
|
|
|
sub compare_relationship_keys :DBIC_method_is_indirect_sugar { |
|
2161
|
0
|
|
|
0
|
0
|
0
|
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; |
|
2162
|
0
|
|
|
|
|
0
|
carp_unique( 'compare_relationship_keys() is deprecated, ask on IRC for a better alternative' ); |
|
2163
|
0
|
|
|
|
|
0
|
bag_eq( $_[1], $_[2] ); |
|
2164
|
312
|
|
|
312
|
|
74012
|
} |
|
|
312
|
|
|
|
|
2768
|
|
|
|
312
|
|
|
|
|
3950
|
|
|
2165
|
|
|
|
|
|
|
|
|
2166
|
|
|
|
|
|
|
sub _compare_relationship_keys :DBIC_method_is_indirect_sugar { |
|
2167
|
0
|
|
|
0
|
|
0
|
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; |
|
2168
|
0
|
|
|
|
|
0
|
carp_unique( '_compare_relationship_keys() is deprecated, ask on IRC for a better alternative' ); |
|
2169
|
0
|
|
|
|
|
0
|
bag_eq( $_[1], $_[2] ); |
|
2170
|
312
|
|
|
312
|
|
69453
|
} |
|
|
312
|
|
|
|
|
2292
|
|
|
|
312
|
|
|
|
|
3830
|
|
|
2171
|
|
|
|
|
|
|
|
|
2172
|
|
|
|
|
|
|
sub _resolve_relationship_condition :DBIC_method_is_indirect_sugar { |
|
2173
|
0
|
|
|
0
|
|
0
|
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; |
|
2174
|
|
|
|
|
|
|
|
|
2175
|
|
|
|
|
|
|
# carp() - has been on CPAN for less than 2 years |
|
2176
|
0
|
|
|
|
|
0
|
carp '_resolve_relationship_condition() is deprecated - see resolve_relationship_condition() instead'; |
|
2177
|
|
|
|
|
|
|
|
|
2178
|
0
|
|
|
|
|
0
|
shift->resolve_relationship_condition(@_); |
|
2179
|
312
|
|
|
312
|
|
66159
|
} |
|
|
312
|
|
|
|
|
4387
|
|
|
|
312
|
|
|
|
|
1317
|
|
|
2180
|
|
|
|
|
|
|
|
|
2181
|
|
|
|
|
|
|
sub resolve_condition :DBIC_method_is_indirect_sugar { |
|
2182
|
0
|
|
|
0
|
0
|
0
|
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; |
|
2183
|
|
|
|
|
|
|
|
|
2184
|
|
|
|
|
|
|
# carp() - has been discouraged forever |
|
2185
|
0
|
|
|
|
|
0
|
carp 'resolve_condition() is deprecated - see resolve_relationship_condition() instead'; |
|
2186
|
|
|
|
|
|
|
|
|
2187
|
0
|
|
|
|
|
0
|
shift->_resolve_condition (@_); |
|
2188
|
312
|
|
|
312
|
|
63578
|
} |
|
|
312
|
|
|
|
|
1598
|
|
|
|
312
|
|
|
|
|
3127
|
|
|
2189
|
|
|
|
|
|
|
|
|
2190
|
|
|
|
|
|
|
sub _resolve_condition :DBIC_method_is_indirect_sugar { |
|
2191
|
0
|
|
|
0
|
|
0
|
DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call; |
|
2192
|
|
|
|
|
|
|
|
|
2193
|
|
|
|
|
|
|
# carp_unique() - the interface replacing it only became reality in Sep 2016 |
|
2194
|
0
|
|
|
|
|
0
|
carp_unique '_resolve_condition() is deprecated - see resolve_relationship_condition() instead'; |
|
2195
|
|
|
|
|
|
|
|
|
2196
|
|
|
|
|
|
|
####################### |
|
2197
|
|
|
|
|
|
|
### API Design? What's that...? (a backwards compatible shim, kill me now) |
|
2198
|
|
|
|
|
|
|
|
|
2199
|
0
|
|
|
|
|
0
|
my ($self, $cond, @res_args, $rel_name); |
|
2200
|
|
|
|
|
|
|
|
|
2201
|
|
|
|
|
|
|
# we *SIMPLY DON'T KNOW YET* which arg is which, yay |
|
2202
|
0
|
|
|
|
|
0
|
($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_; |
|
2203
|
|
|
|
|
|
|
|
|
2204
|
|
|
|
|
|
|
# assume that an undef is an object-like unset (set_from_related(undef)) |
|
2205
|
0
|
0
|
|
|
|
0
|
my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args); |
|
|
0
|
|
|
|
|
0
|
|
|
2206
|
|
|
|
|
|
|
|
|
2207
|
|
|
|
|
|
|
# turn objlike into proper objects for saner code further down |
|
2208
|
0
|
|
|
|
|
0
|
for (0,1) { |
|
2209
|
0
|
0
|
|
|
|
0
|
next unless $is_objlike[$_]; |
|
2210
|
|
|
|
|
|
|
|
|
2211
|
0
|
0
|
|
|
|
0
|
if ( defined blessed $res_args[$_] ) { |
|
2212
|
|
|
|
|
|
|
|
|
2213
|
|
|
|
|
|
|
# but wait - there is more!!! WHAT THE FUCK?!?!?!?! |
|
2214
|
0
|
0
|
0
|
|
|
0
|
if ($res_args[$_]->isa('DBIx::Class::ResultSet')) { |
|
|
|
0
|
|
|
|
|
|
|
2215
|
0
|
|
|
|
|
0
|
carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__'); |
|
2216
|
0
|
|
|
|
|
0
|
$is_objlike[$_] = 0; |
|
2217
|
0
|
|
|
|
|
0
|
$res_args[$_] = '__gremlins__'; |
|
2218
|
|
|
|
|
|
|
} |
|
2219
|
|
|
|
|
|
|
# more compat |
|
2220
|
|
|
|
|
|
|
elsif( $_ == 0 and $res_args[0]->isa( $__expected_result_class_isa ) ) { |
|
2221
|
0
|
|
|
|
|
0
|
$res_args[0] = { $res_args[0]->get_columns }; |
|
2222
|
|
|
|
|
|
|
} |
|
2223
|
|
|
|
|
|
|
} |
|
2224
|
|
|
|
|
|
|
else { |
|
2225
|
0
|
|
0
|
|
|
0
|
$res_args[$_] ||= {}; |
|
2226
|
|
|
|
|
|
|
|
|
2227
|
|
|
|
|
|
|
# hate everywhere - have to pass in as a plain hash |
|
2228
|
|
|
|
|
|
|
# pretending to be an object at least for now |
|
2229
|
0
|
0
|
|
|
|
0
|
$self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]") |
|
2230
|
|
|
|
|
|
|
unless ref $res_args[$_] eq 'HASH'; |
|
2231
|
|
|
|
|
|
|
} |
|
2232
|
|
|
|
|
|
|
} |
|
2233
|
|
|
|
|
|
|
|
|
2234
|
0
|
0
|
|
|
|
0
|
my $args = { |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
2235
|
|
|
|
|
|
|
# where-is-waldo block guesses relname, then further down we override it if available |
|
2236
|
|
|
|
|
|
|
( |
|
2237
|
|
|
|
|
|
|
$is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] ) |
|
2238
|
|
|
|
|
|
|
: $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] ) |
|
2239
|
|
|
|
|
|
|
: ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] ) |
|
2240
|
|
|
|
|
|
|
), |
|
2241
|
|
|
|
|
|
|
|
|
2242
|
|
|
|
|
|
|
( $rel_name ? ( rel_name => $rel_name ) : () ), |
|
2243
|
|
|
|
|
|
|
}; |
|
2244
|
|
|
|
|
|
|
|
|
2245
|
|
|
|
|
|
|
# Allowing passing relconds different than the relationshup itself is cute, |
|
2246
|
|
|
|
|
|
|
# but likely dangerous. Remove that from the API of resolve_relationship_condition, |
|
2247
|
|
|
|
|
|
|
# and instead make it "hard on purpose" |
|
2248
|
0
|
0
|
|
|
|
0
|
local $self->relationship_info( $args->{rel_name} )->{cond} = $cond if defined $cond; |
|
2249
|
|
|
|
|
|
|
|
|
2250
|
|
|
|
|
|
|
####################### |
|
2251
|
|
|
|
|
|
|
|
|
2252
|
|
|
|
|
|
|
# now it's fucking easy isn't it?! |
|
2253
|
0
|
|
|
|
|
0
|
my $rc = $self->resolve_relationship_condition( $args ); |
|
2254
|
|
|
|
|
|
|
|
|
2255
|
|
|
|
|
|
|
my @res = ( |
|
2256
|
|
|
|
|
|
|
( $rc->{join_free_condition} || $rc->{condition} ), |
|
2257
|
|
|
|
|
|
|
! $rc->{join_free_condition}, |
|
2258
|
0
|
|
0
|
|
|
0
|
); |
|
2259
|
|
|
|
|
|
|
|
|
2260
|
|
|
|
|
|
|
# resolve_relationship_condition always returns qualified cols even in the |
|
2261
|
|
|
|
|
|
|
# case of join_free_condition, but nothing downstream expects this |
|
2262
|
0
|
0
|
0
|
|
|
0
|
if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') { |
|
2263
|
|
|
|
|
|
|
$res[0] = { map |
|
2264
|
0
|
|
|
|
|
0
|
{ ($_ =~ /\.(.+)/) => $res[0]{$_} } |
|
2265
|
0
|
|
|
|
|
0
|
keys %{$res[0]} |
|
|
0
|
|
|
|
|
0
|
|
|
2266
|
|
|
|
|
|
|
}; |
|
2267
|
|
|
|
|
|
|
} |
|
2268
|
|
|
|
|
|
|
|
|
2269
|
|
|
|
|
|
|
# and more legacy |
|
2270
|
0
|
0
|
|
|
|
0
|
return wantarray ? @res : $res[0]; |
|
2271
|
312
|
|
|
312
|
|
169942
|
} |
|
|
312
|
|
|
|
|
2625
|
|
|
|
312
|
|
|
|
|
3053
|
|
|
2272
|
|
|
|
|
|
|
|
|
2273
|
|
|
|
|
|
|
# Keep this indefinitely. There is evidence of both CPAN and |
|
2274
|
|
|
|
|
|
|
# darkpan using it, and there isn't much harm in an extra var |
|
2275
|
|
|
|
|
|
|
# anyway. |
|
2276
|
|
|
|
|
|
|
our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION; |
|
2277
|
|
|
|
|
|
|
# YES I KNOW THIS IS EVIL |
|
2278
|
|
|
|
|
|
|
# it is there to save darkpan from themselves, since internally |
|
2279
|
|
|
|
|
|
|
# we are moving to a constant |
|
2280
|
|
|
|
|
|
|
Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1); |
|
2281
|
|
|
|
|
|
|
|
|
2282
|
|
|
|
|
|
|
=head2 resolve_relationship_condition |
|
2283
|
|
|
|
|
|
|
|
|
2284
|
|
|
|
|
|
|
NOTE: You generally B need to use this functionality... until you |
|
2285
|
|
|
|
|
|
|
do. The API description is terse on purpose. If the text below doesn't make |
|
2286
|
|
|
|
|
|
|
sense right away (based on the context which prompted you to look here) it is |
|
2287
|
|
|
|
|
|
|
almost certain you are reaching for the wrong tool. Please consider asking for |
|
2288
|
|
|
|
|
|
|
advice in any of the support channels before proceeding. |
|
2289
|
|
|
|
|
|
|
|
|
2290
|
|
|
|
|
|
|
=over 4 |
|
2291
|
|
|
|
|
|
|
|
|
2292
|
|
|
|
|
|
|
=item Arguments: C<\%args> as shown below (C> denotes mandatory args): |
|
2293
|
|
|
|
|
|
|
|
|
2294
|
|
|
|
|
|
|
* rel_name => $string |
|
2295
|
|
|
|
|
|
|
|
|
2296
|
|
|
|
|
|
|
* foreign_alias => $string |
|
2297
|
|
|
|
|
|
|
|
|
2298
|
|
|
|
|
|
|
* self_alias => $string |
|
2299
|
|
|
|
|
|
|
|
|
2300
|
|
|
|
|
|
|
foreign_values => \%column_value_pairs |
|
2301
|
|
|
|
|
|
|
|
|
2302
|
|
|
|
|
|
|
self_result_object => $ResultObject |
|
2303
|
|
|
|
|
|
|
|
|
2304
|
|
|
|
|
|
|
require_join_free_condition => $bool ( results in exception on failure to construct a JF-cond ) |
|
2305
|
|
|
|
|
|
|
|
|
2306
|
|
|
|
|
|
|
require_join_free_values => $bool ( results in exception on failure to return an equality-only JF-cond ) |
|
2307
|
|
|
|
|
|
|
|
|
2308
|
|
|
|
|
|
|
=item Return Value: C<\%resolution_result> as shown below (C> denotes always-resent parts of the result): |
|
2309
|
|
|
|
|
|
|
|
|
2310
|
|
|
|
|
|
|
* condition => $sqla_condition ( always present, valid, *likely* fully qualified, SQL::Abstract-compatible structure ) |
|
2311
|
|
|
|
|
|
|
|
|
2312
|
|
|
|
|
|
|
identity_map => \%foreign_to_self_equailty_map ( list of declared-equal foreign/self *unqualified* column names ) |
|
2313
|
|
|
|
|
|
|
|
|
2314
|
|
|
|
|
|
|
identity_map_matches_condition => $bool ( indicates whether the entire condition is expressed within the identity_map ) |
|
2315
|
|
|
|
|
|
|
|
|
2316
|
|
|
|
|
|
|
join_free_condition => \%sqla_condition_fully_resolvable_via_foreign_table |
|
2317
|
|
|
|
|
|
|
( always a hash, all keys guaranteed to be valid *fully qualified* columns ) |
|
2318
|
|
|
|
|
|
|
|
|
2319
|
|
|
|
|
|
|
join_free_values => \%unqalified_version_of_join_free_condition |
|
2320
|
|
|
|
|
|
|
( IFF the returned join_free_condition contains only exact values (no expressions), this would be |
|
2321
|
|
|
|
|
|
|
a hashref identical to join_free_condition, except with all column names *unqualified* ) |
|
2322
|
|
|
|
|
|
|
|
|
2323
|
|
|
|
|
|
|
=back |
|
2324
|
|
|
|
|
|
|
|
|
2325
|
|
|
|
|
|
|
This is the low-level method used to convert a declared relationship into |
|
2326
|
|
|
|
|
|
|
various parameters consumed by higher level functions. It is provided as a |
|
2327
|
|
|
|
|
|
|
stable official API, as the logic it encapsulates grew incredibly complex with |
|
2328
|
|
|
|
|
|
|
time. While calling this method directly B, you |
|
2329
|
|
|
|
|
|
|
absolutely B in codepaths containing the moral equivalent |
|
2330
|
|
|
|
|
|
|
of: |
|
2331
|
|
|
|
|
|
|
|
|
2332
|
|
|
|
|
|
|
... |
|
2333
|
|
|
|
|
|
|
if( ref $some_rsrc->relationship_info($somerel)->{cond} eq 'HASH' ) { |
|
2334
|
|
|
|
|
|
|
... |
|
2335
|
|
|
|
|
|
|
} |
|
2336
|
|
|
|
|
|
|
... |
|
2337
|
|
|
|
|
|
|
|
|
2338
|
|
|
|
|
|
|
=cut |
|
2339
|
|
|
|
|
|
|
|
|
2340
|
|
|
|
|
|
|
# TODO - expand the documentation above, too terse |
|
2341
|
|
|
|
|
|
|
|
|
2342
|
|
|
|
|
|
|
sub resolve_relationship_condition { |
|
2343
|
10098
|
|
|
10098
|
1
|
24012
|
my $self = shift; |
|
2344
|
|
|
|
|
|
|
|
|
2345
|
10098
|
100
|
|
|
|
46779
|
my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ }; |
|
|
2403
|
|
|
|
|
13518
|
|
|
2346
|
|
|
|
|
|
|
|
|
2347
|
10098
|
|
|
|
|
27472
|
for ( qw( rel_name self_alias foreign_alias ) ) { |
|
2348
|
|
|
|
|
|
|
$self->throw_exception("Mandatory argument '$_' to resolve_relationship_condition() is not a plain string") |
|
2349
|
30294
|
50
|
33
|
|
|
130566
|
if !defined $args->{$_} or length ref $args->{$_}; |
|
2350
|
|
|
|
|
|
|
} |
|
2351
|
|
|
|
|
|
|
|
|
2352
|
|
|
|
|
|
|
$self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical") |
|
2353
|
10098
|
50
|
|
|
|
29474
|
if $args->{self_alias} eq $args->{foreign_alias}; |
|
2354
|
|
|
|
|
|
|
|
|
2355
|
|
|
|
|
|
|
# TEMP |
|
2356
|
10098
|
|
66
|
|
|
27935
|
my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name || $self->result_class ]}'"; |
|
|
10098
|
|
|
|
|
238499
|
|
|
2357
|
|
|
|
|
|
|
|
|
2358
|
|
|
|
|
|
|
my $rel_info = $self->relationship_info($args->{rel_name}) |
|
2359
|
|
|
|
|
|
|
# TEMP |
|
2360
|
|
|
|
|
|
|
# or $self->throw_exception( "No such $exception_rel_id" ); |
|
2361
|
10098
|
50
|
|
|
|
192333
|
or carp_unique("Requesting resolution on non-existent relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}': fix your code *soon*, as it will break with the next major version"); |
|
|
0
|
|
|
|
|
0
|
|
|
2362
|
|
|
|
|
|
|
|
|
2363
|
|
|
|
|
|
|
# TEMP |
|
2364
|
77
|
|
|
|
|
1244
|
$exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'" |
|
2365
|
10098
|
100
|
66
|
|
|
79043
|
if $rel_info and exists $rel_info->{_original_name}; |
|
2366
|
|
|
|
|
|
|
|
|
2367
|
|
|
|
|
|
|
$self->throw_exception("No practical way to resolve $exception_rel_id between two data structures") |
|
2368
|
10098
|
50
|
66
|
|
|
38050
|
if exists $args->{self_result_object} and exists $args->{foreign_values}; |
|
2369
|
|
|
|
|
|
|
|
|
2370
|
10098
|
|
100
|
|
|
48700
|
$args->{require_join_free_condition} ||= !!$args->{require_join_free_values}; |
|
2371
|
|
|
|
|
|
|
|
|
2372
|
|
|
|
|
|
|
$self->throw_exception( "Argument 'self_result_object' must be an object inheriting from '$__expected_result_class_isa'" ) |
|
2373
|
|
|
|
|
|
|
if ( |
|
2374
|
|
|
|
|
|
|
exists $args->{self_result_object} |
|
2375
|
|
|
|
|
|
|
and |
|
2376
|
|
|
|
|
|
|
( |
|
2377
|
|
|
|
|
|
|
! defined blessed $args->{self_result_object} |
|
2378
|
|
|
|
|
|
|
or |
|
2379
|
10098
|
50
|
33
|
|
|
62054
|
! $args->{self_result_object}->isa( $__expected_result_class_isa ) |
|
|
|
|
66
|
|
|
|
|
|
2380
|
|
|
|
|
|
|
) |
|
2381
|
|
|
|
|
|
|
) |
|
2382
|
|
|
|
|
|
|
; |
|
2383
|
|
|
|
|
|
|
|
|
2384
|
10098
|
|
|
|
|
34100
|
my $rel_rsrc = $self->related_source($args->{rel_name}); |
|
2385
|
|
|
|
|
|
|
|
|
2386
|
10089
|
100
|
33
|
|
|
57204
|
if ( |
|
|
|
|
66
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
2387
|
|
|
|
|
|
|
exists $args->{foreign_values} |
|
2388
|
|
|
|
|
|
|
and |
|
2389
|
|
|
|
|
|
|
( |
|
2390
|
|
|
|
|
|
|
ref $args->{foreign_values} eq 'HASH' |
|
2391
|
|
|
|
|
|
|
or |
|
2392
|
|
|
|
|
|
|
$self->throw_exception( |
|
2393
|
|
|
|
|
|
|
"Argument 'foreign_values' must be a hash reference" |
|
2394
|
|
|
|
|
|
|
) |
|
2395
|
|
|
|
|
|
|
) |
|
2396
|
|
|
|
|
|
|
and |
|
2397
|
688
|
|
|
|
|
3265
|
keys %{$args->{foreign_values}} |
|
2398
|
|
|
|
|
|
|
) { |
|
2399
|
|
|
|
|
|
|
|
|
2400
|
|
|
|
|
|
|
my ($col_idx, $rel_idx) = map |
|
2401
|
679
|
|
|
|
|
1678
|
{ { map { $_ => 1 } $rel_rsrc->$_ } } |
|
|
1358
|
|
|
|
|
27668
|
|
|
|
10727
|
|
|
|
|
24484
|
|
|
2402
|
|
|
|
|
|
|
qw( columns relationships ) |
|
2403
|
|
|
|
|
|
|
; |
|
2404
|
|
|
|
|
|
|
|
|
2405
|
679
|
|
|
|
|
1540
|
my $equivalencies; |
|
2406
|
|
|
|
|
|
|
|
|
2407
|
|
|
|
|
|
|
# re-build {foreign_values} excluding refs as follows |
|
2408
|
|
|
|
|
|
|
# ( hot codepath: intentionally convoluted ) |
|
2409
|
|
|
|
|
|
|
# |
|
2410
|
|
|
|
|
|
|
$args->{foreign_values} = { map { |
|
2411
|
|
|
|
|
|
|
( |
|
2412
|
|
|
|
|
|
|
$_ !~ /^-/ |
|
2413
|
|
|
|
|
|
|
or |
|
2414
|
|
|
|
|
|
|
$self->throw_exception( |
|
2415
|
|
|
|
|
|
|
"The key '$_' supplied as part of 'foreign_values' during " |
|
2416
|
|
|
|
|
|
|
. 'relationship resolution must be a column name, not a function' |
|
2417
|
|
|
|
|
|
|
) |
|
2418
|
|
|
|
|
|
|
) |
|
2419
|
|
|
|
|
|
|
and |
|
2420
|
|
|
|
|
|
|
( |
|
2421
|
|
|
|
|
|
|
# skip if relationship ( means a multicreate stub was passed in ) |
|
2422
|
|
|
|
|
|
|
# skip if literal ( can't infer anything about it ) |
|
2423
|
|
|
|
|
|
|
# or plain throw if nonequiv yet not literal |
|
2424
|
|
|
|
|
|
|
( |
|
2425
|
|
|
|
|
|
|
length ref $args->{foreign_values}{$_} |
|
2426
|
|
|
|
|
|
|
and |
|
2427
|
|
|
|
|
|
|
( |
|
2428
|
|
|
|
|
|
|
$rel_idx->{$_} |
|
2429
|
|
|
|
|
|
|
or |
|
2430
|
|
|
|
|
|
|
is_literal_value($args->{foreign_values}{$_}) |
|
2431
|
|
|
|
|
|
|
or |
|
2432
|
|
|
|
|
|
|
( |
|
2433
|
|
|
|
|
|
|
( |
|
2434
|
|
|
|
|
|
|
! exists( |
|
2435
|
|
|
|
|
|
|
( $equivalencies ||= extract_equality_conditions( $args->{foreign_values}, 'consider nulls' ) ) |
|
2436
|
|
|
|
|
|
|
->{$_} |
|
2437
|
|
|
|
|
|
|
) |
|
2438
|
|
|
|
|
|
|
or |
|
2439
|
|
|
|
|
|
|
($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION |
|
2440
|
|
|
|
|
|
|
) |
|
2441
|
|
|
|
|
|
|
and |
|
2442
|
|
|
|
|
|
|
$self->throw_exception( |
|
2443
|
|
|
|
|
|
|
"Resolution of relationship '$args->{rel_name}' failed: " |
|
2444
|
|
|
|
|
|
|
. "supplied value for foreign column '$_' is not a direct " |
|
2445
|
|
|
|
|
|
|
. 'equivalence expression' |
|
2446
|
|
|
|
|
|
|
) |
|
2447
|
|
|
|
|
|
|
) |
|
2448
|
|
|
|
|
|
|
) |
|
2449
|
|
|
|
|
|
|
) ? () |
|
2450
|
2329
|
50
|
100
|
|
|
16728
|
: $col_idx->{$_} ? ( $_ => $args->{foreign_values}{$_} ) |
|
|
|
100
|
66
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
2451
|
|
|
|
|
|
|
: $self->throw_exception( |
|
2452
|
|
|
|
|
|
|
"The key '$_' supplied as part of 'foreign_values' during " |
|
2453
|
|
|
|
|
|
|
. 'relationship resolution is not a column on related source ' |
|
2454
|
0
|
|
|
|
|
0
|
. "'@{[ $rel_rsrc->source_name ]}'" |
|
2455
|
|
|
|
|
|
|
) |
|
2456
|
|
|
|
|
|
|
) |
|
2457
|
679
|
|
|
|
|
1186
|
} keys %{$args->{foreign_values}} }; |
|
|
679
|
|
|
|
|
2016
|
|
|
2458
|
|
|
|
|
|
|
} |
|
2459
|
|
|
|
|
|
|
|
|
2460
|
10085
|
|
|
|
|
21671
|
my $ret; |
|
2461
|
|
|
|
|
|
|
|
|
2462
|
10085
|
100
|
|
|
|
44033
|
if (ref $rel_info->{cond} eq 'CODE') { |
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
2463
|
|
|
|
|
|
|
|
|
2464
|
|
|
|
|
|
|
my $cref_args = { |
|
2465
|
|
|
|
|
|
|
rel_name => $args->{rel_name}, |
|
2466
|
|
|
|
|
|
|
self_resultsource => $self, |
|
2467
|
|
|
|
|
|
|
self_alias => $args->{self_alias}, |
|
2468
|
|
|
|
|
|
|
foreign_alias => $args->{foreign_alias}, |
|
2469
|
|
|
|
|
|
|
( map |
|
2470
|
1261
|
100
|
|
|
|
4466
|
{ (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () } |
|
|
2522
|
|
|
|
|
9632
|
|
|
2471
|
|
|
|
|
|
|
qw( self_result_object foreign_values ) |
|
2472
|
|
|
|
|
|
|
), |
|
2473
|
|
|
|
|
|
|
}; |
|
2474
|
|
|
|
|
|
|
|
|
2475
|
|
|
|
|
|
|
# legacy - never remove these!!! |
|
2476
|
1261
|
|
|
|
|
3554
|
$cref_args->{foreign_relname} = $cref_args->{rel_name}; |
|
2477
|
|
|
|
|
|
|
|
|
2478
|
|
|
|
|
|
|
$cref_args->{self_rowobj} = $cref_args->{self_result_object} |
|
2479
|
1261
|
100
|
|
|
|
3906
|
if exists $cref_args->{self_result_object}; |
|
2480
|
|
|
|
|
|
|
|
|
2481
|
1261
|
|
|
|
|
6242
|
($ret->{condition}, $ret->{join_free_condition}, my @extra) = $rel_info->{cond}->($cref_args); |
|
2482
|
|
|
|
|
|
|
|
|
2483
|
|
|
|
|
|
|
# sanity check |
|
2484
|
1261
|
100
|
|
|
|
27372
|
$self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra") |
|
2485
|
|
|
|
|
|
|
if @extra; |
|
2486
|
|
|
|
|
|
|
|
|
2487
|
1260
|
100
|
|
|
|
5751
|
if( $ret->{join_free_condition} ) { |
|
2488
|
|
|
|
|
|
|
|
|
2489
|
|
|
|
|
|
|
$self->throw_exception ( |
|
2490
|
|
|
|
|
|
|
"The join-free condition returned for $exception_rel_id must be a hash reference" |
|
2491
|
89
|
50
|
|
|
|
357
|
) unless ref $ret->{join_free_condition} eq 'HASH'; |
|
2492
|
|
|
|
|
|
|
|
|
2493
|
89
|
|
|
|
|
218
|
my ($joinfree_alias, $joinfree_source); |
|
2494
|
89
|
100
|
|
|
|
396
|
if (defined $args->{self_result_object}) { |
|
|
|
50
|
|
|
|
|
|
|
2495
|
21
|
|
|
|
|
40
|
$joinfree_alias = $args->{foreign_alias}; |
|
2496
|
21
|
|
|
|
|
37
|
$joinfree_source = $rel_rsrc; |
|
2497
|
|
|
|
|
|
|
} |
|
2498
|
|
|
|
|
|
|
elsif (defined $args->{foreign_values}) { |
|
2499
|
68
|
|
|
|
|
167
|
$joinfree_alias = $args->{self_alias}; |
|
2500
|
68
|
|
|
|
|
157
|
$joinfree_source = $self; |
|
2501
|
|
|
|
|
|
|
} |
|
2502
|
|
|
|
|
|
|
|
|
2503
|
|
|
|
|
|
|
# FIXME sanity check until things stabilize, remove at some point |
|
2504
|
|
|
|
|
|
|
$self->throw_exception ( |
|
2505
|
89
|
50
|
|
|
|
228
|
"A join-free condition returned for $exception_rel_id without a result object to chain from" |
|
2506
|
|
|
|
|
|
|
) unless $joinfree_alias; |
|
2507
|
|
|
|
|
|
|
|
|
2508
|
|
|
|
|
|
|
my $fq_col_list = { map |
|
2509
|
89
|
|
|
|
|
1838
|
{ ( "$joinfree_alias.$_" => 1 ) } |
|
|
490
|
|
|
|
|
1819
|
|
|
2510
|
|
|
|
|
|
|
$joinfree_source->columns |
|
2511
|
|
|
|
|
|
|
}; |
|
2512
|
|
|
|
|
|
|
|
|
2513
|
|
|
|
|
|
|
exists $fq_col_list->{$_} or $self->throw_exception ( |
|
2514
|
|
|
|
|
|
|
"The join-free condition returned for $exception_rel_id may only " |
|
2515
|
|
|
|
|
|
|
. 'contain keys that are fully qualified column names of the corresponding source ' |
|
2516
|
|
|
|
|
|
|
. "'$joinfree_alias' (instead it returned '$_')" |
|
2517
|
89
|
|
33
|
|
|
277
|
) for keys %{$ret->{join_free_condition}}; |
|
|
89
|
|
|
|
|
578
|
|
|
2518
|
|
|
|
|
|
|
|
|
2519
|
|
|
|
|
|
|
( |
|
2520
|
|
|
|
|
|
|
defined blessed($_) |
|
2521
|
|
|
|
|
|
|
and |
|
2522
|
|
|
|
|
|
|
$_->isa( $__expected_result_class_isa ) |
|
2523
|
|
|
|
|
|
|
and |
|
2524
|
|
|
|
|
|
|
$self->throw_exception ( |
|
2525
|
|
|
|
|
|
|
"The join-free condition returned for $exception_rel_id may not " |
|
2526
|
|
|
|
|
|
|
. 'contain result objects as values - perhaps instead of invoking ' |
|
2527
|
|
|
|
|
|
|
. '->$something you meant to return ->get_column($something)' |
|
2528
|
|
|
|
|
|
|
) |
|
2529
|
89
|
|
33
|
|
|
220
|
) for values %{$ret->{join_free_condition}}; |
|
|
89
|
|
33
|
|
|
765
|
|
|
2530
|
|
|
|
|
|
|
|
|
2531
|
|
|
|
|
|
|
} |
|
2532
|
|
|
|
|
|
|
} |
|
2533
|
|
|
|
|
|
|
elsif (ref $rel_info->{cond} eq 'HASH') { |
|
2534
|
|
|
|
|
|
|
|
|
2535
|
|
|
|
|
|
|
# the condition is static - use parallel arrays |
|
2536
|
|
|
|
|
|
|
# for a "pivot" depending on which side of the |
|
2537
|
|
|
|
|
|
|
# rel did we get as an object |
|
2538
|
8804
|
|
|
|
|
17829
|
my (@f_cols, @l_cols); |
|
2539
|
8804
|
|
|
|
|
14798
|
for my $fc (keys %{ $rel_info->{cond} }) { |
|
|
8804
|
|
|
|
|
34688
|
|
|
2540
|
8898
|
|
|
|
|
24624
|
my $lc = $rel_info->{cond}{$fc}; |
|
2541
|
|
|
|
|
|
|
|
|
2542
|
|
|
|
|
|
|
# FIXME STRICTMODE should probably check these are valid columns |
|
2543
|
8898
|
50
|
|
|
|
50011
|
$fc =~ s/^foreign\.// || |
|
2544
|
|
|
|
|
|
|
$self->throw_exception("Invalid rel cond key '$fc'"); |
|
2545
|
|
|
|
|
|
|
|
|
2546
|
8898
|
50
|
|
|
|
41128
|
$lc =~ s/^self\.// || |
|
2547
|
|
|
|
|
|
|
$self->throw_exception("Invalid rel cond val '$lc'"); |
|
2548
|
|
|
|
|
|
|
|
|
2549
|
8898
|
|
|
|
|
23672
|
push @f_cols, $fc; |
|
2550
|
8898
|
|
|
|
|
24128
|
push @l_cols, $lc; |
|
2551
|
|
|
|
|
|
|
} |
|
2552
|
|
|
|
|
|
|
|
|
2553
|
|
|
|
|
|
|
# construct the crosstable condition and the identity map |
|
2554
|
8804
|
|
|
|
|
31692
|
for (0..$#f_cols) { |
|
2555
|
8898
|
|
|
|
|
60642
|
$ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" }; |
|
2556
|
|
|
|
|
|
|
|
|
2557
|
|
|
|
|
|
|
# explicit value stringification is deliberate - leave no room for |
|
2558
|
|
|
|
|
|
|
# interpretation when comparing sets of keys |
|
2559
|
8898
|
|
|
|
|
41692
|
$ret->{identity_map}{$l_cols[$_]} = "$f_cols[$_]"; |
|
2560
|
|
|
|
|
|
|
}; |
|
2561
|
|
|
|
|
|
|
|
|
2562
|
8804
|
100
|
|
|
|
38578
|
if ($args->{foreign_values}) { |
|
|
|
100
|
|
|
|
|
|
|
2563
|
|
|
|
|
|
|
$ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} |
|
2564
|
|
|
|
|
|
|
= $ret->{join_free_values}{$l_cols[$_]} |
|
2565
|
|
|
|
|
|
|
= $args->{foreign_values}{$f_cols[$_]} |
|
2566
|
611
|
|
|
|
|
4695
|
for 0..$#f_cols; |
|
2567
|
|
|
|
|
|
|
} |
|
2568
|
|
|
|
|
|
|
elsif (defined $args->{self_result_object}) { |
|
2569
|
|
|
|
|
|
|
|
|
2570
|
|
|
|
|
|
|
# FIXME - compat block due to inconsistency of get_columns() vs has_column_loaded() |
|
2571
|
|
|
|
|
|
|
# The former returns cached-in related single rels, while the latter is doing what |
|
2572
|
|
|
|
|
|
|
# it says on the tin. Thus the more logical "get all columns and barf if something |
|
2573
|
|
|
|
|
|
|
# is missing" is a non-starter, and we move through each column one by one :/ |
|
2574
|
|
|
|
|
|
|
|
|
2575
|
|
|
|
|
|
|
$args->{self_result_object}->has_column_loaded( $l_cols[$_] ) |
|
2576
|
|
|
|
|
|
|
|
|
2577
|
|
|
|
|
|
|
? $ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$_]"} |
|
2578
|
|
|
|
|
|
|
= $ret->{join_free_values}{$f_cols[$_]} |
|
2579
|
|
|
|
|
|
|
= $args->{self_result_object}->get_column( $l_cols[$_] ) |
|
2580
|
|
|
|
|
|
|
|
|
2581
|
|
|
|
|
|
|
: $args->{self_result_object}->in_storage |
|
2582
|
|
|
|
|
|
|
|
|
2583
|
|
|
|
|
|
|
? $self->throw_exception(sprintf |
|
2584
|
|
|
|
|
|
|
"Unable to resolve relationship '%s' from object '%s': column '%s' not " |
|
2585
|
|
|
|
|
|
|
. 'loaded from storage (or not passed to new() prior to insert()). You ' |
|
2586
|
|
|
|
|
|
|
. 'probably need to call ->discard_changes to get the server-side defaults ' |
|
2587
|
|
|
|
|
|
|
. 'from the database', |
|
2588
|
|
|
|
|
|
|
$args->{rel_name}, |
|
2589
|
|
|
|
|
|
|
$args->{self_result_object}, |
|
2590
|
|
|
|
|
|
|
$l_cols[$_], |
|
2591
|
|
|
|
|
|
|
) |
|
2592
|
|
|
|
|
|
|
|
|
2593
|
|
|
|
|
|
|
# non-resolvable yet not in storage - give it a pass |
|
2594
|
|
|
|
|
|
|
# FIXME - while this is what the code has done for ages, it doesn't seem right :( |
|
2595
|
|
|
|
|
|
|
: ( |
|
2596
|
|
|
|
|
|
|
delete $ret->{join_free_condition}, |
|
2597
|
|
|
|
|
|
|
delete $ret->{join_free_values}, |
|
2598
|
|
|
|
|
|
|
last |
|
2599
|
|
|
|
|
|
|
) |
|
2600
|
|
|
|
|
|
|
|
|
2601
|
3467
|
100
|
|
|
|
20929
|
for 0 .. $#l_cols; |
|
|
|
100
|
|
|
|
|
|
|
2602
|
|
|
|
|
|
|
} |
|
2603
|
|
|
|
|
|
|
} |
|
2604
|
|
|
|
|
|
|
elsif (ref $rel_info->{cond} eq 'ARRAY') { |
|
2605
|
20
|
50
|
|
|
|
49
|
if (@{ $rel_info->{cond} } == 0) { |
|
|
20
|
|
|
|
|
787
|
|
|
2606
|
0
|
|
|
|
|
0
|
$ret = { |
|
2607
|
|
|
|
|
|
|
condition => UNRESOLVABLE_CONDITION, |
|
2608
|
|
|
|
|
|
|
}; |
|
2609
|
|
|
|
|
|
|
} |
|
2610
|
|
|
|
|
|
|
else { |
|
2611
|
|
|
|
|
|
|
my @subconds = map { |
|
2612
|
40
|
|
|
|
|
443
|
local $rel_info->{cond} = $_; |
|
2613
|
40
|
|
|
|
|
309
|
$self->resolve_relationship_condition( $args ); |
|
2614
|
20
|
|
|
|
|
50
|
} @{ $rel_info->{cond} }; |
|
|
20
|
|
|
|
|
64
|
|
|
2615
|
|
|
|
|
|
|
|
|
2616
|
20
|
50
|
|
|
|
51
|
if( @{ $rel_info->{cond} } == 1 ) { |
|
|
20
|
|
|
|
|
84
|
|
|
2617
|
0
|
|
|
|
|
0
|
$ret = $subconds[0]; |
|
2618
|
|
|
|
|
|
|
} |
|
2619
|
|
|
|
|
|
|
else { |
|
2620
|
20
|
|
|
|
|
58
|
for my $subcond ( @subconds ) { |
|
2621
|
|
|
|
|
|
|
$self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition') |
|
2622
|
40
|
50
|
50
|
|
|
230
|
if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) ); |
|
|
|
|
66
|
|
|
|
|
|
2623
|
|
|
|
|
|
|
|
|
2624
|
|
|
|
|
|
|
# we are discarding join_free_values from individual 'OR' branches here |
|
2625
|
|
|
|
|
|
|
# see @nonvalues checks below |
|
2626
|
40
|
|
66
|
|
|
128
|
$subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition)); |
|
|
66
|
|
|
|
|
286
|
|
|
2627
|
|
|
|
|
|
|
} |
|
2628
|
|
|
|
|
|
|
} |
|
2629
|
|
|
|
|
|
|
} |
|
2630
|
|
|
|
|
|
|
} |
|
2631
|
|
|
|
|
|
|
else { |
|
2632
|
0
|
|
|
|
|
0
|
$self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :("); |
|
2633
|
|
|
|
|
|
|
} |
|
2634
|
|
|
|
|
|
|
|
|
2635
|
|
|
|
|
|
|
|
|
2636
|
|
|
|
|
|
|
# Explicit normalization pass |
|
2637
|
|
|
|
|
|
|
# ( nobody really knows what a CODE can return ) |
|
2638
|
|
|
|
|
|
|
# Explicitly leave U_C alone - it would be normalized |
|
2639
|
|
|
|
|
|
|
# to an { -and => [ U_C ] } |
|
2640
|
|
|
|
|
|
|
defined $ret->{$_} |
|
2641
|
|
|
|
|
|
|
and |
|
2642
|
|
|
|
|
|
|
$ret->{$_} ne UNRESOLVABLE_CONDITION |
|
2643
|
|
|
|
|
|
|
and |
|
2644
|
|
|
|
|
|
|
$ret->{$_} = normalize_sqla_condition($ret->{$_}) |
|
2645
|
10082
|
|
66
|
|
|
102151
|
for qw(condition join_free_condition); |
|
|
|
|
66
|
|
|
|
|
|
2646
|
|
|
|
|
|
|
|
|
2647
|
|
|
|
|
|
|
|
|
2648
|
10082
|
100
|
100
|
|
|
39138
|
if ( |
|
2649
|
|
|
|
|
|
|
$args->{require_join_free_condition} |
|
2650
|
|
|
|
|
|
|
and |
|
2651
|
|
|
|
|
|
|
! defined $ret->{join_free_condition} |
|
2652
|
|
|
|
|
|
|
) { |
|
2653
|
|
|
|
|
|
|
$self->throw_exception( |
|
2654
|
|
|
|
|
|
|
ucfirst sprintf "$exception_rel_id does not resolve to a %sjoin-free condition fragment", |
|
2655
|
|
|
|
|
|
|
exists $args->{foreign_values} |
|
2656
|
4
|
100
|
|
|
|
40
|
? "'foreign_values'-based reversed-" |
|
2657
|
|
|
|
|
|
|
: '' |
|
2658
|
|
|
|
|
|
|
); |
|
2659
|
|
|
|
|
|
|
} |
|
2660
|
|
|
|
|
|
|
|
|
2661
|
|
|
|
|
|
|
# we got something back (not from a static cond) - sanity check and infer values if we can |
|
2662
|
|
|
|
|
|
|
# ( in case of a static cond join_free_values is already pre-populated for us ) |
|
2663
|
10078
|
|
|
|
|
18288
|
my @nonvalues; |
|
2664
|
10078
|
100
|
100
|
|
|
35118
|
if( |
|
2665
|
|
|
|
|
|
|
$ret->{join_free_condition} |
|
2666
|
|
|
|
|
|
|
and |
|
2667
|
|
|
|
|
|
|
! $ret->{join_free_values} |
|
2668
|
|
|
|
|
|
|
) { |
|
2669
|
|
|
|
|
|
|
|
|
2670
|
|
|
|
|
|
|
my $jfc_eqs = extract_equality_conditions( |
|
2671
|
|
|
|
|
|
|
$ret->{join_free_condition}, |
|
2672
|
102
|
|
|
|
|
476
|
'consider_nulls' |
|
2673
|
|
|
|
|
|
|
); |
|
2674
|
|
|
|
|
|
|
|
|
2675
|
102
|
|
|
|
|
241
|
for( keys %{ $ret->{join_free_condition} } ) { |
|
|
102
|
|
|
|
|
367
|
|
|
2676
|
115
|
100
|
|
|
|
407
|
if( $_ =~ /^-/ ) { |
|
2677
|
12
|
|
|
|
|
51
|
push @nonvalues, { $_ => $ret->{join_free_condition}{$_} }; |
|
2678
|
|
|
|
|
|
|
} |
|
2679
|
|
|
|
|
|
|
else { |
|
2680
|
|
|
|
|
|
|
# a join_free_condition is fully qualified by definition |
|
2681
|
103
|
50
|
|
|
|
710
|
my ($col) = $_ =~ /\.(.+)/ or carp_unique( |
|
2682
|
|
|
|
|
|
|
'Internal error - extract_equality_conditions() returned a ' |
|
2683
|
|
|
|
|
|
|
. "non-fully-qualified key '$_'. *Please* file a bugreport " |
|
2684
|
|
|
|
|
|
|
. "including your definition of $exception_rel_id" |
|
2685
|
|
|
|
|
|
|
); |
|
2686
|
|
|
|
|
|
|
|
|
2687
|
103
|
100
|
100
|
|
|
732
|
if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) { |
|
|
|
|
66
|
|
|
|
|
|
2688
|
92
|
|
|
|
|
463
|
$ret->{join_free_values}{$col} = $jfc_eqs->{$_}; |
|
2689
|
|
|
|
|
|
|
} |
|
2690
|
|
|
|
|
|
|
else { |
|
2691
|
11
|
|
|
|
|
35
|
push @nonvalues, { $_ => $ret->{join_free_condition}{$_} }; |
|
2692
|
|
|
|
|
|
|
} |
|
2693
|
|
|
|
|
|
|
} |
|
2694
|
|
|
|
|
|
|
} |
|
2695
|
|
|
|
|
|
|
|
|
2696
|
|
|
|
|
|
|
# all or nothing |
|
2697
|
102
|
100
|
|
|
|
430
|
delete $ret->{join_free_values} if @nonvalues; |
|
2698
|
|
|
|
|
|
|
} |
|
2699
|
|
|
|
|
|
|
|
|
2700
|
|
|
|
|
|
|
|
|
2701
|
|
|
|
|
|
|
# throw only if the user explicitly asked |
|
2702
|
|
|
|
|
|
|
$args->{require_join_free_values} |
|
2703
|
|
|
|
|
|
|
and |
|
2704
|
|
|
|
|
|
|
@nonvalues |
|
2705
|
|
|
|
|
|
|
and |
|
2706
|
|
|
|
|
|
|
$self->throw_exception( |
|
2707
|
|
|
|
|
|
|
"Unable to complete value inferrence - $exception_rel_id results in expression(s) instead of definitive values: " |
|
2708
|
10078
|
100
|
100
|
|
|
29952
|
. do { |
|
2709
|
|
|
|
|
|
|
# FIXME - used for diag only, but still icky |
|
2710
|
|
|
|
|
|
|
my $sqlm = |
|
2711
|
2
|
|
|
2
|
|
9
|
dbic_internal_try { $self->schema->storage->sql_maker } |
|
2712
|
|
|
|
|
|
|
|| |
|
2713
|
|
|
|
|
|
|
( |
|
2714
|
|
|
|
|
|
|
require DBIx::Class::SQLMaker |
|
2715
|
|
|
|
|
|
|
and |
|
2716
|
2
|
|
33
|
|
|
17
|
DBIx::Class::SQLMaker->new |
|
2717
|
|
|
|
|
|
|
) |
|
2718
|
|
|
|
|
|
|
; |
|
2719
|
2
|
|
|
|
|
12
|
local $sqlm->{quote_char}; |
|
2720
|
2
|
|
|
|
|
6
|
local $sqlm->{_dequalify_idents} = 1; |
|
2721
|
2
|
|
|
|
|
15
|
($sqlm->_recurse_where({ -and => \@nonvalues }))[0] |
|
2722
|
|
|
|
|
|
|
} |
|
2723
|
|
|
|
|
|
|
); |
|
2724
|
|
|
|
|
|
|
|
|
2725
|
|
|
|
|
|
|
|
|
2726
|
10076
|
|
|
|
|
17353
|
my $identity_map_incomplete; |
|
2727
|
|
|
|
|
|
|
|
|
2728
|
|
|
|
|
|
|
# add the identities based on the main condition |
|
2729
|
|
|
|
|
|
|
# (may already be there, since easy to calculate on the fly in the HASH case) |
|
2730
|
10076
|
100
|
|
|
|
26523
|
if ( ! $ret->{identity_map} ) { |
|
2731
|
|
|
|
|
|
|
|
|
2732
|
1274
|
|
|
|
|
5283
|
my $col_eqs = extract_equality_conditions($ret->{condition}); |
|
2733
|
|
|
|
|
|
|
|
|
2734
|
|
|
|
|
|
|
$identity_map_incomplete++ if ( |
|
2735
|
|
|
|
|
|
|
$ret->{condition} eq UNRESOLVABLE_CONDITION |
|
2736
|
|
|
|
|
|
|
or |
|
2737
|
|
|
|
|
|
|
( |
|
2738
|
1274
|
100
|
66
|
|
|
5943
|
keys %{$ret->{condition}} |
|
|
1274
|
|
|
|
|
6184
|
|
|
2739
|
|
|
|
|
|
|
!= |
|
2740
|
|
|
|
|
|
|
keys %$col_eqs |
|
2741
|
|
|
|
|
|
|
) |
|
2742
|
|
|
|
|
|
|
); |
|
2743
|
|
|
|
|
|
|
|
|
2744
|
1274
|
|
|
|
|
2470
|
my $colinfos; |
|
2745
|
1274
|
|
|
|
|
3773
|
for my $lhs (keys %$col_eqs) { |
|
2746
|
|
|
|
|
|
|
|
|
2747
|
|
|
|
|
|
|
# start with the assumption it won't work |
|
2748
|
1281
|
|
|
|
|
3437
|
$identity_map_incomplete++; |
|
2749
|
|
|
|
|
|
|
|
|
2750
|
1281
|
50
|
|
|
|
4077
|
next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION; |
|
2751
|
|
|
|
|
|
|
|
|
2752
|
|
|
|
|
|
|
# there is no way to know who is right and who is left in a cref |
|
2753
|
|
|
|
|
|
|
# therefore a full blown resolution call, and figure out the |
|
2754
|
|
|
|
|
|
|
# direction a bit further below |
|
2755
|
|
|
|
|
|
|
$colinfos ||= fromspec_columns_info([ |
|
2756
|
|
|
|
|
|
|
{ -alias => $args->{self_alias}, -rsrc => $self }, |
|
2757
|
1281
|
|
66
|
|
|
11747
|
{ -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc }, |
|
2758
|
|
|
|
|
|
|
]); |
|
2759
|
|
|
|
|
|
|
|
|
2760
|
1281
|
50
|
|
|
|
5327
|
next unless $colinfos->{$lhs}; # someone is engaging in witchcraft |
|
2761
|
|
|
|
|
|
|
|
|
2762
|
1281
|
100
|
66
|
|
|
6403
|
if( my $rhs_ref = |
|
|
|
100
|
50
|
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
2763
|
|
|
|
|
|
|
( |
|
2764
|
|
|
|
|
|
|
ref $col_eqs->{$lhs} eq 'HASH' |
|
2765
|
|
|
|
|
|
|
and |
|
2766
|
|
|
|
|
|
|
keys %{$col_eqs->{$lhs}} == 1 |
|
2767
|
|
|
|
|
|
|
and |
|
2768
|
|
|
|
|
|
|
exists $col_eqs->{$lhs}{-ident} |
|
2769
|
|
|
|
|
|
|
) |
|
2770
|
|
|
|
|
|
|
? [ $col_eqs->{$lhs}{-ident} ] # repack to match the RV of is_literal_value |
|
2771
|
|
|
|
|
|
|
: is_literal_value( $col_eqs->{$lhs} ) |
|
2772
|
|
|
|
|
|
|
) { |
|
2773
|
1179
|
100
|
66
|
|
|
11634
|
if ( |
|
2774
|
|
|
|
|
|
|
$colinfos->{$rhs_ref->[0]} |
|
2775
|
|
|
|
|
|
|
and |
|
2776
|
|
|
|
|
|
|
$colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias} |
|
2777
|
|
|
|
|
|
|
) { |
|
2778
|
|
|
|
|
|
|
( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} ) |
|
2779
|
|
|
|
|
|
|
|
|
2780
|
|
|
|
|
|
|
# explicit value stringification is deliberate - leave no room for |
|
2781
|
|
|
|
|
|
|
# interpretation when comparing sets of keys |
|
2782
|
|
|
|
|
|
|
? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = "$colinfos->{$rhs_ref->[0]}{-colname}" ) |
|
2783
|
966
|
50
|
|
|
|
5805
|
: ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = "$colinfos->{$lhs}{-colname}" ) |
|
2784
|
|
|
|
|
|
|
; |
|
2785
|
|
|
|
|
|
|
|
|
2786
|
|
|
|
|
|
|
# well, what do you know! |
|
2787
|
966
|
|
|
|
|
11198
|
$identity_map_incomplete--; |
|
2788
|
|
|
|
|
|
|
} |
|
2789
|
|
|
|
|
|
|
} |
|
2790
|
|
|
|
|
|
|
elsif ( |
|
2791
|
|
|
|
|
|
|
$col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x |
|
2792
|
|
|
|
|
|
|
and |
|
2793
|
|
|
|
|
|
|
($colinfos->{$1}||{})->{-result_source} == $rel_rsrc |
|
2794
|
|
|
|
|
|
|
) { |
|
2795
|
|
|
|
|
|
|
my ($lcol, $rcol) = map |
|
2796
|
2
|
|
|
|
|
54
|
{ $colinfos->{$_}{-colname} } |
|
|
4
|
|
|
|
|
11
|
|
|
2797
|
|
|
|
|
|
|
( $lhs, $1 ) |
|
2798
|
|
|
|
|
|
|
; |
|
2799
|
2
|
|
|
|
|
18
|
carp_unique( |
|
2800
|
|
|
|
|
|
|
"The $exception_rel_id specifies equality of column '$lcol' and the " |
|
2801
|
|
|
|
|
|
|
. "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)" |
|
2802
|
|
|
|
|
|
|
); |
|
2803
|
|
|
|
|
|
|
} |
|
2804
|
|
|
|
|
|
|
} |
|
2805
|
|
|
|
|
|
|
} |
|
2806
|
|
|
|
|
|
|
|
|
2807
|
|
|
|
|
|
|
$ret->{identity_map_matches_condition} = ($identity_map_incomplete ? 0 : 1) |
|
2808
|
10076
|
100
|
|
|
|
40504
|
if $ret->{identity_map}; |
|
|
|
100
|
|
|
|
|
|
|
2809
|
|
|
|
|
|
|
|
|
2810
|
|
|
|
|
|
|
|
|
2811
|
|
|
|
|
|
|
# cleanup before final return, easier to eyeball |
|
2812
|
|
|
|
|
|
|
! defined $ret->{$_} and delete $ret->{$_} |
|
2813
|
10076
|
|
66
|
|
|
64296
|
for keys %$ret; |
|
2814
|
|
|
|
|
|
|
|
|
2815
|
|
|
|
|
|
|
|
|
2816
|
|
|
|
|
|
|
# FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition |
|
2817
|
|
|
|
|
|
|
$ret->{condition} = { -and => [ $ret->{condition} ] } unless ( |
|
2818
|
|
|
|
|
|
|
$ret->{condition} eq UNRESOLVABLE_CONDITION |
|
2819
|
|
|
|
|
|
|
or |
|
2820
|
|
|
|
|
|
|
( |
|
2821
|
|
|
|
|
|
|
ref $ret->{condition} eq 'HASH' |
|
2822
|
|
|
|
|
|
|
and |
|
2823
|
10076
|
100
|
66
|
|
|
56175
|
grep { $_ =~ /^-/ } keys %{$ret->{condition}} |
|
|
10628
|
|
66
|
|
|
70644
|
|
|
|
10076
|
|
|
|
|
38780
|
|
|
2824
|
|
|
|
|
|
|
) |
|
2825
|
|
|
|
|
|
|
); |
|
2826
|
|
|
|
|
|
|
|
|
2827
|
|
|
|
|
|
|
|
|
2828
|
10076
|
|
|
|
|
20271
|
if( DBIx::Class::_ENV_::ASSERT_NO_INCONSISTENT_RELATIONSHIP_RESOLUTION ) { |
|
2829
|
|
|
|
|
|
|
|
|
2830
|
|
|
|
|
|
|
my $sqlm = |
|
2831
|
0
|
|
|
0
|
|
0
|
dbic_internal_try { $self->schema->storage->sql_maker } |
|
2832
|
|
|
|
|
|
|
|| |
|
2833
|
|
|
|
|
|
|
( |
|
2834
|
|
|
|
|
|
|
require DBIx::Class::SQLMaker |
|
2835
|
|
|
|
|
|
|
and |
|
2836
|
|
|
|
|
|
|
DBIx::Class::SQLMaker->new |
|
2837
|
|
|
|
|
|
|
) |
|
2838
|
|
|
|
|
|
|
; |
|
2839
|
|
|
|
|
|
|
|
|
2840
|
|
|
|
|
|
|
local $sqlm->{_dequalify_idents} = 1; |
|
2841
|
|
|
|
|
|
|
|
|
2842
|
|
|
|
|
|
|
my ( $cond_as_sql, $jf_cond_as_sql, $jf_vals_as_sql, $identmap_as_sql ) = map |
|
2843
|
|
|
|
|
|
|
{ join ' : ', map { |
|
2844
|
|
|
|
|
|
|
ref $_ eq 'ARRAY' ? $_->[1] |
|
2845
|
|
|
|
|
|
|
: defined $_ ? $_ |
|
2846
|
|
|
|
|
|
|
: '{UNDEF}' |
|
2847
|
|
|
|
|
|
|
} $sqlm->_recurse_where($_) } |
|
2848
|
|
|
|
|
|
|
( |
|
2849
|
|
|
|
|
|
|
( map { $ret->{$_} } qw( condition join_free_condition join_free_values ) ), |
|
2850
|
|
|
|
|
|
|
|
|
2851
|
|
|
|
|
|
|
{ map { |
|
2852
|
|
|
|
|
|
|
# inverse because of how the idmap is declared |
|
2853
|
|
|
|
|
|
|
$ret->{identity_map}{$_} => { -ident => $_ } |
|
2854
|
|
|
|
|
|
|
} keys %{$ret->{identity_map}} }, |
|
2855
|
|
|
|
|
|
|
) |
|
2856
|
|
|
|
|
|
|
; |
|
2857
|
|
|
|
|
|
|
|
|
2858
|
|
|
|
|
|
|
|
|
2859
|
|
|
|
|
|
|
emit_loud_diag( |
|
2860
|
|
|
|
|
|
|
confess => 1, |
|
2861
|
|
|
|
|
|
|
msg => sprintf ( |
|
2862
|
|
|
|
|
|
|
"Resolution of %s produced inconsistent metadata:\n\n" |
|
2863
|
|
|
|
|
|
|
. "returned value of 'identity_map_matches_condition': %s\n" |
|
2864
|
|
|
|
|
|
|
. "returned 'condition' rendered as de-qualified SQL: %s\n" |
|
2865
|
|
|
|
|
|
|
. "returned 'identity_map' rendered as de-qualified SQL: %s\n\n" |
|
2866
|
|
|
|
|
|
|
. "The condition declared on the misclassified relationship is: %s ", |
|
2867
|
|
|
|
|
|
|
$exception_rel_id, |
|
2868
|
|
|
|
|
|
|
( $ret->{identity_map_matches_condition} || 0 ), |
|
2869
|
|
|
|
|
|
|
$cond_as_sql, |
|
2870
|
|
|
|
|
|
|
$identmap_as_sql, |
|
2871
|
|
|
|
|
|
|
dump_value( $rel_info->{cond} ), |
|
2872
|
|
|
|
|
|
|
), |
|
2873
|
|
|
|
|
|
|
) if ( |
|
2874
|
|
|
|
|
|
|
$ret->{identity_map_matches_condition} |
|
2875
|
|
|
|
|
|
|
xor |
|
2876
|
|
|
|
|
|
|
( $cond_as_sql eq $identmap_as_sql ) |
|
2877
|
|
|
|
|
|
|
); |
|
2878
|
|
|
|
|
|
|
|
|
2879
|
|
|
|
|
|
|
|
|
2880
|
|
|
|
|
|
|
emit_loud_diag( |
|
2881
|
|
|
|
|
|
|
confess => 1, |
|
2882
|
|
|
|
|
|
|
msg => sprintf ( |
|
2883
|
|
|
|
|
|
|
"Resolution of %s produced inconsistent metadata:\n\n" |
|
2884
|
|
|
|
|
|
|
. "returned 'join_free_condition' rendered as de-qualified SQL: %s\n" |
|
2885
|
|
|
|
|
|
|
. "returned 'join_free_values' rendered as de-qualified SQL: %s\n\n" |
|
2886
|
|
|
|
|
|
|
. "The condition declared on the misclassified relationship is: %s ", |
|
2887
|
|
|
|
|
|
|
$exception_rel_id, |
|
2888
|
|
|
|
|
|
|
$jf_cond_as_sql, |
|
2889
|
|
|
|
|
|
|
$jf_vals_as_sql, |
|
2890
|
|
|
|
|
|
|
dump_value( $rel_info->{cond} ), |
|
2891
|
|
|
|
|
|
|
), |
|
2892
|
|
|
|
|
|
|
) if ( |
|
2893
|
|
|
|
|
|
|
exists $ret->{join_free_condition} |
|
2894
|
|
|
|
|
|
|
and |
|
2895
|
|
|
|
|
|
|
( |
|
2896
|
|
|
|
|
|
|
exists $ret->{join_free_values} |
|
2897
|
|
|
|
|
|
|
xor |
|
2898
|
|
|
|
|
|
|
( $jf_cond_as_sql eq $jf_vals_as_sql ) |
|
2899
|
|
|
|
|
|
|
) |
|
2900
|
|
|
|
|
|
|
); |
|
2901
|
|
|
|
|
|
|
} |
|
2902
|
|
|
|
|
|
|
|
|
2903
|
10076
|
|
|
|
|
73109
|
$ret; |
|
2904
|
|
|
|
|
|
|
} |
|
2905
|
|
|
|
|
|
|
|
|
2906
|
|
|
|
|
|
|
=head2 related_source |
|
2907
|
|
|
|
|
|
|
|
|
2908
|
|
|
|
|
|
|
=over 4 |
|
2909
|
|
|
|
|
|
|
|
|
2910
|
|
|
|
|
|
|
=item Arguments: $rel_name |
|
2911
|
|
|
|
|
|
|
|
|
2912
|
|
|
|
|
|
|
=item Return Value: $source |
|
2913
|
|
|
|
|
|
|
|
|
2914
|
|
|
|
|
|
|
=back |
|
2915
|
|
|
|
|
|
|
|
|
2916
|
|
|
|
|
|
|
Returns the result source object for the given relationship. |
|
2917
|
|
|
|
|
|
|
|
|
2918
|
|
|
|
|
|
|
=cut |
|
2919
|
|
|
|
|
|
|
|
|
2920
|
|
|
|
|
|
|
sub related_source { |
|
2921
|
27236
|
|
|
27236
|
1
|
69539
|
my ($self, $rel) = @_; |
|
2922
|
27236
|
100
|
|
|
|
523409
|
if( !$self->has_relationship( $rel ) ) { |
|
2923
|
1
|
|
|
|
|
38
|
$self->throw_exception("No such relationship '$rel' on " . $self->source_name); |
|
2924
|
|
|
|
|
|
|
} |
|
2925
|
|
|
|
|
|
|
|
|
2926
|
|
|
|
|
|
|
# if we are not registered with a schema - just use the prototype |
|
2927
|
|
|
|
|
|
|
# however if we do have a schema - ask for the source by name (and |
|
2928
|
|
|
|
|
|
|
# throw in the process if all fails) |
|
2929
|
27235
|
100
|
|
27235
|
|
166758
|
if (my $schema = dbic_internal_try { $self->schema }) { |
|
|
27235
|
|
|
|
|
69813
|
|
|
2930
|
27207
|
|
|
|
|
532795
|
$schema->source($self->relationship_info($rel)->{source}); |
|
2931
|
|
|
|
|
|
|
} |
|
2932
|
|
|
|
|
|
|
else { |
|
2933
|
28
|
|
|
|
|
722
|
my $class = $self->relationship_info($rel)->{class}; |
|
2934
|
28
|
|
|
|
|
144
|
$self->ensure_class_loaded($class); |
|
2935
|
28
|
|
|
|
|
490
|
$class->result_source; |
|
2936
|
|
|
|
|
|
|
} |
|
2937
|
|
|
|
|
|
|
} |
|
2938
|
|
|
|
|
|
|
|
|
2939
|
|
|
|
|
|
|
=head2 related_class |
|
2940
|
|
|
|
|
|
|
|
|
2941
|
|
|
|
|
|
|
=over 4 |
|
2942
|
|
|
|
|
|
|
|
|
2943
|
|
|
|
|
|
|
=item Arguments: $rel_name |
|
2944
|
|
|
|
|
|
|
|
|
2945
|
|
|
|
|
|
|
=item Return Value: $classname |
|
2946
|
|
|
|
|
|
|
|
|
2947
|
|
|
|
|
|
|
=back |
|
2948
|
|
|
|
|
|
|
|
|
2949
|
|
|
|
|
|
|
Returns the class name for objects in the given relationship. |
|
2950
|
|
|
|
|
|
|
|
|
2951
|
|
|
|
|
|
|
=cut |
|
2952
|
|
|
|
|
|
|
|
|
2953
|
|
|
|
|
|
|
sub related_class { |
|
2954
|
0
|
|
|
0
|
1
|
0
|
my ($self, $rel) = @_; |
|
2955
|
0
|
0
|
|
|
|
0
|
if( !$self->has_relationship( $rel ) ) { |
|
2956
|
0
|
|
|
|
|
0
|
$self->throw_exception("No such relationship '$rel' on " . $self->source_name); |
|
2957
|
|
|
|
|
|
|
} |
|
2958
|
0
|
|
|
|
|
0
|
return $self->schema->class($self->relationship_info($rel)->{source}); |
|
2959
|
|
|
|
|
|
|
} |
|
2960
|
|
|
|
|
|
|
|
|
2961
|
|
|
|
|
|
|
=head2 handle |
|
2962
|
|
|
|
|
|
|
|
|
2963
|
|
|
|
|
|
|
=over 4 |
|
2964
|
|
|
|
|
|
|
|
|
2965
|
|
|
|
|
|
|
=item Arguments: none |
|
2966
|
|
|
|
|
|
|
|
|
2967
|
|
|
|
|
|
|
=item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle> |
|
2968
|
|
|
|
|
|
|
|
|
2969
|
|
|
|
|
|
|
=back |
|
2970
|
|
|
|
|
|
|
|
|
2971
|
|
|
|
|
|
|
Obtain a new L |
|
2972
|
|
|
|
|
|
|
for this source. Used as a serializable pointer to this resultsource, as it is not |
|
2973
|
|
|
|
|
|
|
easy (nor advisable) to serialize CODErefs which may very well be present in e.g. |
|
2974
|
|
|
|
|
|
|
relationship definitions. |
|
2975
|
|
|
|
|
|
|
|
|
2976
|
|
|
|
|
|
|
=cut |
|
2977
|
|
|
|
|
|
|
|
|
2978
|
|
|
|
|
|
|
sub handle { |
|
2979
|
206
|
|
|
206
|
1
|
3630
|
require DBIx::Class::ResultSourceHandle; |
|
2980
|
|
|
|
|
|
|
return DBIx::Class::ResultSourceHandle->new({ |
|
2981
|
|
|
|
|
|
|
source_moniker => $_[0]->source_name, |
|
2982
|
|
|
|
|
|
|
|
|
2983
|
|
|
|
|
|
|
# so that a detached thaw can be re-frozen |
|
2984
|
|
|
|
|
|
|
$_[0]->{_detached_thaw} |
|
2985
|
206
|
50
|
|
|
|
4597
|
? ( _detached_source => $_[0] ) |
|
2986
|
|
|
|
|
|
|
: ( schema => $_[0]->schema ) |
|
2987
|
|
|
|
|
|
|
, |
|
2988
|
|
|
|
|
|
|
}); |
|
2989
|
|
|
|
|
|
|
} |
|
2990
|
|
|
|
|
|
|
|
|
2991
|
|
|
|
|
|
|
my $global_phase_destroy; |
|
2992
|
|
|
|
|
|
|
sub DESTROY { |
|
2993
|
|
|
|
|
|
|
### NO detected_reinvoked_destructor check |
|
2994
|
|
|
|
|
|
|
### This code very much relies on being called multuple times |
|
2995
|
|
|
|
|
|
|
|
|
2996
|
67862
|
50
|
33
|
67862
|
|
1641325
|
return if $global_phase_destroy ||= in_global_destruction; |
|
2997
|
|
|
|
|
|
|
|
|
2998
|
|
|
|
|
|
|
###### |
|
2999
|
|
|
|
|
|
|
# !!! ACHTUNG !!!! |
|
3000
|
|
|
|
|
|
|
###### |
|
3001
|
|
|
|
|
|
|
# |
|
3002
|
|
|
|
|
|
|
# Under no circumstances shall $_[0] be stored anywhere else (like copied to |
|
3003
|
|
|
|
|
|
|
# a lexical variable, or shifted, or anything else). Doing so will mess up |
|
3004
|
|
|
|
|
|
|
# the refcount of this particular result source, and will allow the $schema |
|
3005
|
|
|
|
|
|
|
# we are trying to save to reattach back to the source we are destroying. |
|
3006
|
|
|
|
|
|
|
# The relevant code checking refcounts is in ::Schema::DESTROY() |
|
3007
|
|
|
|
|
|
|
|
|
3008
|
|
|
|
|
|
|
# if we are not a schema instance holder - we don't matter |
|
3009
|
|
|
|
|
|
|
return if( |
|
3010
|
|
|
|
|
|
|
! ref $_[0]->{schema} |
|
3011
|
|
|
|
|
|
|
or |
|
3012
|
|
|
|
|
|
|
isweak $_[0]->{schema} |
|
3013
|
67862
|
100
|
100
|
|
|
1286535
|
); |
|
3014
|
|
|
|
|
|
|
|
|
3015
|
|
|
|
|
|
|
# weaken our schema hold forcing the schema to find somewhere else to live |
|
3016
|
|
|
|
|
|
|
# during global destruction (if we have not yet bailed out) this will throw |
|
3017
|
|
|
|
|
|
|
# which will serve as a signal to not try doing anything else |
|
3018
|
|
|
|
|
|
|
# however beware - on older perls the exception seems randomly untrappable |
|
3019
|
|
|
|
|
|
|
# due to some weird race condition during thread joining :((( |
|
3020
|
46
|
50
|
|
|
|
232
|
local $SIG{__DIE__} if $SIG{__DIE__}; |
|
3021
|
46
|
|
|
|
|
94
|
local $@ if DBIx::Class::_ENV_::UNSTABLE_DOLLARAT; |
|
3022
|
|
|
|
|
|
|
eval { |
|
3023
|
46
|
|
|
|
|
242
|
weaken $_[0]->{schema}; |
|
3024
|
|
|
|
|
|
|
|
|
3025
|
|
|
|
|
|
|
# if schema is still there reintroduce ourselves with strong refs back to us |
|
3026
|
46
|
100
|
|
|
|
406
|
if ($_[0]->{schema}) { |
|
3027
|
33
|
|
|
|
|
746
|
my $srcregs = $_[0]->{schema}->source_registrations; |
|
3028
|
|
|
|
|
|
|
|
|
3029
|
|
|
|
|
|
|
defined $srcregs->{$_} |
|
3030
|
|
|
|
|
|
|
and |
|
3031
|
|
|
|
|
|
|
$srcregs->{$_} == $_[0] |
|
3032
|
|
|
|
|
|
|
and |
|
3033
|
|
|
|
|
|
|
$srcregs->{$_} = $_[0] |
|
3034
|
|
|
|
|
|
|
and |
|
3035
|
|
|
|
|
|
|
last |
|
3036
|
33
|
|
66
|
|
|
3821
|
for keys %$srcregs; |
|
|
|
|
66
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3037
|
|
|
|
|
|
|
} |
|
3038
|
|
|
|
|
|
|
|
|
3039
|
46
|
|
|
|
|
254
|
1; |
|
3040
|
46
|
50
|
|
|
|
102
|
} or do { |
|
3041
|
0
|
|
|
|
|
0
|
$global_phase_destroy = 1; |
|
3042
|
|
|
|
|
|
|
}; |
|
3043
|
|
|
|
|
|
|
|
|
3044
|
|
|
|
|
|
|
# Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage |
|
3045
|
|
|
|
|
|
|
# collected before leaving this scope. Depending on the code above, this |
|
3046
|
|
|
|
|
|
|
# may very well be just a preventive measure guarding future modifications |
|
3047
|
46
|
|
|
|
|
871
|
undef; |
|
3048
|
|
|
|
|
|
|
} |
|
3049
|
|
|
|
|
|
|
|
|
3050
|
204
|
|
|
204
|
0
|
9670
|
sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) } |
|
3051
|
|
|
|
|
|
|
|
|
3052
|
|
|
|
|
|
|
sub STORABLE_thaw { |
|
3053
|
196
|
|
|
196
|
0
|
4202
|
my ($self, $cloning, $ice) = @_; |
|
3054
|
196
|
|
|
|
|
304
|
%$self = %{ (Storable::thaw($ice))->resolve }; |
|
|
196
|
|
|
|
|
442
|
|
|
3055
|
|
|
|
|
|
|
} |
|
3056
|
|
|
|
|
|
|
|
|
3057
|
|
|
|
|
|
|
=head2 throw_exception |
|
3058
|
|
|
|
|
|
|
|
|
3059
|
|
|
|
|
|
|
See L. |
|
3060
|
|
|
|
|
|
|
|
|
3061
|
|
|
|
|
|
|
=cut |
|
3062
|
|
|
|
|
|
|
|
|
3063
|
|
|
|
|
|
|
sub throw_exception { |
|
3064
|
2074
|
|
|
2074
|
1
|
5244
|
my $self = shift; |
|
3065
|
|
|
|
|
|
|
|
|
3066
|
|
|
|
|
|
|
$self->{schema} |
|
3067
|
2074
|
100
|
|
|
|
15306
|
? $self->{schema}->throw_exception(@_) |
|
3068
|
|
|
|
|
|
|
: DBIx::Class::Exception->throw(@_) |
|
3069
|
|
|
|
|
|
|
; |
|
3070
|
|
|
|
|
|
|
} |
|
3071
|
|
|
|
|
|
|
|
|
3072
|
|
|
|
|
|
|
=head2 column_info_from_storage |
|
3073
|
|
|
|
|
|
|
|
|
3074
|
|
|
|
|
|
|
=over |
|
3075
|
|
|
|
|
|
|
|
|
3076
|
|
|
|
|
|
|
=item Arguments: 1/0 (default: 0) |
|
3077
|
|
|
|
|
|
|
|
|
3078
|
|
|
|
|
|
|
=item Return Value: 1/0 |
|
3079
|
|
|
|
|
|
|
|
|
3080
|
|
|
|
|
|
|
=back |
|
3081
|
|
|
|
|
|
|
|
|
3082
|
|
|
|
|
|
|
__PACKAGE__->column_info_from_storage(1); |
|
3083
|
|
|
|
|
|
|
|
|
3084
|
|
|
|
|
|
|
Enables the on-demand automatic loading of the above column |
|
3085
|
|
|
|
|
|
|
metadata from storage as necessary. This is *deprecated*, and |
|
3086
|
|
|
|
|
|
|
should not be used. It will be removed before 1.0. |
|
3087
|
|
|
|
|
|
|
|
|
3088
|
|
|
|
|
|
|
=head1 FURTHER QUESTIONS? |
|
3089
|
|
|
|
|
|
|
|
|
3090
|
|
|
|
|
|
|
Check the list of L. |
|
3091
|
|
|
|
|
|
|
|
|
3092
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
|
3093
|
|
|
|
|
|
|
|
|
3094
|
|
|
|
|
|
|
This module is free software L |
|
3095
|
|
|
|
|
|
|
by the L. You can |
|
3096
|
|
|
|
|
|
|
redistribute it and/or modify it under the same terms as the |
|
3097
|
|
|
|
|
|
|
L. |
|
3098
|
|
|
|
|
|
|
|
|
3099
|
|
|
|
|
|
|
=cut |
|
3100
|
|
|
|
|
|
|
|
|
3101
|
|
|
|
|
|
|
1; |