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