1 package DBIx::Class::Storage::DBI::UniqueIdentifier;
5 use base 'DBIx::Class::Storage::DBI';
10 DBIx::Class::Storage::DBI::UniqueIdentifier - Storage component for RDBMSes
11 supporting the 'uniqueidentifier' type
15 This is a storage component for databases that support the C<uniqueidentifier>
16 type and the C<NEWID()> function for generating UUIDs.
18 UUIDs are generated automatically for PK columns with the C<uniqueidentifier>
19 L<data_type|DBIx::Class::ResultSource/data_type>, as well as non-PK with this
20 L<data_type|DBIx::Class::ResultSource/data_type> and
21 L<auto_nextval|DBIx::Class::ResultSource/auto_nextval>.
23 Currently used by L<DBIx::Class::Storage::DBI::MSSQL> and
24 L<DBIx::Class::Storage::DBI::SQLAnywhere>.
26 The composing class can define a C<_new_uuid> method to override the function
27 used to generate a new UUID.
31 sub _new_uuid { 'NEWID()' }
35 my ($source, $to_insert) = @_;
37 my $col_info = $source->columns_info;
40 my @pk_cols = $source->primary_columns;
42 @pk_cols{@pk_cols} = ();
45 $col_info->{$_}{data_type}
47 $col_info->{$_}{data_type} =~ /^uniqueidentifier/i
50 my @auto_guids = grep {
51 $col_info->{$_}{data_type}
53 $col_info->{$_}{data_type} =~ /^uniqueidentifier/i
55 $col_info->{$_}{auto_nextval}
56 } grep { not exists $pk_cols{$_} } $source->columns;
59 grep { not exists $to_insert->{$_} } (@pk_guids, @auto_guids);
61 my $updated_cols = {};
63 for my $guid_col (@get_guids_for) {
64 my ($new_guid) = $self->_get_dbh->selectrow_array('SELECT '.$self->_new_uuid);
65 $updated_cols->{$guid_col} = $to_insert->{$guid_col} = $new_guid;
68 $updated_cols = { %$updated_cols, %{ $self->next::method(@_) } };
75 See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
79 You may distribute this code under the same terms as Perl itself.