Properly detect and test mysql v3 default JOIN behavior
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / UniqueIdentifier.pm
CommitLineData
548d1627 1package DBIx::Class::Storage::DBI::UniqueIdentifier;
2
3use strict;
4use warnings;
5use base 'DBIx::Class::Storage::DBI';
6use mro 'c3';
7
40d8d018 8__PACKAGE__->mk_group_accessors(inherited => 'new_guid');
9
548d1627 10=head1 NAME
11
12DBIx::Class::Storage::DBI::UniqueIdentifier - Storage component for RDBMSes
40d8d018 13supporting GUID types
548d1627 14
15=head1 DESCRIPTION
16
40d8d018 17This is a storage component for databases that support GUID types such as
18C<uniqueidentifier>, C<uniqueidentifierstr> or C<guid>.
19
20GUIDs are generated automatically for PK columns with a supported
21L<data_type|DBIx::Class::ResultSource/data_type>, as well as non-PK with
22L<auto_nextval|DBIx::Class::ResultSource/auto_nextval> set.
23
24=head1 METHODS
25
26=head2 new_guid
27
28The composing class must set C<new_guid> to the method used to generate a new
29GUID. It can also set it to C<undef>, in which case the user is required to set
30it, or a runtime error will be thrown. It can be:
31
32=over 4
33
34=item string
35
36In which case it is used as the name of database function to create a new GUID,
37
38=item coderef
548d1627 39
40d8d018 40In which case the coderef should return a string GUID, using L<Data::GUID>, or
2edf3352 41whatever GUID generation method you prefer. It is passed the C<$self>
42L<DBIx::Class::Storage> reference as a parameter.
548d1627 43
40d8d018 44=back
548d1627 45
40d8d018 46For example:
47
48 $schema->storage->new_guid(sub { Data::GUID->new->as_string });
548d1627 49
50=cut
51
40d8d018 52my $GUID_TYPE = qr/^(?:uniqueidentifier(?:str)?|guid)\z/i;
53
54sub _is_guid_type {
55 my ($self, $data_type) = @_;
56
57 return $data_type =~ $GUID_TYPE;
58}
548d1627 59
8b9473f5 60sub _prefetch_autovalues {
548d1627 61 my $self = shift;
a3483a58 62 my ($source, $col_info, $to_insert) = @_;
548d1627 63
64 my %guid_cols;
65 my @pk_cols = $source->primary_columns;
8b9473f5 66 my %pk_col_idx;
67 @pk_col_idx{@pk_cols} = ();
548d1627 68
69 my @pk_guids = grep {
52416317 70 $col_info->{$_}{data_type}
548d1627 71 &&
40d8d018 72 $col_info->{$_}{data_type} =~ $GUID_TYPE
548d1627 73 } @pk_cols;
74
75 my @auto_guids = grep {
52416317 76 $col_info->{$_}{data_type}
548d1627 77 &&
40d8d018 78 $col_info->{$_}{data_type} =~ $GUID_TYPE
548d1627 79 &&
52416317 80 $col_info->{$_}{auto_nextval}
8b9473f5 81 } grep { not exists $pk_col_idx{$_} } $source->columns;
548d1627 82
83 my @get_guids_for =
84 grep { not exists $to_insert->{$_} } (@pk_guids, @auto_guids);
85
548d1627 86 for my $guid_col (@get_guids_for) {
40d8d018 87 my $new_guid;
88
89 my $guid_method = $self->new_guid;
90
91 if (not defined $guid_method) {
92 $self->throw_exception(
e705f529 93 'You must set new_guid() on your storage. See perldoc '
40d8d018 94 .'DBIx::Class::Storage::DBI::UniqueIdentifier'
95 );
96 }
97
98 if (ref $guid_method eq 'CODE') {
2edf3352 99 $to_insert->{$guid_col} = $guid_method->($self);
40d8d018 100 }
101 else {
8b9473f5 102 ($to_insert->{$guid_col}) = $self->_get_dbh->selectrow_array("SELECT $guid_method");
40d8d018 103 }
548d1627 104 }
105
8b9473f5 106 return $self->next::method(@_);
548d1627 107}
108
109=head1 AUTHOR
110
111See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
112
113=head1 LICENSE
114
115You may distribute this code under the same terms as Perl itself.
116
117=cut
118
1191;