is replaced with the table name.
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
Throws an error if any of the given column names do not yet exist on |
796
|
|
|
|
|
|
|
the result source. |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
See also L. |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
=cut |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
sub add_unique_constraints { |
803
|
650
|
|
|
650
|
1
|
191811
|
my $self = shift; |
804
|
650
|
|
|
|
|
1461
|
my @constraints = @_; |
805
|
|
|
|
|
|
|
|
806
|
650
|
100
|
66
|
975
|
|
4752
|
if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) { |
|
975
|
|
|
|
|
3259
|
|
807
|
|
|
|
|
|
|
# with constraint name |
808
|
325
|
|
|
|
|
1970
|
while (my ($name, $constraint) = splice @constraints, 0, 2) { |
809
|
650
|
|
|
|
|
1328
|
$self->add_unique_constraint($name => $constraint); |
810
|
|
|
|
|
|
|
} |
811
|
|
|
|
|
|
|
} |
812
|
|
|
|
|
|
|
else { |
813
|
|
|
|
|
|
|
# no constraint name |
814
|
325
|
|
|
|
|
873
|
foreach my $constraint (@constraints) { |
815
|
650
|
|
|
|
|
1350
|
$self->add_unique_constraint($constraint); |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
} |
818
|
|
|
|
|
|
|
} |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
=head2 name_unique_constraint |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
=over 4 |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
=item Arguments: \@colnames |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
=item Return Value: Constraint name |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
=back |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
$source->table('mytable'); |
831
|
|
|
|
|
|
|
$source->name_unique_constraint(['col1', 'col2']); |
832
|
|
|
|
|
|
|
# returns |
833
|
|
|
|
|
|
|
'mytable_col1_col2' |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
Return a name for a unique constraint containing the specified |
836
|
|
|
|
|
|
|
columns. The name is created by joining the table name and each column |
837
|
|
|
|
|
|
|
name, using an underscore character. |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
For example, a constraint on a table named C containing the columns |
840
|
|
|
|
|
|
|
C and C would result in a constraint name of C. |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
This is used by L if you do not specify the |
843
|
|
|
|
|
|
|
optional constraint name. |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
=cut |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
sub name_unique_constraint { |
848
|
3387
|
|
|
3387
|
1
|
9114
|
my ($self, $cols) = @_; |
849
|
|
|
|
|
|
|
|
850
|
3387
|
|
|
|
|
13924
|
my $name = $self->name; |
851
|
3387
|
100
|
|
|
|
8579
|
$name = $$name if (ref $name eq 'SCALAR'); |
852
|
3387
|
|
|
|
|
10139
|
$name =~ s/ ^ [^\.]+ \. //x; # strip possible schema qualifier |
853
|
|
|
|
|
|
|
|
854
|
3387
|
|
|
|
|
13974
|
return join '_', $name, @$cols; |
855
|
|
|
|
|
|
|
} |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=head2 unique_constraints |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
=over 4 |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
=item Arguments: none |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
=item Return Value: Hash of unique constraint data |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
=back |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
$source->unique_constraints(); |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
Read-only accessor which returns a hash of unique constraints on this |
870
|
|
|
|
|
|
|
source. |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
The hash is keyed by constraint name, and contains an arrayref of |
873
|
|
|
|
|
|
|
column names as values. |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
=cut |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
sub unique_constraints { |
878
|
29577
|
100
|
|
29577
|
1
|
25090
|
return %{shift->_unique_constraints||{}}; |
|
29577
|
|
|
|
|
179662
|
|
879
|
|
|
|
|
|
|
} |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
=head2 unique_constraint_names |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
=over 4 |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=item Arguments: none |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
=item Return Value: Unique constraint names |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
=back |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
$source->unique_constraint_names(); |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
Returns the list of unique constraint names defined on this source. |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
=cut |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
sub unique_constraint_names { |
898
|
1144
|
|
|
1144
|
1
|
1750
|
my ($self) = @_; |
899
|
|
|
|
|
|
|
|
900
|
1144
|
|
|
|
|
3555
|
my %unique_constraints = $self->unique_constraints; |
901
|
|
|
|
|
|
|
|
902
|
1144
|
|
|
|
|
7653
|
return keys %unique_constraints; |
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
=head2 unique_constraint_columns |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
=over 4 |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
=item Arguments: $constraintname |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
=item Return Value: List of constraint columns |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
=back |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
$source->unique_constraint_columns('myconstraint'); |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
Returns the list of columns that make up the specified unique constraint. |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=cut |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
sub unique_constraint_columns { |
922
|
7226
|
|
|
7226
|
1
|
8862
|
my ($self, $constraint_name) = @_; |
923
|
|
|
|
|
|
|
|
924
|
7226
|
|
|
|
|
12258
|
my %unique_constraints = $self->unique_constraints; |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
$self->throw_exception( |
927
|
|
|
|
|
|
|
"Unknown unique constraint $constraint_name on '" . $self->name . "'" |
928
|
7226
|
50
|
|
|
|
16055
|
) unless exists $unique_constraints{$constraint_name}; |
929
|
|
|
|
|
|
|
|
930
|
7226
|
|
|
|
|
5830
|
return @{ $unique_constraints{$constraint_name} }; |
|
7226
|
|
|
|
|
31215
|
|
931
|
|
|
|
|
|
|
} |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
=head2 sqlt_deploy_callback |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
=over |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
=item Arguments: $callback_name | \&callback_code |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
=item Return Value: $callback_name | \&callback_code |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
=back |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
__PACKAGE__->sqlt_deploy_callback('mycallbackmethod'); |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
or |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
__PACKAGE__->sqlt_deploy_callback(sub { |
948
|
|
|
|
|
|
|
my ($source_instance, $sqlt_table) = @_; |
949
|
|
|
|
|
|
|
... |
950
|
|
|
|
|
|
|
} ); |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
An accessor to set a callback to be called during deployment of |
953
|
|
|
|
|
|
|
the schema via L or |
954
|
|
|
|
|
|
|
L. |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
The callback can be set as either a code reference or the name of a |
957
|
|
|
|
|
|
|
method in the current result class. |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
Defaults to L. |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
Your callback will be passed the $source object representing the |
962
|
|
|
|
|
|
|
ResultSource instance being deployed, and the |
963
|
|
|
|
|
|
|
L object being created from it. The |
964
|
|
|
|
|
|
|
callback can be used to manipulate the table object or add your own |
965
|
|
|
|
|
|
|
customised indexes. If you need to manipulate a non-table object, use |
966
|
|
|
|
|
|
|
the L. |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
See L
|
969
|
|
|
|
|
|
|
Your SQL> for examples. |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
This sqlt deployment callback can only be used to manipulate |
972
|
|
|
|
|
|
|
SQL::Translator objects as they get turned into SQL. To execute |
973
|
|
|
|
|
|
|
post-deploy statements which SQL::Translator does not currently |
974
|
|
|
|
|
|
|
handle, override L in your Schema class |
975
|
|
|
|
|
|
|
and call L. |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
=head2 default_sqlt_deploy_hook |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
This is the default deploy hook implementation which checks if your |
980
|
|
|
|
|
|
|
current Result class has a C method, and if present |
981
|
|
|
|
|
|
|
invokes it B. This is to preserve the |
982
|
|
|
|
|
|
|
semantics of C which was originally designed to expect |
983
|
|
|
|
|
|
|
the Result class name and the |
984
|
|
|
|
|
|
|
L<$sqlt_table instance|SQL::Translator::Schema::Table> of the table being |
985
|
|
|
|
|
|
|
deployed. |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
=cut |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
sub default_sqlt_deploy_hook { |
990
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
991
|
|
|
|
|
|
|
|
992
|
0
|
|
|
|
|
0
|
my $class = $self->result_class; |
993
|
|
|
|
|
|
|
|
994
|
0
|
0
|
0
|
|
|
0
|
if ($class and $class->can('sqlt_deploy_hook')) { |
995
|
0
|
|
|
|
|
0
|
$class->sqlt_deploy_hook(@_); |
996
|
|
|
|
|
|
|
} |
997
|
|
|
|
|
|
|
} |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
sub _invoke_sqlt_deploy_hook { |
1000
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1001
|
0
|
0
|
|
|
|
0
|
if ( my $hook = $self->sqlt_deploy_callback) { |
1002
|
0
|
|
|
|
|
0
|
$self->$hook(@_); |
1003
|
|
|
|
|
|
|
} |
1004
|
|
|
|
|
|
|
} |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
=head2 result_class |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
=over 4 |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
=item Arguments: $classname |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
=item Return Value: $classname |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
=back |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
use My::Schema::ResultClass::Inflator; |
1017
|
|
|
|
|
|
|
... |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
use My::Schema::Artist; |
1020
|
|
|
|
|
|
|
... |
1021
|
|
|
|
|
|
|
__PACKAGE__->result_class('My::Schema::ResultClass::Inflator'); |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
Set the default result class for this source. You can use this to create |
1024
|
|
|
|
|
|
|
and use your own result inflator. See L |
1025
|
|
|
|
|
|
|
for more details. |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
Please note that setting this to something like |
1028
|
|
|
|
|
|
|
L will make every result unblessed |
1029
|
|
|
|
|
|
|
and make life more difficult. Inflators like those are better suited to |
1030
|
|
|
|
|
|
|
temporary usage via L. |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
=head2 resultset |
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
=over 4 |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
=item Arguments: none |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
=item Return Value: L<$resultset|DBIx::Class::ResultSet> |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
=back |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
Returns a resultset for the given source. This will initially be created |
1043
|
|
|
|
|
|
|
on demand by calling |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
$self->resultset_class->new($self, $self->resultset_attributes) |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
but is cached from then on unless resultset_class changes. |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
=head2 resultset_class |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
=over 4 |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
=item Arguments: $classname |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
=item Return Value: $classname |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
=back |
1058
|
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
|
package My::Schema::ResultSet::Artist; |
1060
|
|
|
|
|
|
|
use base 'DBIx::Class::ResultSet'; |
1061
|
|
|
|
|
|
|
... |
1062
|
|
|
|
|
|
|
|
1063
|
|
|
|
|
|
|
# In the result class |
1064
|
|
|
|
|
|
|
__PACKAGE__->resultset_class('My::Schema::ResultSet::Artist'); |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
# Or in code |
1067
|
|
|
|
|
|
|
$source->resultset_class('My::Schema::ResultSet::Artist'); |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
Set the class of the resultset. This is useful if you want to create your |
1070
|
|
|
|
|
|
|
own resultset methods. Create your own class derived from |
1071
|
|
|
|
|
|
|
L, and set it here. If called with no arguments, |
1072
|
|
|
|
|
|
|
this method returns the name of the existing resultset class, if one |
1073
|
|
|
|
|
|
|
exists. |
1074
|
|
|
|
|
|
|
|
1075
|
|
|
|
|
|
|
=head2 resultset_attributes |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
=over 4 |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
=item Arguments: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES> |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
=item Return Value: L<\%attrs|DBIx::Class::ResultSet/ATTRIBUTES> |
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
=back |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
# In the result class |
1086
|
|
|
|
|
|
|
__PACKAGE__->resultset_attributes({ order_by => [ 'id' ] }); |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
# Or in code |
1089
|
|
|
|
|
|
|
$source->resultset_attributes({ order_by => [ 'id' ] }); |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
Store a collection of resultset attributes, that will be set on every |
1092
|
|
|
|
|
|
|
L produced from this result source. |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
B: C comes with its own set of issues and |
1095
|
|
|
|
|
|
|
bugs! While C isn't deprecated per se, its usage is |
1096
|
|
|
|
|
|
|
not recommended! |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
Since relationships use attributes to link tables together, the "default" |
1099
|
|
|
|
|
|
|
attributes you set may cause unpredictable and undesired behavior. Furthermore, |
1100
|
|
|
|
|
|
|
the defaults cannot be turned off, so you are stuck with them. |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
In most cases, what you should actually be using are project-specific methods: |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
package My::Schema::ResultSet::Artist; |
1105
|
|
|
|
|
|
|
use base 'DBIx::Class::ResultSet'; |
1106
|
|
|
|
|
|
|
... |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
# BAD IDEA! |
1109
|
|
|
|
|
|
|
#__PACKAGE__->resultset_attributes({ prefetch => 'tracks' }); |
1110
|
|
|
|
|
|
|
|
1111
|
|
|
|
|
|
|
# GOOD IDEA! |
1112
|
|
|
|
|
|
|
sub with_tracks { shift->search({}, { prefetch => 'tracks' }) } |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
# in your code |
1115
|
|
|
|
|
|
|
$schema->resultset('Artist')->with_tracks->... |
1116
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
This gives you the flexibility of not using it when you don't need it. |
1118
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
For more complex situations, another solution would be to use a virtual view |
1120
|
|
|
|
|
|
|
via L. |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
=cut |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
sub resultset { |
1125
|
14683
|
|
|
14683
|
1
|
18766
|
my $self = shift; |
1126
|
14683
|
50
|
|
|
|
31809
|
$self->throw_exception( |
1127
|
|
|
|
|
|
|
'resultset does not take any arguments. If you want another resultset, '. |
1128
|
|
|
|
|
|
|
'call it on the schema instead.' |
1129
|
|
|
|
|
|
|
) if scalar @_; |
1130
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
$self->resultset_class->new( |
1132
|
|
|
|
|
|
|
$self, |
1133
|
|
|
|
|
|
|
{ |
1134
|
14683
|
|
|
14683
|
|
368650
|
try { %{$self->schema->default_resultset_attributes} }, |
|
14683
|
|
|
|
|
35950
|
|
1135
|
14683
|
|
|
|
|
292392
|
%{$self->{resultset_attributes}}, |
|
14683
|
|
|
|
|
757521
|
|
1136
|
|
|
|
|
|
|
}, |
1137
|
|
|
|
|
|
|
); |
1138
|
|
|
|
|
|
|
} |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
=head2 name |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
=over 4 |
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
=item Arguments: none |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
=item Result value: $name |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
=back |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
Returns the name of the result source, which will typically be the table |
1151
|
|
|
|
|
|
|
name. This may be a scalar reference if the result source has a non-standard |
1152
|
|
|
|
|
|
|
name. |
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
=head2 source_name |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
=over 4 |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
=item Arguments: $source_name |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
=item Result value: $source_name |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
=back |
1163
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
Set an alternate name for the result source when it is loaded into a schema. |
1165
|
|
|
|
|
|
|
This is useful if you want to refer to a result source by a name other than |
1166
|
|
|
|
|
|
|
its class name. |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
package ArchivedBooks; |
1169
|
|
|
|
|
|
|
use base qw/DBIx::Class/; |
1170
|
|
|
|
|
|
|
__PACKAGE__->table('books_archive'); |
1171
|
|
|
|
|
|
|
__PACKAGE__->source_name('Books'); |
1172
|
|
|
|
|
|
|
|
1173
|
|
|
|
|
|
|
# from your schema... |
1174
|
|
|
|
|
|
|
$schema->resultset('Books')->find(1); |
1175
|
|
|
|
|
|
|
|
1176
|
|
|
|
|
|
|
=head2 from |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
=over 4 |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
=item Arguments: none |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
=item Return Value: FROM clause |
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
=back |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
my $from_clause = $source->from(); |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
Returns an expression of the source to be supplied to storage to specify |
1189
|
|
|
|
|
|
|
retrieval from this source. In the case of a database, the required FROM |
1190
|
|
|
|
|
|
|
clause contents. |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
=cut |
1193
|
|
|
|
|
|
|
|
1194
|
0
|
|
|
0
|
1
|
0
|
sub from { die 'Virtual method!' } |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
=head2 source_info |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
Stores a hashref of per-source metadata. No specific key names |
1199
|
|
|
|
|
|
|
have yet been standardized, the examples below are purely hypothetical |
1200
|
|
|
|
|
|
|
and don't actually accomplish anything on their own: |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
__PACKAGE__->source_info({ |
1203
|
|
|
|
|
|
|
"_tablespace" => 'fast_disk_array_3', |
1204
|
|
|
|
|
|
|
"_engine" => 'InnoDB', |
1205
|
|
|
|
|
|
|
}); |
1206
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
=head2 schema |
1208
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
=over 4 |
1210
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
=item Arguments: L<$schema?|DBIx::Class::Schema> |
1212
|
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
=item Return Value: L<$schema|DBIx::Class::Schema> |
1214
|
|
|
|
|
|
|
|
1215
|
|
|
|
|
|
|
=back |
1216
|
|
|
|
|
|
|
|
1217
|
|
|
|
|
|
|
my $schema = $source->schema(); |
1218
|
|
|
|
|
|
|
|
1219
|
|
|
|
|
|
|
Sets and/or returns the L object to which this |
1220
|
|
|
|
|
|
|
result source instance has been attached to. |
1221
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
=cut |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
sub schema { |
1225
|
144158
|
100
|
|
144158
|
1
|
250191
|
if (@_ > 1) { |
1226
|
72398
|
|
|
|
|
119533
|
$_[0]->{schema} = $_[1]; |
1227
|
|
|
|
|
|
|
} |
1228
|
|
|
|
|
|
|
else { |
1229
|
71760
|
100
|
|
|
|
1378382
|
$_[0]->{schema} || do { |
1230
|
88
|
|
100
|
|
|
247
|
my $name = $_[0]->{source_name} || '_unnamed_'; |
1231
|
88
|
|
|
|
|
158
|
my $err = 'Unable to perform storage-dependent operations with a detached result source ' |
1232
|
|
|
|
|
|
|
. "(source '$name' is not associated with a schema)."; |
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
$err .= ' You need to use $schema->thaw() or manually set' |
1235
|
|
|
|
|
|
|
. ' $DBIx::Class::ResultSourceHandle::thaw_schema while thawing.' |
1236
|
88
|
100
|
|
|
|
196
|
if $_[0]->{_detached_thaw}; |
1237
|
|
|
|
|
|
|
|
1238
|
88
|
|
|
|
|
273
|
DBIx::Class::Exception->throw($err); |
1239
|
|
|
|
|
|
|
}; |
1240
|
|
|
|
|
|
|
} |
1241
|
|
|
|
|
|
|
} |
1242
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
=head2 storage |
1244
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
=over 4 |
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
=item Arguments: none |
1248
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
=item Return Value: L<$storage|DBIx::Class::Storage> |
1250
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
=back |
1252
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
$source->storage->debug(1); |
1254
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
Returns the L for the current schema. |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
=cut |
1258
|
|
|
|
|
|
|
|
1259
|
23444
|
|
|
23444
|
1
|
40594
|
sub storage { shift->schema->storage; } |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
=head2 add_relationship |
1262
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
=over 4 |
1264
|
|
|
|
|
|
|
|
1265
|
|
|
|
|
|
|
=item Arguments: $rel_name, $related_source_name, \%cond, \%attrs? |
1266
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
=item Return Value: 1/true if it succeeded |
1268
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
=back |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
$source->add_relationship('rel_name', 'related_source', $cond, $attrs); |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
L describes a series of methods which |
1274
|
|
|
|
|
|
|
create pre-defined useful types of relationships. Look there first |
1275
|
|
|
|
|
|
|
before using this method directly. |
1276
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
The relationship name can be arbitrary, but must be unique for each |
1278
|
|
|
|
|
|
|
relationship attached to this result source. 'related_source' should |
1279
|
|
|
|
|
|
|
be the name with which the related result source was registered with |
1280
|
|
|
|
|
|
|
the current schema. For example: |
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
$schema->source('Book')->add_relationship('reviews', 'Review', { |
1283
|
|
|
|
|
|
|
'foreign.book_id' => 'self.id', |
1284
|
|
|
|
|
|
|
}); |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
The condition C<$cond> needs to be an L-style |
1287
|
|
|
|
|
|
|
representation of the join between the tables. For example, if you're |
1288
|
|
|
|
|
|
|
creating a relation from Author to Book, |
1289
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
{ 'foreign.author_id' => 'self.id' } |
1291
|
|
|
|
|
|
|
|
1292
|
|
|
|
|
|
|
will result in the JOIN clause |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
author me JOIN book foreign ON foreign.author_id = me.id |
1295
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
You can specify as many foreign => self mappings as necessary. |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
Valid attributes are as follows: |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
=over 4 |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
=item join_type |
1303
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
Explicitly specifies the type of join to use in the relationship. Any |
1305
|
|
|
|
|
|
|
SQL join type is valid, e.g. C or C. It will be placed in |
1306
|
|
|
|
|
|
|
the SQL command immediately before C. |
1307
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
=item proxy |
1309
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
An arrayref containing a list of accessors in the foreign class to proxy in |
1311
|
|
|
|
|
|
|
the main class. If, for example, you do the following: |
1312
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
CD->might_have(liner_notes => 'LinerNotes', undef, { |
1314
|
|
|
|
|
|
|
proxy => [ qw/notes/ ], |
1315
|
|
|
|
|
|
|
}); |
1316
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
Then, assuming LinerNotes has an accessor named notes, you can do: |
1318
|
|
|
|
|
|
|
|
1319
|
|
|
|
|
|
|
my $cd = CD->find(1); |
1320
|
|
|
|
|
|
|
# set notes -- LinerNotes object is created if it doesn't exist |
1321
|
|
|
|
|
|
|
$cd->notes('Notes go here'); |
1322
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
=item accessor |
1324
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
Specifies the type of accessor that should be created for the |
1326
|
|
|
|
|
|
|
relationship. Valid values are C (for when there is only a single |
1327
|
|
|
|
|
|
|
related object), C (when there can be many), and C (for |
1328
|
|
|
|
|
|
|
when there is a single related object, but you also want the relationship |
1329
|
|
|
|
|
|
|
accessor to double as a column accessor). For C accessors, an |
1330
|
|
|
|
|
|
|
add_to_* method is also created, which calls C for the |
1331
|
|
|
|
|
|
|
relationship. |
1332
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
=back |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
Throws an exception if the condition is improperly supplied, or cannot |
1336
|
|
|
|
|
|
|
be resolved. |
1337
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
=cut |
1339
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
sub add_relationship { |
1341
|
29096
|
|
|
29096
|
1
|
40091
|
my ($self, $rel, $f_source_name, $cond, $attrs) = @_; |
1342
|
29096
|
100
|
|
|
|
54081
|
$self->throw_exception("Can't create relationship without join condition") |
1343
|
|
|
|
|
|
|
unless $cond; |
1344
|
29095
|
|
100
|
|
|
48562
|
$attrs ||= {}; |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
# Check foreign and self are right in cond |
1347
|
29095
|
100
|
50
|
|
|
80521
|
if ( (ref $cond ||'') eq 'HASH') { |
1348
|
|
|
|
|
|
|
$_ =~ /^foreign\./ or $self->throw_exception("Malformed relationship condition key '$_': must be prefixed with 'foreign.'") |
1349
|
24081
|
|
66
|
|
|
112510
|
for keys %$cond; |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
$_ =~ /^self\./ or $self->throw_exception("Malformed relationship condition value '$_': must be prefixed with 'self.'") |
1352
|
24078
|
|
66
|
|
|
89357
|
for values %$cond; |
1353
|
|
|
|
|
|
|
} |
1354
|
|
|
|
|
|
|
|
1355
|
29088
|
|
|
|
|
27164
|
my %rels = %{ $self->_relationships }; |
|
29088
|
|
|
|
|
142623
|
|
1356
|
29088
|
|
|
|
|
233404
|
$rels{$rel} = { class => $f_source_name, |
1357
|
|
|
|
|
|
|
source => $f_source_name, |
1358
|
|
|
|
|
|
|
cond => $cond, |
1359
|
|
|
|
|
|
|
attrs => $attrs }; |
1360
|
29088
|
|
|
|
|
74681
|
$self->_relationships(\%rels); |
1361
|
|
|
|
|
|
|
|
1362
|
29088
|
|
|
|
|
60965
|
return $self; |
1363
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
# XXX disabled. doesn't work properly currently. skip in tests. |
1365
|
|
|
|
|
|
|
|
1366
|
0
|
|
|
|
|
0
|
my $f_source = $self->schema->source($f_source_name); |
1367
|
0
|
0
|
|
|
|
0
|
unless ($f_source) { |
1368
|
0
|
|
|
|
|
0
|
$self->ensure_class_loaded($f_source_name); |
1369
|
0
|
|
|
|
|
0
|
$f_source = $f_source_name->result_source; |
1370
|
|
|
|
|
|
|
#my $s_class = ref($self->schema); |
1371
|
|
|
|
|
|
|
#$f_source_name =~ m/^${s_class}::(.*)$/; |
1372
|
|
|
|
|
|
|
#$self->schema->register_class(($1 || $f_source_name), $f_source_name); |
1373
|
|
|
|
|
|
|
#$f_source = $self->schema->source($f_source_name); |
1374
|
|
|
|
|
|
|
} |
1375
|
0
|
0
|
|
|
|
0
|
return unless $f_source; # Can't test rel without f_source |
1376
|
|
|
|
|
|
|
|
1377
|
0
|
|
|
0
|
|
0
|
try { $self->_resolve_join($rel, 'me', {}, []) } |
1378
|
|
|
|
|
|
|
catch { |
1379
|
|
|
|
|
|
|
# If the resolve failed, back out and re-throw the error |
1380
|
0
|
|
|
0
|
|
0
|
delete $rels{$rel}; |
1381
|
0
|
|
|
|
|
0
|
$self->_relationships(\%rels); |
1382
|
0
|
|
|
|
|
0
|
$self->throw_exception("Error creating relationship $rel: $_"); |
1383
|
0
|
|
|
|
|
0
|
}; |
1384
|
|
|
|
|
|
|
|
1385
|
0
|
|
|
|
|
0
|
1; |
1386
|
|
|
|
|
|
|
} |
1387
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
=head2 relationships |
1389
|
|
|
|
|
|
|
|
1390
|
|
|
|
|
|
|
=over 4 |
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
=item Arguments: none |
1393
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
=item Return Value: L<@rel_names|DBIx::Class::Relationship> |
1395
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
=back |
1397
|
|
|
|
|
|
|
|
1398
|
|
|
|
|
|
|
my @rel_names = $source->relationships(); |
1399
|
|
|
|
|
|
|
|
1400
|
|
|
|
|
|
|
Returns all relationship names for this source. |
1401
|
|
|
|
|
|
|
|
1402
|
|
|
|
|
|
|
=cut |
1403
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
sub relationships { |
1405
|
9583
|
|
|
9583
|
1
|
9564
|
return keys %{shift->_relationships}; |
|
9583
|
|
|
|
|
49865
|
|
1406
|
|
|
|
|
|
|
} |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
=head2 relationship_info |
1409
|
|
|
|
|
|
|
|
1410
|
|
|
|
|
|
|
=over 4 |
1411
|
|
|
|
|
|
|
|
1412
|
|
|
|
|
|
|
=item Arguments: L<$rel_name|DBIx::Class::Relationship> |
1413
|
|
|
|
|
|
|
|
1414
|
|
|
|
|
|
|
=item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship> |
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
=back |
1417
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
Returns a hash of relationship information for the specified relationship |
1419
|
|
|
|
|
|
|
name. The keys/values are as specified for L. |
1420
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
=cut |
1422
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
sub relationship_info { |
1424
|
|
|
|
|
|
|
#my ($self, $rel) = @_; |
1425
|
95219
|
|
|
95219
|
1
|
685190
|
return shift->_relationships->{+shift}; |
1426
|
|
|
|
|
|
|
} |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
=head2 has_relationship |
1429
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
=over 4 |
1431
|
|
|
|
|
|
|
|
1432
|
|
|
|
|
|
|
=item Arguments: L<$rel_name|DBIx::Class::Relationship> |
1433
|
|
|
|
|
|
|
|
1434
|
|
|
|
|
|
|
=item Return Value: 1/0 (true/false) |
1435
|
|
|
|
|
|
|
|
1436
|
|
|
|
|
|
|
=back |
1437
|
|
|
|
|
|
|
|
1438
|
|
|
|
|
|
|
Returns true if the source has a relationship of this name, false otherwise. |
1439
|
|
|
|
|
|
|
|
1440
|
|
|
|
|
|
|
=cut |
1441
|
|
|
|
|
|
|
|
1442
|
|
|
|
|
|
|
sub has_relationship { |
1443
|
|
|
|
|
|
|
#my ($self, $rel) = @_; |
1444
|
16416
|
|
|
16416
|
1
|
50733
|
return exists shift->_relationships->{+shift}; |
1445
|
|
|
|
|
|
|
} |
1446
|
|
|
|
|
|
|
|
1447
|
|
|
|
|
|
|
=head2 reverse_relationship_info |
1448
|
|
|
|
|
|
|
|
1449
|
|
|
|
|
|
|
=over 4 |
1450
|
|
|
|
|
|
|
|
1451
|
|
|
|
|
|
|
=item Arguments: L<$rel_name|DBIx::Class::Relationship> |
1452
|
|
|
|
|
|
|
|
1453
|
|
|
|
|
|
|
=item Return Value: L<\%rel_data|DBIx::Class::Relationship::Base/add_relationship> |
1454
|
|
|
|
|
|
|
|
1455
|
|
|
|
|
|
|
=back |
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
Looks through all the relationships on the source this relationship |
1458
|
|
|
|
|
|
|
points to, looking for one whose condition is the reverse of the |
1459
|
|
|
|
|
|
|
condition on this relationship. |
1460
|
|
|
|
|
|
|
|
1461
|
|
|
|
|
|
|
A common use of this is to find the name of the C relation |
1462
|
|
|
|
|
|
|
opposing a C relation. For definition of these look in |
1463
|
|
|
|
|
|
|
L. |
1464
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
The returned hashref is keyed by the name of the opposing |
1466
|
|
|
|
|
|
|
relationship, and contains its data in the same manner as |
1467
|
|
|
|
|
|
|
L. |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
=cut |
1470
|
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
sub reverse_relationship_info { |
1472
|
927
|
|
|
927
|
1
|
1490
|
my ($self, $rel) = @_; |
1473
|
|
|
|
|
|
|
|
1474
|
927
|
50
|
|
|
|
1872
|
my $rel_info = $self->relationship_info($rel) |
1475
|
|
|
|
|
|
|
or $self->throw_exception("No such relationship '$rel'"); |
1476
|
|
|
|
|
|
|
|
1477
|
927
|
|
|
|
|
1389
|
my $ret = {}; |
1478
|
|
|
|
|
|
|
|
1479
|
927
|
100
|
|
|
|
2775
|
return $ret unless ((ref $rel_info->{cond}) eq 'HASH'); |
1480
|
|
|
|
|
|
|
|
1481
|
926
|
|
|
|
|
2654
|
my $stripped_cond = $self->__strip_relcond ($rel_info->{cond}); |
1482
|
|
|
|
|
|
|
|
1483
|
926
|
|
|
|
|
2312
|
my $registered_source_name = $self->source_name; |
1484
|
|
|
|
|
|
|
|
1485
|
|
|
|
|
|
|
# this may be a partial schema or something else equally esoteric |
1486
|
926
|
|
|
|
|
5559
|
my $other_rsrc = $self->related_source($rel); |
1487
|
|
|
|
|
|
|
|
1488
|
|
|
|
|
|
|
# Get all the relationships for that source that related to this source |
1489
|
|
|
|
|
|
|
# whose foreign column set are our self columns on $rel and whose self |
1490
|
|
|
|
|
|
|
# columns are our foreign columns on $rel |
1491
|
926
|
|
|
|
|
4989
|
foreach my $other_rel ($other_rsrc->relationships) { |
1492
|
|
|
|
|
|
|
|
1493
|
|
|
|
|
|
|
# only consider stuff that points back to us |
1494
|
|
|
|
|
|
|
# "us" here is tricky - if we are in a schema registration, we want |
1495
|
|
|
|
|
|
|
# to use the source_names, otherwise we will use the actual classes |
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
# the schema may be partial |
1498
|
8261
|
|
|
8261
|
|
198997
|
my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) } |
1499
|
8261
|
50
|
|
|
|
35470
|
or next; |
1500
|
|
|
|
|
|
|
|
1501
|
8261
|
100
|
|
|
|
70750
|
if ($registered_source_name) { |
1502
|
8247
|
100
|
50
|
|
|
31722
|
next if $registered_source_name ne ($roundtrip_rsrc->source_name || '') |
1503
|
|
|
|
|
|
|
} |
1504
|
|
|
|
|
|
|
else { |
1505
|
14
|
100
|
|
|
|
413
|
next if $self->result_class ne $roundtrip_rsrc->result_class; |
1506
|
|
|
|
|
|
|
} |
1507
|
|
|
|
|
|
|
|
1508
|
2952
|
|
|
|
|
4730
|
my $other_rel_info = $other_rsrc->relationship_info($other_rel); |
1509
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
# this can happen when we have a self-referential class |
1511
|
2952
|
100
|
|
|
|
7252
|
next if $other_rel_info eq $rel_info; |
1512
|
|
|
|
|
|
|
|
1513
|
2945
|
100
|
|
|
|
7336
|
next unless ref $other_rel_info->{cond} eq 'HASH'; |
1514
|
2036
|
|
|
|
|
3365
|
my $other_stripped_cond = $self->__strip_relcond($other_rel_info->{cond}); |
1515
|
|
|
|
|
|
|
|
1516
|
2036
|
100
|
66
|
|
|
8734
|
$ret->{$other_rel} = $other_rel_info if ( |
1517
|
|
|
|
|
|
|
$self->_compare_relationship_keys ( |
1518
|
|
|
|
|
|
|
[ keys %$stripped_cond ], [ values %$other_stripped_cond ] |
1519
|
|
|
|
|
|
|
) |
1520
|
|
|
|
|
|
|
and |
1521
|
|
|
|
|
|
|
$self->_compare_relationship_keys ( |
1522
|
|
|
|
|
|
|
[ values %$stripped_cond ], [ keys %$other_stripped_cond ] |
1523
|
|
|
|
|
|
|
) |
1524
|
|
|
|
|
|
|
); |
1525
|
|
|
|
|
|
|
} |
1526
|
|
|
|
|
|
|
|
1527
|
926
|
|
|
|
|
4722
|
return $ret; |
1528
|
|
|
|
|
|
|
} |
1529
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
# all this does is removes the foreign/self prefix from a condition |
1531
|
|
|
|
|
|
|
sub __strip_relcond { |
1532
|
|
|
|
|
|
|
+{ |
1533
|
|
|
|
|
|
|
map |
1534
|
2962
|
|
|
|
|
3677
|
{ map { /^ (?:foreign|self) \. (\w+) $/x } ($_, $_[1]{$_}) } |
|
5924
|
|
|
|
|
26340
|
|
1535
|
2962
|
|
|
2962
|
|
2639
|
keys %{$_[1]} |
|
2962
|
|
|
|
|
7115
|
|
1536
|
|
|
|
|
|
|
} |
1537
|
|
|
|
|
|
|
} |
1538
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
sub compare_relationship_keys { |
1540
|
0
|
|
|
0
|
0
|
0
|
carp 'compare_relationship_keys is a private method, stop calling it'; |
1541
|
0
|
|
|
|
|
0
|
my $self = shift; |
1542
|
0
|
|
|
|
|
0
|
$self->_compare_relationship_keys (@_); |
1543
|
|
|
|
|
|
|
} |
1544
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
# Returns true if both sets of keynames are the same, false otherwise. |
1546
|
|
|
|
|
|
|
sub _compare_relationship_keys { |
1547
|
|
|
|
|
|
|
# my ($self, $keys1, $keys2) = @_; |
1548
|
|
|
|
|
|
|
return |
1549
|
3607
|
|
|
|
|
5908
|
join ("\x00", sort @{$_[1]}) |
1550
|
|
|
|
|
|
|
eq |
1551
|
3607
|
|
|
3607
|
|
3201
|
join ("\x00", sort @{$_[2]}) |
|
3607
|
|
|
|
|
20096
|
|
1552
|
|
|
|
|
|
|
; |
1553
|
|
|
|
|
|
|
} |
1554
|
|
|
|
|
|
|
|
1555
|
|
|
|
|
|
|
# optionally takes either an arrayref of column names, or a hashref of already |
1556
|
|
|
|
|
|
|
# retrieved colinfos |
1557
|
|
|
|
|
|
|
# returns an arrayref of column names of the shortest unique constraint |
1558
|
|
|
|
|
|
|
# (matching some of the input if any), giving preference to the PK |
1559
|
|
|
|
|
|
|
sub _identifying_column_set { |
1560
|
665
|
|
|
665
|
|
1084
|
my ($self, $cols) = @_; |
1561
|
|
|
|
|
|
|
|
1562
|
665
|
|
|
|
|
2080
|
my %unique = $self->unique_constraints; |
1563
|
665
|
100
|
66
|
|
|
2906
|
my $colinfos = ref $cols eq 'HASH' ? $cols : $self->columns_info($cols||()); |
1564
|
|
|
|
|
|
|
|
1565
|
|
|
|
|
|
|
# always prefer the PK first, and then shortest constraints first |
1566
|
|
|
|
|
|
|
USET: |
1567
|
665
|
|
|
|
|
2508
|
for my $set (delete $unique{primary}, sort { @$a <=> @$b } (values %unique) ) { |
|
370
|
|
|
|
|
810
|
|
1568
|
833
|
50
|
33
|
|
|
3659
|
next unless $set && @$set; |
1569
|
|
|
|
|
|
|
|
1570
|
833
|
|
|
|
|
1447
|
for (@$set) { |
1571
|
1016
|
100
|
100
|
|
|
4622
|
next USET unless ($colinfos->{$_} && !$colinfos->{$_}{is_nullable} ); |
1572
|
|
|
|
|
|
|
} |
1573
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
# copy so we can mangle it at will |
1575
|
630
|
|
|
|
|
4562
|
return [ @$set ]; |
1576
|
|
|
|
|
|
|
} |
1577
|
|
|
|
|
|
|
|
1578
|
35
|
|
|
|
|
184
|
return undef; |
1579
|
|
|
|
|
|
|
} |
1580
|
|
|
|
|
|
|
|
1581
|
|
|
|
|
|
|
sub _minimal_valueset_satisfying_constraint { |
1582
|
3214
|
|
|
3214
|
|
4232
|
my $self = shift; |
1583
|
3214
|
50
|
|
|
|
13804
|
my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ }; |
|
0
|
|
|
|
|
0
|
|
1584
|
|
|
|
|
|
|
|
1585
|
3214
|
|
66
|
|
|
8021
|
$args->{columns_info} ||= $self->columns_info; |
1586
|
|
|
|
|
|
|
|
1587
|
|
|
|
|
|
|
my $vals = $self->storage->_extract_fixed_condition_columns( |
1588
|
|
|
|
|
|
|
$args->{values}, |
1589
|
3214
|
100
|
|
|
|
6978
|
($args->{carp_on_nulls} ? 'consider_nulls' : undef ), |
1590
|
|
|
|
|
|
|
); |
1591
|
|
|
|
|
|
|
|
1592
|
3210
|
|
|
|
|
3750
|
my $cols; |
1593
|
3210
|
|
|
|
|
7700
|
for my $col ($self->unique_constraint_columns($args->{constraint_name}) ) { |
1594
|
4209
|
100
|
100
|
|
|
19012
|
if( ! exists $vals->{$col} or ( $vals->{$col}||'' ) eq UNRESOLVABLE_CONDITION ) { |
|
|
100
|
100
|
|
|
|
|
1595
|
2804
|
|
|
|
|
6016
|
$cols->{missing}{$col} = undef; |
1596
|
|
|
|
|
|
|
} |
1597
|
|
|
|
|
|
|
elsif( ! defined $vals->{$col} ) { |
1598
|
2
|
50
|
|
|
|
8
|
$cols->{$args->{carp_on_nulls} ? 'undefined' : 'missing'}{$col} = undef; |
1599
|
|
|
|
|
|
|
} |
1600
|
|
|
|
|
|
|
else { |
1601
|
|
|
|
|
|
|
# we need to inject back the '=' as _extract_fixed_condition_columns |
1602
|
|
|
|
|
|
|
# will strip it from literals and values alike, resulting in an invalid |
1603
|
|
|
|
|
|
|
# condition in the end |
1604
|
1403
|
|
|
|
|
5949
|
$cols->{present}{$col} = { '=' => $vals->{$col} }; |
1605
|
|
|
|
|
|
|
} |
1606
|
|
|
|
|
|
|
|
1607
|
|
|
|
|
|
|
$cols->{fc}{$col} = 1 if ( |
1608
|
|
|
|
|
|
|
( ! $cols->{missing} or ! exists $cols->{missing}{$col} ) |
1609
|
|
|
|
|
|
|
and |
1610
|
4209
|
100
|
100
|
|
|
18741
|
keys %{ $args->{columns_info}{$col}{_filter_info} || {} } |
|
1405
|
100
|
100
|
|
|
10932
|
|
1611
|
|
|
|
|
|
|
); |
1612
|
|
|
|
|
|
|
} |
1613
|
|
|
|
|
|
|
|
1614
|
|
|
|
|
|
|
$self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', missing values for column(s): %s", |
1615
|
|
|
|
|
|
|
$args->{constraint_name}, |
1616
|
2804
|
|
|
|
|
16070
|
join (', ', map { "'$_'" } sort keys %{$cols->{missing}} ), |
|
1949
|
|
|
|
|
6068
|
|
1617
|
3210
|
100
|
|
|
|
8814
|
) ) if $cols->{missing}; |
1618
|
|
|
|
|
|
|
|
1619
|
|
|
|
|
|
|
$self->throw_exception( sprintf ( |
1620
|
|
|
|
|
|
|
"Unable to satisfy requested constraint '%s', FilterColumn values not usable for column(s): %s", |
1621
|
|
|
|
|
|
|
$args->{constraint_name}, |
1622
|
2
|
|
|
|
|
17
|
join (', ', map { "'$_'" } sort keys %{$cols->{fc}}), |
|
2
|
|
|
|
|
4
|
|
1623
|
1261
|
100
|
|
|
|
3249
|
)) if $cols->{fc}; |
1624
|
|
|
|
|
|
|
|
1625
|
1259
|
100
|
66
|
|
|
3578
|
if ( |
1626
|
|
|
|
|
|
|
$cols->{undefined} |
1627
|
|
|
|
|
|
|
and |
1628
|
|
|
|
|
|
|
!$ENV{DBIC_NULLABLE_KEY_NOWARN} |
1629
|
|
|
|
|
|
|
) { |
1630
|
|
|
|
|
|
|
carp_unique ( sprintf ( |
1631
|
|
|
|
|
|
|
"NULL/undef values supplied for requested unique constraint '%s' (NULL " |
1632
|
|
|
|
|
|
|
. 'values in column(s): %s). This is almost certainly not what you wanted, ' |
1633
|
|
|
|
|
|
|
. 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.', |
1634
|
|
|
|
|
|
|
$args->{constraint_name}, |
1635
|
2
|
|
|
|
|
4
|
join (', ', map { "'$_'" } sort keys %{$cols->{undefined}}), |
|
2
|
|
|
|
|
17
|
|
|
2
|
|
|
|
|
4
|
|
1636
|
|
|
|
|
|
|
)); |
1637
|
|
|
|
|
|
|
} |
1638
|
|
|
|
|
|
|
|
1639
|
1259
|
100
|
|
|
|
2246
|
return { map { %{ $cols->{$_}||{} } } qw(present undefined) }; |
|
2518
|
|
|
|
|
2083
|
|
|
2518
|
|
|
|
|
17664
|
|
1640
|
|
|
|
|
|
|
} |
1641
|
|
|
|
|
|
|
|
1642
|
|
|
|
|
|
|
# Returns the {from} structure used to express JOIN conditions |
1643
|
|
|
|
|
|
|
sub _resolve_join { |
1644
|
2393
|
|
|
2393
|
|
4164
|
my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_; |
1645
|
|
|
|
|
|
|
|
1646
|
|
|
|
|
|
|
# we need a supplied one, because we do in-place modifications, no returns |
1647
|
2393
|
50
|
|
|
|
5280
|
$self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join') |
1648
|
|
|
|
|
|
|
unless ref $seen eq 'HASH'; |
1649
|
|
|
|
|
|
|
|
1650
|
2393
|
50
|
|
|
|
4504
|
$self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join') |
1651
|
|
|
|
|
|
|
unless ref $jpath eq 'ARRAY'; |
1652
|
|
|
|
|
|
|
|
1653
|
2393
|
|
|
|
|
3251
|
$jpath = [@$jpath]; # copy |
1654
|
|
|
|
|
|
|
|
1655
|
2393
|
100
|
100
|
|
|
13925
|
if (not defined $join or not length $join) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1656
|
428
|
|
|
|
|
1491
|
return (); |
1657
|
|
|
|
|
|
|
} |
1658
|
|
|
|
|
|
|
elsif (ref $join eq 'ARRAY') { |
1659
|
|
|
|
|
|
|
return |
1660
|
|
|
|
|
|
|
map { |
1661
|
529
|
|
|
|
|
1181
|
$self->_resolve_join($_, $alias, $seen, $jpath, $parent_force_left); |
|
741
|
|
|
|
|
2038
|
|
1662
|
|
|
|
|
|
|
} @$join; |
1663
|
|
|
|
|
|
|
} |
1664
|
|
|
|
|
|
|
elsif (ref $join eq 'HASH') { |
1665
|
|
|
|
|
|
|
|
1666
|
259
|
|
|
|
|
290
|
my @ret; |
1667
|
259
|
|
|
|
|
735
|
for my $rel (keys %$join) { |
1668
|
|
|
|
|
|
|
|
1669
|
256
|
50
|
|
|
|
790
|
my $rel_info = $self->relationship_info($rel) |
1670
|
|
|
|
|
|
|
or $self->throw_exception("No such relationship '$rel' on " . $self->source_name); |
1671
|
|
|
|
|
|
|
|
1672
|
256
|
|
|
|
|
375
|
my $force_left = $parent_force_left; |
1673
|
256
|
|
100
|
|
|
1868
|
$force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left'; |
|
|
|
100
|
|
|
|
|
1674
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
# the actual seen value will be incremented by the recursion |
1676
|
|
|
|
|
|
|
my $as = $self->storage->relname_to_table_alias( |
1677
|
256
|
|
66
|
|
|
711
|
$rel, ($seen->{$rel} && $seen->{$rel} + 1) |
1678
|
|
|
|
|
|
|
); |
1679
|
|
|
|
|
|
|
|
1680
|
|
|
|
|
|
|
push @ret, ( |
1681
|
|
|
|
|
|
|
$self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left), |
1682
|
|
|
|
|
|
|
$self->related_source($rel)->_resolve_join( |
1683
|
256
|
|
|
|
|
1220
|
$join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left |
1684
|
|
|
|
|
|
|
) |
1685
|
|
|
|
|
|
|
); |
1686
|
|
|
|
|
|
|
} |
1687
|
259
|
|
|
|
|
1387
|
return @ret; |
1688
|
|
|
|
|
|
|
|
1689
|
|
|
|
|
|
|
} |
1690
|
|
|
|
|
|
|
elsif (ref $join) { |
1691
|
0
|
|
|
|
|
0
|
$self->throw_exception("No idea how to resolve join reftype ".ref $join); |
1692
|
|
|
|
|
|
|
} |
1693
|
|
|
|
|
|
|
else { |
1694
|
1177
|
|
|
|
|
2705
|
my $count = ++$seen->{$join}; |
1695
|
1177
|
|
66
|
|
|
3207
|
my $as = $self->storage->relname_to_table_alias( |
1696
|
|
|
|
|
|
|
$join, ($count > 1 && $count) |
1697
|
|
|
|
|
|
|
); |
1698
|
|
|
|
|
|
|
|
1699
|
1177
|
50
|
|
|
|
3056
|
my $rel_info = $self->relationship_info($join) |
1700
|
|
|
|
|
|
|
or $self->throw_exception("No such relationship $join on " . $self->source_name); |
1701
|
|
|
|
|
|
|
|
1702
|
1177
|
|
|
|
|
3330
|
my $rel_src = $self->related_source($join); |
1703
|
|
|
|
|
|
|
return [ { $as => $rel_src->from, |
1704
|
|
|
|
|
|
|
-rsrc => $rel_src, |
1705
|
|
|
|
|
|
|
-join_type => $parent_force_left |
1706
|
|
|
|
|
|
|
? 'left' |
1707
|
|
|
|
|
|
|
: $rel_info->{attrs}{join_type} |
1708
|
|
|
|
|
|
|
, |
1709
|
|
|
|
|
|
|
-join_path => [@$jpath, { $join => $as } ], |
1710
|
|
|
|
|
|
|
-is_single => ( |
1711
|
|
|
|
|
|
|
(! $rel_info->{attrs}{accessor}) |
1712
|
|
|
|
|
|
|
or |
1713
|
2068
|
|
|
2068
|
|
15017
|
first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/) |
1714
|
|
|
|
|
|
|
), |
1715
|
|
|
|
|
|
|
-alias => $as, |
1716
|
|
|
|
|
|
|
-relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1, |
1717
|
|
|
|
|
|
|
}, |
1718
|
1177
|
100
|
66
|
|
|
6688
|
scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join) |
|
|
|
100
|
|
|
|
|
1719
|
|
|
|
|
|
|
]; |
1720
|
|
|
|
|
|
|
} |
1721
|
|
|
|
|
|
|
} |
1722
|
|
|
|
|
|
|
|
1723
|
|
|
|
|
|
|
sub pk_depends_on { |
1724
|
0
|
|
|
0
|
0
|
0
|
carp 'pk_depends_on is a private method, stop calling it'; |
1725
|
0
|
|
|
|
|
0
|
my $self = shift; |
1726
|
0
|
|
|
|
|
0
|
$self->_pk_depends_on (@_); |
1727
|
|
|
|
|
|
|
} |
1728
|
|
|
|
|
|
|
|
1729
|
|
|
|
|
|
|
# Determines whether a relation is dependent on an object from this source |
1730
|
|
|
|
|
|
|
# having already been inserted. Takes the name of the relationship and a |
1731
|
|
|
|
|
|
|
# hashref of columns of the related object. |
1732
|
|
|
|
|
|
|
sub _pk_depends_on { |
1733
|
686
|
|
|
686
|
|
980
|
my ($self, $rel_name, $rel_data) = @_; |
1734
|
|
|
|
|
|
|
|
1735
|
686
|
|
|
|
|
1296
|
my $relinfo = $self->relationship_info($rel_name); |
1736
|
|
|
|
|
|
|
|
1737
|
|
|
|
|
|
|
# don't assume things if the relationship direction is specified |
1738
|
|
|
|
|
|
|
return $relinfo->{attrs}{is_foreign_key_constraint} |
1739
|
686
|
100
|
|
|
|
4087
|
if exists ($relinfo->{attrs}{is_foreign_key_constraint}); |
1740
|
|
|
|
|
|
|
|
1741
|
194
|
|
|
|
|
292
|
my $cond = $relinfo->{cond}; |
1742
|
194
|
50
|
|
|
|
505
|
return 0 unless ref($cond) eq 'HASH'; |
1743
|
|
|
|
|
|
|
|
1744
|
|
|
|
|
|
|
# map { foreign.foo => 'self.bar' } to { bar => 'foo' } |
1745
|
194
|
|
|
|
|
487
|
my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond }; |
|
388
|
|
|
|
|
423
|
|
|
388
|
|
|
|
|
1232
|
|
|
388
|
|
|
|
|
883
|
|
1746
|
|
|
|
|
|
|
|
1747
|
|
|
|
|
|
|
# assume anything that references our PK probably is dependent on us |
1748
|
|
|
|
|
|
|
# rather than vice versa, unless the far side is (a) defined or (b) |
1749
|
|
|
|
|
|
|
# auto-increment |
1750
|
194
|
|
|
|
|
494
|
my $rel_source = $self->related_source($rel_name); |
1751
|
|
|
|
|
|
|
|
1752
|
194
|
|
|
|
|
996
|
foreach my $p ($self->primary_columns) { |
1753
|
194
|
50
|
|
|
|
523
|
if (exists $keyhash->{$p}) { |
1754
|
194
|
50
|
33
|
|
|
1026
|
unless (defined($rel_data->{$keyhash->{$p}}) |
1755
|
|
|
|
|
|
|
|| $rel_source->column_info($keyhash->{$p}) |
1756
|
|
|
|
|
|
|
->{is_auto_increment}) { |
1757
|
194
|
|
|
|
|
972
|
return 0; |
1758
|
|
|
|
|
|
|
} |
1759
|
|
|
|
|
|
|
} |
1760
|
|
|
|
|
|
|
} |
1761
|
|
|
|
|
|
|
|
1762
|
0
|
|
|
|
|
0
|
return 1; |
1763
|
|
|
|
|
|
|
} |
1764
|
|
|
|
|
|
|
|
1765
|
|
|
|
|
|
|
sub resolve_condition { |
1766
|
0
|
|
|
0
|
0
|
0
|
carp 'resolve_condition is a private method, stop calling it'; |
1767
|
0
|
|
|
|
|
0
|
shift->_resolve_condition (@_); |
1768
|
|
|
|
|
|
|
} |
1769
|
|
|
|
|
|
|
|
1770
|
|
|
|
|
|
|
sub _resolve_condition { |
1771
|
|
|
|
|
|
|
# carp_unique sprintf |
1772
|
|
|
|
|
|
|
# '_resolve_condition is a private method, and moreover is about to go ' |
1773
|
|
|
|
|
|
|
# . 'away. Please contact the development team at %s if you believe you ' |
1774
|
|
|
|
|
|
|
# . 'have a genuine use for this method, in order to discuss alternatives.', |
1775
|
|
|
|
|
|
|
# DBIx::Class::_ENV_::HELP_URL, |
1776
|
|
|
|
|
|
|
# ; |
1777
|
|
|
|
|
|
|
|
1778
|
|
|
|
|
|
|
####################### |
1779
|
|
|
|
|
|
|
### API Design? What's that...? (a backwards compatible shim, kill me now) |
1780
|
|
|
|
|
|
|
|
1781
|
4159
|
|
|
4159
|
|
5048
|
my ($self, $cond, @res_args, $rel_name); |
1782
|
|
|
|
|
|
|
|
1783
|
|
|
|
|
|
|
# we *SIMPLY DON'T KNOW YET* which arg is which, yay |
1784
|
4159
|
|
|
|
|
9654
|
($self, $cond, $res_args[0], $res_args[1], $rel_name) = @_; |
1785
|
|
|
|
|
|
|
|
1786
|
|
|
|
|
|
|
# assume that an undef is an object-like unset (set_from_related(undef)) |
1787
|
4159
|
50
|
|
|
|
6254
|
my @is_objlike = map { ! defined $_ or length ref $_ } (@res_args); |
|
8318
|
|
|
|
|
33437
|
|
1788
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
# turn objlike into proper objects for saner code further down |
1790
|
4159
|
|
|
|
|
7667
|
for (0,1) { |
1791
|
8318
|
100
|
|
|
|
15611
|
next unless $is_objlike[$_]; |
1792
|
|
|
|
|
|
|
|
1793
|
2982
|
100
|
|
|
|
10909
|
if ( defined blessed $res_args[$_] ) { |
1794
|
|
|
|
|
|
|
|
1795
|
|
|
|
|
|
|
# but wait - there is more!!! WHAT THE FUCK?!?!?!?! |
1796
|
2975
|
50
|
|
|
|
22788
|
if ($res_args[$_]->isa('DBIx::Class::ResultSet')) { |
1797
|
0
|
|
|
|
|
0
|
carp('Passing a resultset for relationship resolution makes no sense - invoking __gremlins__'); |
1798
|
0
|
|
|
|
|
0
|
$is_objlike[$_] = 0; |
1799
|
0
|
|
|
|
|
0
|
$res_args[$_] = '__gremlins__'; |
1800
|
|
|
|
|
|
|
} |
1801
|
|
|
|
|
|
|
} |
1802
|
|
|
|
|
|
|
else { |
1803
|
7
|
|
50
|
|
|
21
|
$res_args[$_] ||= {}; |
1804
|
|
|
|
|
|
|
|
1805
|
|
|
|
|
|
|
# hate everywhere - have to pass in as a plain hash |
1806
|
|
|
|
|
|
|
# pretending to be an object at least for now |
1807
|
7
|
50
|
|
|
|
33
|
$self->throw_exception("Unsupported object-like structure encountered: $res_args[$_]") |
1808
|
|
|
|
|
|
|
unless ref $res_args[$_] eq 'HASH'; |
1809
|
|
|
|
|
|
|
} |
1810
|
|
|
|
|
|
|
} |
1811
|
|
|
|
|
|
|
|
1812
|
4159
|
100
|
|
|
|
27499
|
my $args = { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1813
|
|
|
|
|
|
|
condition => $cond, |
1814
|
|
|
|
|
|
|
|
1815
|
|
|
|
|
|
|
# where-is-waldo block guesses relname, then further down we override it if available |
1816
|
|
|
|
|
|
|
( |
1817
|
|
|
|
|
|
|
$is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] ) |
1818
|
|
|
|
|
|
|
: $is_objlike[0] ? ( rel_name => $res_args[1], self_alias => 'me', foreign_alias => $res_args[1], foreign_values => $res_args[0] ) |
1819
|
|
|
|
|
|
|
: ( rel_name => $res_args[0], self_alias => $res_args[1], foreign_alias => $res_args[0] ) |
1820
|
|
|
|
|
|
|
), |
1821
|
|
|
|
|
|
|
|
1822
|
|
|
|
|
|
|
( $rel_name ? ( rel_name => $rel_name ) : () ), |
1823
|
|
|
|
|
|
|
}; |
1824
|
|
|
|
|
|
|
####################### |
1825
|
|
|
|
|
|
|
|
1826
|
|
|
|
|
|
|
# now it's fucking easy isn't it?! |
1827
|
4159
|
|
|
|
|
10883
|
my $rc = $self->_resolve_relationship_condition( $args ); |
1828
|
|
|
|
|
|
|
|
1829
|
|
|
|
|
|
|
my @res = ( |
1830
|
|
|
|
|
|
|
( $rc->{join_free_condition} || $rc->{condition} ), |
1831
|
|
|
|
|
|
|
! $rc->{join_free_condition}, |
1832
|
4157
|
|
66
|
|
|
16505
|
); |
1833
|
|
|
|
|
|
|
|
1834
|
|
|
|
|
|
|
# _resolve_relationship_condition always returns qualified cols even in the |
1835
|
|
|
|
|
|
|
# case of join_free_condition, but nothing downstream expects this |
1836
|
4157
|
100
|
100
|
|
|
16567
|
if ($rc->{join_free_condition} and ref $res[0] eq 'HASH') { |
1837
|
|
|
|
|
|
|
$res[0] = { map |
1838
|
2853
|
|
|
|
|
15579
|
{ ($_ =~ /\.(.+)/) => $res[0]{$_} } |
1839
|
2811
|
|
|
|
|
2909
|
keys %{$res[0]} |
|
2811
|
|
|
|
|
5880
|
|
1840
|
|
|
|
|
|
|
}; |
1841
|
|
|
|
|
|
|
} |
1842
|
|
|
|
|
|
|
|
1843
|
|
|
|
|
|
|
# and more legacy |
1844
|
4157
|
100
|
|
|
|
37298
|
return wantarray ? @res : $res[0]; |
1845
|
|
|
|
|
|
|
} |
1846
|
|
|
|
|
|
|
|
1847
|
|
|
|
|
|
|
# Keep this indefinitely. There is evidence of both CPAN and |
1848
|
|
|
|
|
|
|
# darkpan using it, and there isn't much harm in an extra var |
1849
|
|
|
|
|
|
|
# anyway. |
1850
|
|
|
|
|
|
|
our $UNRESOLVABLE_CONDITION = UNRESOLVABLE_CONDITION; |
1851
|
|
|
|
|
|
|
# YES I KNOW THIS IS EVIL |
1852
|
|
|
|
|
|
|
# it is there to save darkpan from themselves, since internally |
1853
|
|
|
|
|
|
|
# we are moving to a constant |
1854
|
|
|
|
|
|
|
Internals::SvREADONLY($UNRESOLVABLE_CONDITION => 1); |
1855
|
|
|
|
|
|
|
|
1856
|
|
|
|
|
|
|
# Resolves the passed condition to a concrete query fragment and extra |
1857
|
|
|
|
|
|
|
# metadata |
1858
|
|
|
|
|
|
|
# |
1859
|
|
|
|
|
|
|
## self-explanatory API, modeled on the custom cond coderef: |
1860
|
|
|
|
|
|
|
# rel_name => (scalar) |
1861
|
|
|
|
|
|
|
# foreign_alias => (scalar) |
1862
|
|
|
|
|
|
|
# foreign_values => (either not supplied, or a hashref, or a foreign ResultObject (to be ->get_columns()ed), or plain undef ) |
1863
|
|
|
|
|
|
|
# self_alias => (scalar) |
1864
|
|
|
|
|
|
|
# self_result_object => (either not supplied or a result object) |
1865
|
|
|
|
|
|
|
# require_join_free_condition => (boolean, throws on failure to construct a JF-cond) |
1866
|
|
|
|
|
|
|
# infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition) |
1867
|
|
|
|
|
|
|
# condition => (sqla cond struct, optional, defeaults to from $self->rel_info(rel_name)->{cond}) |
1868
|
|
|
|
|
|
|
# |
1869
|
|
|
|
|
|
|
## returns a hash |
1870
|
|
|
|
|
|
|
# condition => (a valid *likely fully qualified* sqla cond structure) |
1871
|
|
|
|
|
|
|
# identity_map => (a hashref of foreign-to-self *unqualified* column equality names) |
1872
|
|
|
|
|
|
|
# join_free_condition => (a valid *fully qualified* sqla cond structure, maybe unset) |
1873
|
|
|
|
|
|
|
# inferred_values => (in case of an available join_free condition, this is a hashref of |
1874
|
|
|
|
|
|
|
# *unqualified* column/value *EQUALITY* pairs, representing an amalgamation |
1875
|
|
|
|
|
|
|
# of the JF-cond parse and infer_values_based_on |
1876
|
|
|
|
|
|
|
# always either complete or unset) |
1877
|
|
|
|
|
|
|
# |
1878
|
|
|
|
|
|
|
sub _resolve_relationship_condition { |
1879
|
5978
|
|
|
5978
|
|
7046
|
my $self = shift; |
1880
|
|
|
|
|
|
|
|
1881
|
5978
|
100
|
|
|
|
18017
|
my $args = { ref $_[0] eq 'HASH' ? %{ $_[0] } : @_ }; |
|
4193
|
|
|
|
|
17082
|
|
1882
|
|
|
|
|
|
|
|
1883
|
5978
|
|
|
|
|
10626
|
for ( qw( rel_name self_alias foreign_alias ) ) { |
1884
|
|
|
|
|
|
|
$self->throw_exception("Mandatory argument '$_' to _resolve_relationship_condition() is not a plain string") |
1885
|
17934
|
50
|
33
|
|
|
64316
|
if !defined $args->{$_} or length ref $args->{$_}; |
1886
|
|
|
|
|
|
|
} |
1887
|
|
|
|
|
|
|
|
1888
|
|
|
|
|
|
|
$self->throw_exception("Arguments 'self_alias' and 'foreign_alias' may not be identical") |
1889
|
5978
|
50
|
|
|
|
13687
|
if $args->{self_alias} eq $args->{foreign_alias}; |
1890
|
|
|
|
|
|
|
|
1891
|
|
|
|
|
|
|
# TEMP |
1892
|
5978
|
|
|
|
|
11636
|
my $exception_rel_id = "relationship '$args->{rel_name}' on source '@{[ $self->source_name ]}'"; |
|
5978
|
|
|
|
|
23677
|
|
1893
|
|
|
|
|
|
|
|
1894
|
|
|
|
|
|
|
my $rel_info = $self->relationship_info($args->{rel_name}) |
1895
|
|
|
|
|
|
|
# TEMP |
1896
|
|
|
|
|
|
|
# or $self->throw_exception( "No such $exception_rel_id" ); |
1897
|
5978
|
50
|
|
|
|
41349
|
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
|
|
1898
|
|
|
|
|
|
|
|
1899
|
|
|
|
|
|
|
# TEMP |
1900
|
77
|
|
|
|
|
202
|
$exception_rel_id = "relationship '$rel_info->{_original_name}' on source '@{[ $self->source_name ]}'" |
1901
|
5978
|
100
|
33
|
|
|
20758
|
if $rel_info and exists $rel_info->{_original_name}; |
1902
|
|
|
|
|
|
|
|
1903
|
|
|
|
|
|
|
$self->throw_exception("No practical way to resolve $exception_rel_id between two data structures") |
1904
|
5978
|
50
|
66
|
|
|
15841
|
if exists $args->{self_result_object} and exists $args->{foreign_values}; |
1905
|
|
|
|
|
|
|
|
1906
|
|
|
|
|
|
|
$self->throw_exception( "Argument to infer_values_based_on must be a hash" ) |
1907
|
5978
|
50
|
66
|
|
|
16390
|
if exists $args->{infer_values_based_on} and ref $args->{infer_values_based_on} ne 'HASH'; |
1908
|
|
|
|
|
|
|
|
1909
|
5978
|
|
66
|
|
|
23732
|
$args->{require_join_free_condition} ||= !!$args->{infer_values_based_on}; |
1910
|
|
|
|
|
|
|
|
1911
|
5978
|
|
66
|
|
|
14289
|
$args->{condition} ||= $rel_info->{cond}; |
1912
|
|
|
|
|
|
|
|
1913
|
|
|
|
|
|
|
$self->throw_exception( "Argument 'self_result_object' must be an object inheriting from DBIx::Class::Row" ) |
1914
|
|
|
|
|
|
|
if ( |
1915
|
|
|
|
|
|
|
exists $args->{self_result_object} |
1916
|
|
|
|
|
|
|
and |
1917
|
5978
|
50
|
33
|
|
|
42459
|
( ! defined blessed $args->{self_result_object} or ! $args->{self_result_object}->isa('DBIx::Class::Row') ) |
|
|
|
66
|
|
|
|
|
1918
|
|
|
|
|
|
|
) |
1919
|
|
|
|
|
|
|
; |
1920
|
|
|
|
|
|
|
|
1921
|
|
|
|
|
|
|
#TEMP |
1922
|
5978
|
|
|
|
|
6917
|
my $rel_rsrc;# = $self->related_source($args->{rel_name}); |
1923
|
|
|
|
|
|
|
|
1924
|
5978
|
100
|
|
|
|
10431
|
if (exists $args->{foreign_values}) { |
1925
|
|
|
|
|
|
|
# TEMP |
1926
|
603
|
|
33
|
|
|
2016
|
$rel_rsrc ||= $self->related_source($args->{rel_name}); |
1927
|
|
|
|
|
|
|
|
1928
|
603
|
100
|
66
|
|
|
3733
|
if (defined blessed $args->{foreign_values}) { |
|
|
50
|
|
|
|
|
|
1929
|
|
|
|
|
|
|
|
1930
|
|
|
|
|
|
|
$self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" ) |
1931
|
594
|
50
|
|
|
|
3016
|
unless $args->{foreign_values}->isa('DBIx::Class::Row'); |
1932
|
|
|
|
|
|
|
|
1933
|
|
|
|
|
|
|
carp_unique( |
1934
|
|
|
|
|
|
|
"Objects supplied as 'foreign_values' ($args->{foreign_values}) " |
1935
|
0
|
|
|
|
|
0
|
. "usually should inherit from the related ResultClass ('@{[ $rel_rsrc->result_class ]}'), " |
1936
|
|
|
|
|
|
|
. "perhaps you've made a mistake invoking the condition resolver?" |
1937
|
594
|
50
|
|
|
|
11117
|
) unless $args->{foreign_values}->isa($rel_rsrc->result_class); |
1938
|
|
|
|
|
|
|
|
1939
|
594
|
|
|
|
|
2258
|
$args->{foreign_values} = { $args->{foreign_values}->get_columns }; |
1940
|
|
|
|
|
|
|
} |
1941
|
|
|
|
|
|
|
elsif (! defined $args->{foreign_values} or ref $args->{foreign_values} eq 'HASH') { |
1942
|
9
|
|
|
|
|
46
|
my $ri = { map { $_ => 1 } $rel_rsrc->relationships }; |
|
107
|
|
|
|
|
153
|
|
1943
|
9
|
|
|
|
|
44
|
my $ci = $rel_rsrc->columns_info; |
1944
|
|
|
|
|
|
|
! exists $ci->{$_} and ! exists $ri->{$_} and $self->throw_exception( |
1945
|
0
|
|
|
|
|
0
|
"Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" |
1946
|
9
|
|
100
|
|
|
16
|
) for keys %{ $args->{foreign_values} ||= {} }; |
|
9
|
|
66
|
|
|
99
|
|
|
|
|
33
|
|
|
|
|
1947
|
|
|
|
|
|
|
} |
1948
|
|
|
|
|
|
|
else { |
1949
|
0
|
|
|
|
|
0
|
$self->throw_exception( |
1950
|
0
|
|
|
|
|
0
|
"Argument 'foreign_values' must be either an object inheriting from '@{[ $rel_rsrc->result_class ]}', " |
1951
|
|
|
|
|
|
|
. "or a hash reference, or undef" |
1952
|
|
|
|
|
|
|
); |
1953
|
|
|
|
|
|
|
} |
1954
|
|
|
|
|
|
|
} |
1955
|
|
|
|
|
|
|
|
1956
|
5978
|
|
|
|
|
5975
|
my $ret; |
1957
|
|
|
|
|
|
|
|
1958
|
5978
|
100
|
|
|
|
18234
|
if (ref $args->{condition} eq 'CODE') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1959
|
|
|
|
|
|
|
|
1960
|
|
|
|
|
|
|
my $cref_args = { |
1961
|
|
|
|
|
|
|
rel_name => $args->{rel_name}, |
1962
|
|
|
|
|
|
|
self_resultsource => $self, |
1963
|
|
|
|
|
|
|
self_alias => $args->{self_alias}, |
1964
|
|
|
|
|
|
|
foreign_alias => $args->{foreign_alias}, |
1965
|
|
|
|
|
|
|
( map |
1966
|
226
|
100
|
|
|
|
476
|
{ (exists $args->{$_}) ? ( $_ => $args->{$_} ) : () } |
|
452
|
|
|
|
|
1274
|
|
1967
|
|
|
|
|
|
|
qw( self_result_object foreign_values ) |
1968
|
|
|
|
|
|
|
), |
1969
|
|
|
|
|
|
|
}; |
1970
|
|
|
|
|
|
|
|
1971
|
|
|
|
|
|
|
# legacy - never remove these!!! |
1972
|
226
|
|
|
|
|
346
|
$cref_args->{foreign_relname} = $cref_args->{rel_name}; |
1973
|
|
|
|
|
|
|
|
1974
|
|
|
|
|
|
|
$cref_args->{self_rowobj} = $cref_args->{self_result_object} |
1975
|
226
|
100
|
|
|
|
464
|
if exists $cref_args->{self_result_object}; |
1976
|
|
|
|
|
|
|
|
1977
|
226
|
|
|
|
|
596
|
($ret->{condition}, $ret->{join_free_condition}, my @extra) = $args->{condition}->($cref_args); |
1978
|
|
|
|
|
|
|
|
1979
|
|
|
|
|
|
|
# sanity check |
1980
|
226
|
100
|
|
|
|
1703
|
$self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra") |
1981
|
|
|
|
|
|
|
if @extra; |
1982
|
|
|
|
|
|
|
|
1983
|
225
|
100
|
|
|
|
767
|
if (my $jfc = $ret->{join_free_condition}) { |
1984
|
|
|
|
|
|
|
|
1985
|
22
|
50
|
|
|
|
57
|
$self->throw_exception ( |
1986
|
|
|
|
|
|
|
"The join-free condition returned for $exception_rel_id must be a hash reference" |
1987
|
|
|
|
|
|
|
) unless ref $jfc eq 'HASH'; |
1988
|
|
|
|
|
|
|
|
1989
|
|
|
|
|
|
|
# TEMP |
1990
|
22
|
|
66
|
|
|
76
|
$rel_rsrc ||= $self->related_source($args->{rel_name}); |
1991
|
|
|
|
|
|
|
|
1992
|
22
|
|
|
|
|
68
|
my ($joinfree_alias, $joinfree_source); |
1993
|
22
|
100
|
|
|
|
55
|
if (defined $args->{self_result_object}) { |
|
|
50
|
|
|
|
|
|
1994
|
19
|
|
|
|
|
24
|
$joinfree_alias = $args->{foreign_alias}; |
1995
|
19
|
|
|
|
|
17
|
$joinfree_source = $rel_rsrc; |
1996
|
|
|
|
|
|
|
} |
1997
|
|
|
|
|
|
|
elsif (defined $args->{foreign_values}) { |
1998
|
3
|
|
|
|
|
5
|
$joinfree_alias = $args->{self_alias}; |
1999
|
3
|
|
|
|
|
5
|
$joinfree_source = $self; |
2000
|
|
|
|
|
|
|
} |
2001
|
|
|
|
|
|
|
|
2002
|
|
|
|
|
|
|
# FIXME sanity check until things stabilize, remove at some point |
2003
|
|
|
|
|
|
|
$self->throw_exception ( |
2004
|
22
|
50
|
|
|
|
48
|
"A join-free condition returned for $exception_rel_id without a result object to chain from" |
2005
|
|
|
|
|
|
|
) unless $joinfree_alias; |
2006
|
|
|
|
|
|
|
|
2007
|
|
|
|
|
|
|
my $fq_col_list = { map |
2008
|
22
|
|
|
|
|
51
|
{ ( "$joinfree_alias.$_" => 1 ) } |
|
120
|
|
|
|
|
229
|
|
2009
|
|
|
|
|
|
|
$joinfree_source->columns |
2010
|
|
|
|
|
|
|
}; |
2011
|
|
|
|
|
|
|
|
2012
|
|
|
|
|
|
|
exists $fq_col_list->{$_} or $self->throw_exception ( |
2013
|
|
|
|
|
|
|
"The join-free condition returned for $exception_rel_id may only " |
2014
|
|
|
|
|
|
|
. 'contain keys that are fully qualified column names of the corresponding source ' |
2015
|
|
|
|
|
|
|
. "(it returned '$_')" |
2016
|
22
|
|
33
|
|
|
129
|
) for keys %$jfc; |
2017
|
|
|
|
|
|
|
|
2018
|
|
|
|
|
|
|
( |
2019
|
|
|
|
|
|
|
length ref $_ |
2020
|
|
|
|
|
|
|
and |
2021
|
|
|
|
|
|
|
defined blessed($_) |
2022
|
|
|
|
|
|
|
and |
2023
|
|
|
|
|
|
|
$_->isa('DBIx::Class::Row') |
2024
|
|
|
|
|
|
|
and |
2025
|
|
|
|
|
|
|
$self->throw_exception ( |
2026
|
|
|
|
|
|
|
"The join-free condition returned for $exception_rel_id may not " |
2027
|
|
|
|
|
|
|
. 'contain result objects as values - perhaps instead of invoking ' |
2028
|
|
|
|
|
|
|
. '->$something you meant to return ->get_column($something)' |
2029
|
|
|
|
|
|
|
) |
2030
|
22
|
|
66
|
|
|
230
|
) for values %$jfc; |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
2031
|
|
|
|
|
|
|
|
2032
|
|
|
|
|
|
|
} |
2033
|
|
|
|
|
|
|
} |
2034
|
|
|
|
|
|
|
elsif (ref $args->{condition} eq 'HASH') { |
2035
|
|
|
|
|
|
|
|
2036
|
|
|
|
|
|
|
# the condition is static - use parallel arrays |
2037
|
|
|
|
|
|
|
# for a "pivot" depending on which side of the |
2038
|
|
|
|
|
|
|
# rel did we get as an object |
2039
|
5735
|
|
|
|
|
5558
|
my (@f_cols, @l_cols); |
2040
|
5735
|
|
|
|
|
5037
|
for my $fc (keys %{$args->{condition}}) { |
|
5735
|
|
|
|
|
15717
|
|
2041
|
5847
|
|
|
|
|
9739
|
my $lc = $args->{condition}{$fc}; |
2042
|
|
|
|
|
|
|
|
2043
|
|
|
|
|
|
|
# FIXME STRICTMODE should probably check these are valid columns |
2044
|
5847
|
50
|
|
|
|
27969
|
$fc =~ s/^foreign\.// || |
2045
|
|
|
|
|
|
|
$self->throw_exception("Invalid rel cond key '$fc'"); |
2046
|
|
|
|
|
|
|
|
2047
|
5847
|
50
|
|
|
|
19411
|
$lc =~ s/^self\.// || |
2048
|
|
|
|
|
|
|
$self->throw_exception("Invalid rel cond val '$lc'"); |
2049
|
|
|
|
|
|
|
|
2050
|
5847
|
|
|
|
|
9188
|
push @f_cols, $fc; |
2051
|
5847
|
|
|
|
|
9811
|
push @l_cols, $lc; |
2052
|
|
|
|
|
|
|
} |
2053
|
|
|
|
|
|
|
|
2054
|
|
|
|
|
|
|
# construct the crosstable condition and the identity map |
2055
|
5735
|
|
|
|
|
13995
|
for (0..$#f_cols) { |
2056
|
5847
|
|
|
|
|
31767
|
$ret->{condition}{"$args->{foreign_alias}.$f_cols[$_]"} = { -ident => "$args->{self_alias}.$l_cols[$_]" }; |
2057
|
5847
|
|
|
|
|
16745
|
$ret->{identity_map}{$l_cols[$_]} = $f_cols[$_]; |
2058
|
|
|
|
|
|
|
}; |
2059
|
|
|
|
|
|
|
|
2060
|
5735
|
100
|
|
|
|
16769
|
if ($args->{foreign_values}) { |
|
|
100
|
|
|
|
|
|
2061
|
|
|
|
|
|
|
$ret->{join_free_condition}{"$args->{self_alias}.$l_cols[$_]"} = $args->{foreign_values}{$f_cols[$_]} |
2062
|
599
|
|
|
|
|
2918
|
for 0..$#f_cols; |
2063
|
|
|
|
|
|
|
} |
2064
|
|
|
|
|
|
|
elsif (defined $args->{self_result_object}) { |
2065
|
|
|
|
|
|
|
|
2066
|
4035
|
|
|
|
|
6459
|
for my $i (0..$#l_cols) { |
2067
|
4065
|
100
|
|
|
|
15484
|
if ( $args->{self_result_object}->has_column_loaded($l_cols[$i]) ) { |
2068
|
3975
|
|
|
|
|
11719
|
$ret->{join_free_condition}{"$args->{foreign_alias}.$f_cols[$i]"} = $args->{self_result_object}->get_column($l_cols[$i]); |
2069
|
|
|
|
|
|
|
} |
2070
|
|
|
|
|
|
|
else { |
2071
|
|
|
|
|
|
|
$self->throw_exception(sprintf |
2072
|
|
|
|
|
|
|
"Unable to resolve relationship '%s' from object '%s': column '%s' not " |
2073
|
|
|
|
|
|
|
. 'loaded from storage (or not passed to new() prior to insert()). You ' |
2074
|
|
|
|
|
|
|
. 'probably need to call ->discard_changes to get the server-side defaults ' |
2075
|
|
|
|
|
|
|
. 'from the database.', |
2076
|
|
|
|
|
|
|
$args->{rel_name}, |
2077
|
|
|
|
|
|
|
$args->{self_result_object}, |
2078
|
|
|
|
|
|
|
$l_cols[$i], |
2079
|
90
|
100
|
|
|
|
376
|
) if $args->{self_result_object}->in_storage; |
2080
|
|
|
|
|
|
|
|
2081
|
|
|
|
|
|
|
# FIXME - temporarly force-override |
2082
|
88
|
|
|
|
|
1521
|
delete $args->{require_join_free_condition}; |
2083
|
88
|
|
|
|
|
152
|
$ret->{join_free_condition} = UNRESOLVABLE_CONDITION; |
2084
|
88
|
|
|
|
|
175
|
last; |
2085
|
|
|
|
|
|
|
} |
2086
|
|
|
|
|
|
|
} |
2087
|
|
|
|
|
|
|
} |
2088
|
|
|
|
|
|
|
} |
2089
|
|
|
|
|
|
|
elsif (ref $args->{condition} eq 'ARRAY') { |
2090
|
17
|
50
|
|
|
|
31
|
if (@{$args->{condition}} == 0) { |
|
17
|
50
|
|
|
|
52
|
|
2091
|
0
|
|
|
|
|
0
|
$ret = { |
2092
|
|
|
|
|
|
|
condition => UNRESOLVABLE_CONDITION, |
2093
|
|
|
|
|
|
|
join_free_condition => UNRESOLVABLE_CONDITION, |
2094
|
|
|
|
|
|
|
}; |
2095
|
|
|
|
|
|
|
} |
2096
|
17
|
|
|
|
|
55
|
elsif (@{$args->{condition}} == 1) { |
2097
|
|
|
|
|
|
|
$ret = $self->_resolve_relationship_condition({ |
2098
|
|
|
|
|
|
|
%$args, |
2099
|
0
|
|
|
|
|
0
|
condition => $args->{condition}[0], |
2100
|
|
|
|
|
|
|
}); |
2101
|
|
|
|
|
|
|
} |
2102
|
|
|
|
|
|
|
else { |
2103
|
|
|
|
|
|
|
# we are discarding inferred values here... likely incorrect... |
2104
|
|
|
|
|
|
|
# then again - the entire thing is an OR, so we *can't* use them anyway |
2105
|
17
|
|
|
|
|
27
|
for my $subcond ( map |
2106
|
34
|
|
|
|
|
266
|
{ $self->_resolve_relationship_condition({ %$args, condition => $_ }) } |
2107
|
17
|
|
|
|
|
44
|
@{$args->{condition}} |
2108
|
|
|
|
|
|
|
) { |
2109
|
|
|
|
|
|
|
$self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition') |
2110
|
34
|
50
|
50
|
|
|
161
|
if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) ); |
|
|
|
66
|
|
|
|
|
2111
|
|
|
|
|
|
|
|
2112
|
34
|
|
66
|
|
|
88
|
$subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition)); |
|
54
|
|
|
|
|
164
|
|
2113
|
|
|
|
|
|
|
} |
2114
|
|
|
|
|
|
|
} |
2115
|
|
|
|
|
|
|
} |
2116
|
|
|
|
|
|
|
else { |
2117
|
0
|
|
|
|
|
0
|
$self->throw_exception ("Can't handle condition $args->{condition} for $exception_rel_id yet :("); |
2118
|
|
|
|
|
|
|
} |
2119
|
|
|
|
|
|
|
|
2120
|
|
|
|
|
|
|
$self->throw_exception(ucfirst "$exception_rel_id does not resolve to a join-free condition fragment") if ( |
2121
|
|
|
|
|
|
|
$args->{require_join_free_condition} |
2122
|
|
|
|
|
|
|
and |
2123
|
5975
|
100
|
66
|
|
|
19384
|
( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION ) |
|
|
|
66
|
|
|
|
|
2124
|
|
|
|
|
|
|
); |
2125
|
|
|
|
|
|
|
|
2126
|
5974
|
|
|
|
|
12952
|
my $storage = $self->schema->storage; |
2127
|
|
|
|
|
|
|
|
2128
|
|
|
|
|
|
|
# we got something back - sanity check and infer values if we can |
2129
|
5974
|
|
|
|
|
63429
|
my @nonvalues; |
2130
|
5974
|
100
|
100
|
|
|
29972
|
if ( my $jfc = $ret->{join_free_condition} and $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION ) { |
2131
|
|
|
|
|
|
|
|
2132
|
4576
|
|
|
|
|
16439
|
my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls'); |
2133
|
|
|
|
|
|
|
|
2134
|
4576
|
100
|
|
|
|
10709
|
if (keys %$jfc_eqs) { |
2135
|
|
|
|
|
|
|
|
2136
|
4566
|
|
|
|
|
7566
|
for (keys %$jfc) { |
2137
|
|
|
|
|
|
|
# $jfc is fully qualified by definition |
2138
|
4648
|
|
|
|
|
19920
|
my ($col) = $_ =~ /\.(.+)/; |
2139
|
|
|
|
|
|
|
|
2140
|
4648
|
100
|
100
|
|
|
25741
|
if (exists $jfc_eqs->{$_} and ($jfc_eqs->{$_}||'') ne UNRESOLVABLE_CONDITION) { |
|
|
100
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
2141
|
4637
|
|
|
|
|
14557
|
$ret->{inferred_values}{$col} = $jfc_eqs->{$_}; |
2142
|
|
|
|
|
|
|
} |
2143
|
|
|
|
|
|
|
elsif ( !$args->{infer_values_based_on} or ! exists $args->{infer_values_based_on}{$col} ) { |
2144
|
10
|
|
|
|
|
15
|
push @nonvalues, $col; |
2145
|
|
|
|
|
|
|
} |
2146
|
|
|
|
|
|
|
} |
2147
|
|
|
|
|
|
|
|
2148
|
|
|
|
|
|
|
# all or nothing |
2149
|
4566
|
100
|
|
|
|
11650
|
delete $ret->{inferred_values} if @nonvalues; |
2150
|
|
|
|
|
|
|
} |
2151
|
|
|
|
|
|
|
} |
2152
|
|
|
|
|
|
|
|
2153
|
|
|
|
|
|
|
# did the user explicitly ask |
2154
|
5974
|
100
|
|
|
|
12975
|
if ($args->{infer_values_based_on}) { |
2155
|
|
|
|
|
|
|
|
2156
|
|
|
|
|
|
|
$self->throw_exception(sprintf ( |
2157
|
|
|
|
|
|
|
"Unable to complete value inferrence - custom $exception_rel_id returns conditions instead of values for column(s): %s", |
2158
|
1248
|
100
|
|
|
|
2269
|
map { "'$_'" } @nonvalues |
|
1
|
|
|
|
|
12
|
|
2159
|
|
|
|
|
|
|
)) if @nonvalues; |
2160
|
|
|
|
|
|
|
|
2161
|
|
|
|
|
|
|
|
2162
|
1247
|
|
100
|
|
|
2472
|
$ret->{inferred_values} ||= {}; |
2163
|
|
|
|
|
|
|
|
2164
|
|
|
|
|
|
|
$ret->{inferred_values}{$_} = $args->{infer_values_based_on}{$_} |
2165
|
1247
|
|
|
|
|
1030
|
for keys %{$args->{infer_values_based_on}}; |
|
1247
|
|
|
|
|
4189
|
|
2166
|
|
|
|
|
|
|
} |
2167
|
|
|
|
|
|
|
|
2168
|
|
|
|
|
|
|
# add the identities based on the main condition |
2169
|
|
|
|
|
|
|
# (may already be there, since easy to calculate on the fly in the HASH case) |
2170
|
5973
|
100
|
|
|
|
11521
|
if ( ! $ret->{identity_map} ) { |
2171
|
|
|
|
|
|
|
|
2172
|
240
|
|
|
|
|
740
|
my $col_eqs = $storage->_extract_fixed_condition_columns($ret->{condition}); |
2173
|
|
|
|
|
|
|
|
2174
|
240
|
|
|
|
|
215
|
my $colinfos; |
2175
|
240
|
|
|
|
|
456
|
for my $lhs (keys %$col_eqs) { |
2176
|
|
|
|
|
|
|
|
2177
|
222
|
50
|
|
|
|
585
|
next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION; |
2178
|
|
|
|
|
|
|
|
2179
|
|
|
|
|
|
|
# TEMP |
2180
|
222
|
|
66
|
|
|
796
|
$rel_rsrc ||= $self->related_source($args->{rel_name}); |
2181
|
|
|
|
|
|
|
|
2182
|
|
|
|
|
|
|
# there is no way to know who is right and who is left in a cref |
2183
|
|
|
|
|
|
|
# therefore a full blown resolution call, and figure out the |
2184
|
|
|
|
|
|
|
# direction a bit further below |
2185
|
|
|
|
|
|
|
$colinfos ||= $storage->_resolve_column_info([ |
2186
|
|
|
|
|
|
|
{ -alias => $args->{self_alias}, -rsrc => $self }, |
2187
|
222
|
|
66
|
|
|
2020
|
{ -alias => $args->{foreign_alias}, -rsrc => $rel_rsrc }, |
2188
|
|
|
|
|
|
|
]); |
2189
|
|
|
|
|
|
|
|
2190
|
222
|
50
|
|
|
|
673
|
next unless $colinfos->{$lhs}; # someone is engaging in witchcraft |
2191
|
|
|
|
|
|
|
|
2192
|
222
|
100
|
50
|
|
|
620
|
if ( my $rhs_ref = is_literal_value( $col_eqs->{$lhs} ) ) { |
|
|
100
|
66
|
|
|
|
|
2193
|
|
|
|
|
|
|
|
2194
|
184
|
100
|
66
|
|
|
3330
|
if ( |
2195
|
|
|
|
|
|
|
$colinfos->{$rhs_ref->[0]} |
2196
|
|
|
|
|
|
|
and |
2197
|
|
|
|
|
|
|
$colinfos->{$lhs}{-source_alias} ne $colinfos->{$rhs_ref->[0]}{-source_alias} |
2198
|
|
|
|
|
|
|
) { |
2199
|
|
|
|
|
|
|
( $colinfos->{$lhs}{-source_alias} eq $args->{self_alias} ) |
2200
|
|
|
|
|
|
|
? ( $ret->{identity_map}{$colinfos->{$lhs}{-colname}} = $colinfos->{$rhs_ref->[0]}{-colname} ) |
2201
|
|
|
|
|
|
|
: ( $ret->{identity_map}{$colinfos->{$rhs_ref->[0]}{-colname}} = $colinfos->{$lhs}{-colname} ) |
2202
|
8
|
50
|
|
|
|
112
|
; |
2203
|
|
|
|
|
|
|
} |
2204
|
|
|
|
|
|
|
} |
2205
|
|
|
|
|
|
|
elsif ( |
2206
|
|
|
|
|
|
|
$col_eqs->{$lhs} =~ /^ ( \Q$args->{self_alias}\E \. .+ ) /x |
2207
|
|
|
|
|
|
|
and |
2208
|
|
|
|
|
|
|
($colinfos->{$1}||{})->{-result_source} == $rel_rsrc |
2209
|
|
|
|
|
|
|
) { |
2210
|
|
|
|
|
|
|
my ($lcol, $rcol) = map |
2211
|
2
|
|
|
|
|
78
|
{ $colinfos->{$_}{-colname} } |
|
4
|
|
|
|
|
12
|
|
2212
|
|
|
|
|
|
|
( $lhs, $1 ) |
2213
|
|
|
|
|
|
|
; |
2214
|
2
|
|
|
|
|
16
|
carp_unique( |
2215
|
|
|
|
|
|
|
"The $exception_rel_id specifies equality of column '$lcol' and the " |
2216
|
|
|
|
|
|
|
. "*VALUE* '$rcol' (you did not use the { -ident => ... } operator)" |
2217
|
|
|
|
|
|
|
); |
2218
|
|
|
|
|
|
|
} |
2219
|
|
|
|
|
|
|
} |
2220
|
|
|
|
|
|
|
} |
2221
|
|
|
|
|
|
|
|
2222
|
|
|
|
|
|
|
# FIXME - temporary, to fool the idiotic check in SQLMaker::_join_condition |
2223
|
|
|
|
|
|
|
$ret->{condition} = { -and => [ $ret->{condition} ] } |
2224
|
5973
|
50
|
|
|
|
29648
|
unless $ret->{condition} eq UNRESOLVABLE_CONDITION; |
2225
|
|
|
|
|
|
|
|
2226
|
5973
|
|
|
|
|
34408
|
$ret; |
2227
|
|
|
|
|
|
|
} |
2228
|
|
|
|
|
|
|
|
2229
|
|
|
|
|
|
|
=head2 related_source |
2230
|
|
|
|
|
|
|
|
2231
|
|
|
|
|
|
|
=over 4 |
2232
|
|
|
|
|
|
|
|
2233
|
|
|
|
|
|
|
=item Arguments: $rel_name |
2234
|
|
|
|
|
|
|
|
2235
|
|
|
|
|
|
|
=item Return Value: $source |
2236
|
|
|
|
|
|
|
|
2237
|
|
|
|
|
|
|
=back |
2238
|
|
|
|
|
|
|
|
2239
|
|
|
|
|
|
|
Returns the result source object for the given relationship. |
2240
|
|
|
|
|
|
|
|
2241
|
|
|
|
|
|
|
=cut |
2242
|
|
|
|
|
|
|
|
2243
|
|
|
|
|
|
|
sub related_source { |
2244
|
16320
|
|
|
16320
|
1
|
20291
|
my ($self, $rel) = @_; |
2245
|
16320
|
50
|
|
|
|
25947
|
if( !$self->has_relationship( $rel ) ) { |
2246
|
0
|
|
|
|
|
0
|
$self->throw_exception("No such relationship '$rel' on " . $self->source_name); |
2247
|
|
|
|
|
|
|
} |
2248
|
|
|
|
|
|
|
|
2249
|
|
|
|
|
|
|
# if we are not registered with a schema - just use the prototype |
2250
|
|
|
|
|
|
|
# however if we do have a schema - ask for the source by name (and |
2251
|
|
|
|
|
|
|
# throw in the process if all fails) |
2252
|
16320
|
100
|
|
16320
|
|
65954
|
if (my $schema = try { $self->schema }) { |
|
16320
|
|
|
|
|
386036
|
|
2253
|
16301
|
|
|
|
|
122569
|
$schema->source($self->relationship_info($rel)->{source}); |
2254
|
|
|
|
|
|
|
} |
2255
|
|
|
|
|
|
|
else { |
2256
|
19
|
|
|
|
|
345
|
my $class = $self->relationship_info($rel)->{class}; |
2257
|
19
|
|
|
|
|
70
|
$self->ensure_class_loaded($class); |
2258
|
19
|
|
|
|
|
763
|
$class->result_source_instance; |
2259
|
|
|
|
|
|
|
} |
2260
|
|
|
|
|
|
|
} |
2261
|
|
|
|
|
|
|
|
2262
|
|
|
|
|
|
|
=head2 related_class |
2263
|
|
|
|
|
|
|
|
2264
|
|
|
|
|
|
|
=over 4 |
2265
|
|
|
|
|
|
|
|
2266
|
|
|
|
|
|
|
=item Arguments: $rel_name |
2267
|
|
|
|
|
|
|
|
2268
|
|
|
|
|
|
|
=item Return Value: $classname |
2269
|
|
|
|
|
|
|
|
2270
|
|
|
|
|
|
|
=back |
2271
|
|
|
|
|
|
|
|
2272
|
|
|
|
|
|
|
Returns the class name for objects in the given relationship. |
2273
|
|
|
|
|
|
|
|
2274
|
|
|
|
|
|
|
=cut |
2275
|
|
|
|
|
|
|
|
2276
|
|
|
|
|
|
|
sub related_class { |
2277
|
0
|
|
|
0
|
1
|
0
|
my ($self, $rel) = @_; |
2278
|
0
|
0
|
|
|
|
0
|
if( !$self->has_relationship( $rel ) ) { |
2279
|
0
|
|
|
|
|
0
|
$self->throw_exception("No such relationship '$rel' on " . $self->source_name); |
2280
|
|
|
|
|
|
|
} |
2281
|
0
|
|
|
|
|
0
|
return $self->schema->class($self->relationship_info($rel)->{source}); |
2282
|
|
|
|
|
|
|
} |
2283
|
|
|
|
|
|
|
|
2284
|
|
|
|
|
|
|
=head2 handle |
2285
|
|
|
|
|
|
|
|
2286
|
|
|
|
|
|
|
=over 4 |
2287
|
|
|
|
|
|
|
|
2288
|
|
|
|
|
|
|
=item Arguments: none |
2289
|
|
|
|
|
|
|
|
2290
|
|
|
|
|
|
|
=item Return Value: L<$source_handle|DBIx::Class::ResultSourceHandle> |
2291
|
|
|
|
|
|
|
|
2292
|
|
|
|
|
|
|
=back |
2293
|
|
|
|
|
|
|
|
2294
|
|
|
|
|
|
|
Obtain a new L |
2295
|
|
|
|
|
|
|
for this source. Used as a serializable pointer to this resultsource, as it is not |
2296
|
|
|
|
|
|
|
easy (nor advisable) to serialize CODErefs which may very well be present in e.g. |
2297
|
|
|
|
|
|
|
relationship definitions. |
2298
|
|
|
|
|
|
|
|
2299
|
|
|
|
|
|
|
=cut |
2300
|
|
|
|
|
|
|
|
2301
|
|
|
|
|
|
|
sub handle { |
2302
|
|
|
|
|
|
|
return DBIx::Class::ResultSourceHandle->new({ |
2303
|
|
|
|
|
|
|
source_moniker => $_[0]->source_name, |
2304
|
|
|
|
|
|
|
|
2305
|
|
|
|
|
|
|
# so that a detached thaw can be re-frozen |
2306
|
|
|
|
|
|
|
$_[0]->{_detached_thaw} |
2307
|
206
|
50
|
|
206
|
1
|
836
|
? ( _detached_source => $_[0] ) |
2308
|
|
|
|
|
|
|
: ( schema => $_[0]->schema ) |
2309
|
|
|
|
|
|
|
, |
2310
|
|
|
|
|
|
|
}); |
2311
|
|
|
|
|
|
|
} |
2312
|
|
|
|
|
|
|
|
2313
|
|
|
|
|
|
|
my $global_phase_destroy; |
2314
|
|
|
|
|
|
|
sub DESTROY { |
2315
|
|
|
|
|
|
|
### NO detected_reinvoked_destructor check |
2316
|
|
|
|
|
|
|
### This code very much relies on being called multuple times |
2317
|
|
|
|
|
|
|
|
2318
|
123203
|
50
|
33
|
123203
|
|
2338271
|
return if $global_phase_destroy ||= in_global_destruction; |
2319
|
|
|
|
|
|
|
|
2320
|
|
|
|
|
|
|
###### |
2321
|
|
|
|
|
|
|
# !!! ACHTUNG !!!! |
2322
|
|
|
|
|
|
|
###### |
2323
|
|
|
|
|
|
|
# |
2324
|
|
|
|
|
|
|
# Under no circumstances shall $_[0] be stored anywhere else (like copied to |
2325
|
|
|
|
|
|
|
# a lexical variable, or shifted, or anything else). Doing so will mess up |
2326
|
|
|
|
|
|
|
# the refcount of this particular result source, and will allow the $schema |
2327
|
|
|
|
|
|
|
# we are trying to save to reattach back to the source we are destroying. |
2328
|
|
|
|
|
|
|
# The relevant code checking refcounts is in ::Schema::DESTROY() |
2329
|
|
|
|
|
|
|
|
2330
|
|
|
|
|
|
|
# if we are not a schema instance holder - we don't matter |
2331
|
|
|
|
|
|
|
return if( |
2332
|
|
|
|
|
|
|
! ref $_[0]->{schema} |
2333
|
|
|
|
|
|
|
or |
2334
|
|
|
|
|
|
|
isweak $_[0]->{schema} |
2335
|
123203
|
100
|
100
|
|
|
1633501
|
); |
2336
|
|
|
|
|
|
|
|
2337
|
|
|
|
|
|
|
# weaken our schema hold forcing the schema to find somewhere else to live |
2338
|
|
|
|
|
|
|
# during global destruction (if we have not yet bailed out) this will throw |
2339
|
|
|
|
|
|
|
# which will serve as a signal to not try doing anything else |
2340
|
|
|
|
|
|
|
# however beware - on older perls the exception seems randomly untrappable |
2341
|
|
|
|
|
|
|
# due to some weird race condition during thread joining :((( |
2342
|
18675
|
|
|
|
|
16711
|
local $@; |
2343
|
|
|
|
|
|
|
eval { |
2344
|
18675
|
|
|
|
|
27361
|
weaken $_[0]->{schema}; |
2345
|
|
|
|
|
|
|
|
2346
|
|
|
|
|
|
|
# if schema is still there reintroduce ourselves with strong refs back to us |
2347
|
18675
|
100
|
|
|
|
30351
|
if ($_[0]->{schema}) { |
2348
|
18665
|
|
|
|
|
306898
|
my $srcregs = $_[0]->{schema}->source_registrations; |
2349
|
18665
|
|
|
|
|
227839
|
for (keys %$srcregs) { |
2350
|
858686
|
50
|
|
|
|
1004484
|
next unless $srcregs->{$_}; |
2351
|
858686
|
100
|
|
|
|
1139294
|
$srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0]; |
2352
|
|
|
|
|
|
|
} |
2353
|
|
|
|
|
|
|
} |
2354
|
|
|
|
|
|
|
|
2355
|
18675
|
|
|
|
|
56643
|
1; |
2356
|
18675
|
50
|
|
|
|
18769
|
} or do { |
2357
|
0
|
|
|
|
|
0
|
$global_phase_destroy = 1; |
2358
|
|
|
|
|
|
|
}; |
2359
|
|
|
|
|
|
|
|
2360
|
18675
|
|
|
|
|
98114
|
return; |
2361
|
|
|
|
|
|
|
} |
2362
|
|
|
|
|
|
|
|
2363
|
204
|
|
|
204
|
0
|
3686
|
sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) } |
2364
|
|
|
|
|
|
|
|
2365
|
|
|
|
|
|
|
sub STORABLE_thaw { |
2366
|
204
|
|
|
204
|
0
|
2634
|
my ($self, $cloning, $ice) = @_; |
2367
|
204
|
|
|
|
|
171
|
%$self = %{ (Storable::thaw($ice))->resolve }; |
|
204
|
|
|
|
|
373
|
|
2368
|
|
|
|
|
|
|
} |
2369
|
|
|
|
|
|
|
|
2370
|
|
|
|
|
|
|
=head2 throw_exception |
2371
|
|
|
|
|
|
|
|
2372
|
|
|
|
|
|
|
See L. |
2373
|
|
|
|
|
|
|
|
2374
|
|
|
|
|
|
|
=cut |
2375
|
|
|
|
|
|
|
|
2376
|
|
|
|
|
|
|
sub throw_exception { |
2377
|
2038
|
|
|
2038
|
1
|
3505
|
my $self = shift; |
2378
|
|
|
|
|
|
|
|
2379
|
|
|
|
|
|
|
$self->{schema} |
2380
|
2038
|
100
|
|
|
|
10613
|
? $self->{schema}->throw_exception(@_) |
2381
|
|
|
|
|
|
|
: DBIx::Class::Exception->throw(@_) |
2382
|
|
|
|
|
|
|
; |
2383
|
|
|
|
|
|
|
} |
2384
|
|
|
|
|
|
|
|
2385
|
|
|
|
|
|
|
=head2 column_info_from_storage |
2386
|
|
|
|
|
|
|
|
2387
|
|
|
|
|
|
|
=over |
2388
|
|
|
|
|
|
|
|
2389
|
|
|
|
|
|
|
=item Arguments: 1/0 (default: 0) |
2390
|
|
|
|
|
|
|
|
2391
|
|
|
|
|
|
|
=item Return Value: 1/0 |
2392
|
|
|
|
|
|
|
|
2393
|
|
|
|
|
|
|
=back |
2394
|
|
|
|
|
|
|
|
2395
|
|
|
|
|
|
|
__PACKAGE__->column_info_from_storage(1); |
2396
|
|
|
|
|
|
|
|
2397
|
|
|
|
|
|
|
Enables the on-demand automatic loading of the above column |
2398
|
|
|
|
|
|
|
metadata from storage as necessary. This is *deprecated*, and |
2399
|
|
|
|
|
|
|
should not be used. It will be removed before 1.0. |
2400
|
|
|
|
|
|
|
|
2401
|
|
|
|
|
|
|
=head1 FURTHER QUESTIONS? |
2402
|
|
|
|
|
|
|
|
2403
|
|
|
|
|
|
|
Check the list of L. |
2404
|
|
|
|
|
|
|
|
2405
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
2406
|
|
|
|
|
|
|
|
2407
|
|
|
|
|
|
|
This module is free software L |
2408
|
|
|
|
|
|
|
by the L. You can |
2409
|
|
|
|
|
|
|
redistribute it and/or modify it under the same terms as the |
2410
|
|
|
|
|
|
|
L. |
2411
|
|
|
|
|
|
|
|
2412
|
|
|
|
|
|
|
=cut |
2413
|
|
|
|
|
|
|
|
2414
|
|
|
|
|
|
|
1; |