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; |