File Coverage

blib/lib/DBIx/Class/Storage/DBI/UniqueIdentifier.pm
Criterion Covered Total %
statement 12 36 33.3
branch 0 8 0.0
condition 0 3 0.0
subroutine 4 6 66.6
pod n/a
total 16 53 30.1


line stmt bran cond sub pod time code
1             package DBIx::Class::Storage::DBI::UniqueIdentifier;
2              
3 6     6   30 use strict;
  6         8  
  6         159  
4 6     6   24 use warnings;
  6         10  
  6         133  
5 6     6   25 use base 'DBIx::Class::Storage::DBI';
  6         7  
  6         1525  
6 6     6   39 use mro 'c3';
  6         7  
  6         105  
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, C or C.
19              
20             GUIDs are generated automatically for PK columns with a supported
21             L, as well as non-PK with
22             L set.
23              
24             =head1 METHODS
25              
26             =head2 new_guid
27              
28             The composing class must set C to the method used to generate a new
29             GUID. It can also set it to C, 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, or
41             whatever GUID generation method you prefer. It is passed the C<$self>
42             L 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 0     0     my ($self, $data_type) = @_;
56              
57 0           return $data_type =~ $GUID_TYPE;
58             }
59              
60             sub _prefetch_autovalues {
61 0     0     my $self = shift;
62 0           my ($source, $col_info, $to_insert) = @_;
63              
64 0           my %guid_cols;
65 0           my @pk_cols = $source->primary_columns;
66 0           my %pk_col_idx;
67 0           @pk_col_idx{@pk_cols} = ();
68              
69             my @pk_guids = grep {
70 0           $col_info->{$_}{data_type}
71             &&
72 0 0         $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 0 0 0       } grep { not exists $pk_col_idx{$_} } $source->columns;
  0            
  0            
82              
83             my @get_guids_for =
84 0           grep { not exists $to_insert->{$_} } (@pk_guids, @auto_guids);
  0            
85              
86 0           for my $guid_col (@get_guids_for) {
87 0           my $new_guid;
88              
89 0           my $guid_method = $self->new_guid;
90              
91 0 0         if (not defined $guid_method) {
92 0           $self->throw_exception(
93             'You must set new_guid() on your storage. See perldoc '
94             .'DBIx::Class::Storage::DBI::UniqueIdentifier'
95             );
96             }
97              
98 0 0         if (ref $guid_method eq 'CODE') {
99 0           $to_insert->{$guid_col} = $guid_method->($self);
100             }
101             else {
102 0           ($to_insert->{$guid_col}) = $self->_get_dbh->selectrow_array("SELECT $guid_method");
103             }
104             }
105              
106 0           return $self->next::method(@_);
107             }
108              
109             =head1 FURTHER QUESTIONS?
110              
111             Check the list of L.
112              
113             =head1 COPYRIGHT AND LICENSE
114              
115             This module is free software L
116             by the L. You can
117             redistribute it and/or modify it under the same terms as the
118             L.
119              
120             =cut
121              
122             1;