File Coverage

lib/DBIx/EAV/Schema.pm
Criterion Covered Total %
statement 118 119 99.1
branch 42 50 84.0
condition 7 14 50.0
subroutine 20 20 100.0
pod 6 12 50.0
total 193 215 89.7


line stmt bran cond sub pod time code
1             package DBIx::EAV::Schema;
2              
3 10     10   65 use Moo;
  10         20  
  10         67  
4 10     10   3234 use Carp 'croak';
  10         17  
  10         461  
5 10     10   55 use Scalar::Util 'blessed';
  10         16  
  10         402  
6 10     10   3308 use DBIx::EAV::Table;
  10         25  
  10         282  
7 10     10   5229 use SQL::Translator;
  10         2252211  
  10         446  
8             use constant {
9             SQL_DEBUG => $ENV{DBIX_EAV_TRACE}
10 10     10   81 };
  10         21  
  10         17850  
11              
12             our $SCHEMA_VERSION = 1;
13              
14              
15             my %driver_to_producer = (
16             mysql => 'MySQL'
17             );
18              
19              
20             has 'dbh', is => 'ro', required => 1;
21              
22             has 'database_cascade_delete', is => 'ro', default => 1;
23             has 'table_prefix', is => 'ro', default => 'eav_';
24             has 'tenant_id', is => 'ro';
25             has 'enable_multi_tenancy', is => 'ro', default => 0;
26             has 'data_types', is => 'ro', default => sub { [qw/ int decimal varchar text datetime bool /] };
27             has 'static_attributes', is => 'ro', default => sub { [] };
28             has 'id_type', is => 'ro', default => 'int';
29              
30             has 'translator', is => 'ro', init_arg => undef, lazy => 1, builder => 1;
31             has '_tables', is => 'ro', init_arg => undef, default => sub { {} };
32              
33              
34             sub BUILD {
35 11     11 0 120 my $self = shift;
36              
37             # enable sqlite fk for cascade delete to work
38 11 50       50 $self->dbh_do("PRAGMA foreign_keys = ON;")
39             if $self->db_driver_name eq 'SQLite';
40             }
41              
42              
43             sub _build_translator {
44 11     11   152 my $self = shift;
45              
46 11         287 my $sqlt = SQL::Translator->new;
47 11         11306 $self->_build_sqlt_schema($sqlt->schema);
48              
49 11         327 $sqlt;
50             }
51              
52             sub _build_sqlt_schema {
53 11     11   29873 my ($self, $schema) = @_;
54 11   66     102 my $enable_multi_tenancy = $self->enable_multi_tenancy || $self->tenant_id;
55             my @schema = (
56              
57             entity_types => {
58             columns => ['id', $enable_multi_tenancy ? 'tenant_id' : (), 'name:varchar:255', 'signature:char:32'],
59             index => [$enable_multi_tenancy ? 'tenant_id' : ()],
60             unique => {
61             name => [$enable_multi_tenancy ? 'tenant_id' : (),'name']
62             }
63             },
64              
65             entities => {
66 11         428 columns => [qw/ id entity_type_id /, @{ $self->static_attributes } ],
67             fk => { entity_type_id => 'entity_types' }
68             },
69              
70             attributes => {
71             columns => [qw/ id entity_type_id name:varchar:255 data_type:varchar:64 /],
72             fk => { entity_type_id => 'entity_types' }
73             },
74              
75             relationships => {
76             columns => [qw/ id left_entity_type_id right_entity_type_id name:varchar:255 incoming_name:varchar:255 is_has_one:bool::0 is_has_many:bool::0 is_many_to_many:bool::0 /],
77             fk => { left_entity_type_id => 'entity_types', right_entity_type_id => 'entity_types' },
78             unique => {
79             name => ['left_entity_type_id','name']
80             }
81             },
82              
83             entity_relationships => {
84             columns => [qw/ relationship_id left_entity_id right_entity_id /],
85             pk => [qw/ relationship_id left_entity_id right_entity_id /],
86             fk => {
87             relationship_id => 'relationships',
88             left_entity_id => { table => 'entities', cascade_delete => $self->database_cascade_delete },
89             right_entity_id => { table => 'entities', cascade_delete => $self->database_cascade_delete },
90             }
91             },
92              
93             type_hierarchy => {
94             columns => [qw/ parent_type_id child_type_id /],
95             pk => [qw/ parent_type_id child_type_id /],
96             fk => {
97             parent_type_id => { table => 'entity_types', cascade_delete => $self->database_cascade_delete },
98             child_type_id => { table => 'entity_types', cascade_delete => $self->database_cascade_delete },
99             }
100             },
101              
102             map {
103 66         422 ("value_$_" => {
104             columns => [qw/ entity_id attribute_id /, 'value:'.$_],
105             fk => {
106             entity_id => { table => 'entities', cascade_delete => $self->database_cascade_delete },
107             attribute_id => 'attributes'
108             }
109             })
110 11 100       145 } @{ $self->data_types }
  11 100       71  
    100          
111             );
112              
113 11         64 for (my $i = 0; $i < @schema; $i += 2) {
114              
115             # add table
116 132         5878 my $table_name = $schema[$i];
117 132         235 my $table_schema = $schema[$i+1];
118 132 50       814 my $table = $schema->add_table( name => $self->table_prefix . $table_name )
119             or die $schema->error;
120              
121             # add columns
122 132         110342 foreach my $col ( @{ $table_schema->{columns} }) {
  132         430  
123              
124 459 50       404068 my $field_params = ref $col ? $col : do {
125              
126 459         1487 my ($name, $type, $size, $default) = split ':', $col;
127             +{
128 459         1773 name => $name,
129             data_type => $type,
130             size => $size,
131             default_value => $default
132             }
133             };
134              
135             $field_params->{data_type} = $self->id_type
136 459 100       2473 if $field_params->{name} =~ /(?:^id$|_id$)/;
137              
138             $field_params->{is_auto_increment} = 1
139 459 100       970 if $field_params->{name} eq 'id';
140              
141 459   50     1626 $field_params->{is_nullable} //= 0;
142              
143 459 50       1832 $table->add_field(%$field_params)
144             or die $table->error;
145             }
146              
147             # # primary key
148 132 100       192284 my $pk = $table->get_field('id') ? 'id' : $table_schema->{pk};
149 132 100       17392 $table->primary_key($pk) if $pk;
150              
151             # # foreign keys
152 132 100       143349 foreach my $fk_column (keys %{ $table_schema->{fk} || {} }) {
  132         678  
153              
154 231         90912 my $params = $table_schema->{fk}->{$fk_column};
155 231 100       661 $params = { table => $params } unless ref $params;
156              
157             $table->add_constraint(
158             name => join('_', 'fk', $table_name, $fk_column, $params->{table}),
159             type => 'foreign_key',
160             fields => $fk_column,
161             reference_fields => 'id',
162             reference_table => $self->table_prefix . $params->{table},
163 231 100       1744 on_delete => $params->{cascade_delete} ? 'CASCADE' : 'NO ACTION'
164             );
165             }
166              
167             # # unique constraints
168 132 100       106551 foreach my $name (keys %{ $table_schema->{unique} || {} }) {
  132         786  
169              
170             $table->add_index(
171             name => join('_', 'unique', $table_name, $name),
172             type => 'unique',
173 22         170 fields => $table_schema->{unique}{$name},
174             );
175             }
176              
177             # # index
178 132 100       11977 foreach my $colname (@{ $table_schema->{index} || [] }) {
  132         794  
179              
180 10         60 $table->add_index(
181             name => join('_', 'idx', $table_name, $colname),
182             type => 'normal',
183             fields => $colname,
184             );
185             }
186             }
187              
188 11         319 return 1;
189             }
190              
191              
192 26     26 0 198 sub version { $SCHEMA_VERSION }
193              
194             sub get_ddl {
195 13     13 1 102570 my ($self, $producer) = @_;
196              
197 13 100       39 unless ($producer) {
198              
199 12         204 my $driver = $self->dbh->{Driver}{Name};
200 12   33     105 $producer = $driver_to_producer{$driver} || $driver;
201             }
202              
203 13         321 $self->translator->producer($producer);
204 13         29148 $self->translator->translate;
205             }
206              
207             sub version_table {
208 25     25 0 1116816 my $self = shift;
209              
210 25         789 DBIx::EAV::Table->new(
211             dbh => $self->dbh,
212             name => $self->table_prefix . 'schema_versions',
213             columns => [qw/ id version ddl /]
214             );
215             }
216              
217             sub version_table_is_installed {
218 14     14 0 90747 my $self = shift;
219              
220 14         29 my $success = 0;
221              
222 14         30 eval {
223 14         146 $self->dbh_do(sprintf 'SELECT COUNT(*) FROM %s', $self->table_prefix . 'schema_versions');
224 3         10 $success = 1;
225             };
226              
227 14         121 $success;
228             }
229              
230             sub install_version_table {
231 10     10 0 27 my $self = shift;
232              
233 10         306 my $sqlt = SQL::Translator->new;
234 10         9775 my $table = $sqlt->schema->add_table( name => $self->version_table->name );
235              
236 10         6905 $table->add_field(
237             name => 'id',
238             data_type => 'INTEGER',
239             is_auto_increment => 1
240             );
241              
242 10         8975 $table->add_field(
243             name => 'version',
244             data_type => 'INTEGER'
245             );
246              
247 10         10641 $table->add_field(
248             name => 'ddl',
249             data_type => 'TEXT'
250             );
251              
252 10         12272 $table->primary_key('id');
253              
254             # execute ddl
255 10         20695 my $driver = $self->dbh->{Driver}{Name};
256 10   33     315 $sqlt->producer($driver_to_producer{$driver} || $driver);
257              
258             $self->dbh_do($_)
259 10         127517 for grep { /\w/ } split ';', $sqlt->translate;
  40         92323  
260              
261             }
262              
263             sub installed_version {
264 2     2 0 5 my $self = shift;
265 2         8 my $table = $self->version_table;
266 2         5 my $row;
267 2         4 eval {
268 2         15 my ($rv, $sth) = $self->dbh_do(sprintf 'SELECT * FROM %s ORDER BY id DESC', $table->name);
269 2         49 $row = $sth->fetchrow_hashref;
270             };
271 2 50       25 return unless $row;
272 2         14 $row->{version};
273             }
274              
275             sub deploy {
276 12     12 1 43 my $self = shift;
277 12         72 my %options = ( @_, no_comments => 1 );
278              
279             $self->translator->$_($options{$_})
280 12         312 for keys %options;
281              
282             # deploy version table
283 12 100       1278 $self->install_version_table
284             unless $self->version_table_is_installed;
285              
286             # check we already installed this version
287 12         73 my $version_table = $self->version_table;
288 12 100 66     59 return if $version_table->select_one({ version => $self->version }) && !$options{add_drop_table};
289              
290             # deploy ddl
291 11         130 my $ddl = $self->get_ddl;
292 11         1009485 print STDERR $ddl if SQL_DEBUG;
293             $self->dbh_do($_)
294 11         141 for grep { /\w/ } split ';', $ddl;
  209         412  
295              
296             # create version record
297 11         96 $version_table->insert({
298             version => $self->version,
299             ddl => 'DDL'
300             });
301             }
302              
303              
304             sub dbh_do {
305 331     331 1 2910 my ($self, $stmt, $bind) = @_;
306              
307 331         374 if (SQL_DEBUG) {
308             my $i = 0;
309             print STDERR "$stmt";
310             print STDERR $bind ? sprintf(": %s\n", join(' ', map { $i++.'='.$_ } @{ $bind || [] }))
311             : ";\n";
312             }
313              
314 331         2057 my $sth = $self->dbh->prepare($stmt);
315 331 50       46131 my $rv = $sth->execute(ref $bind eq 'ARRAY' ? @$bind : ());
316 320 50       1174 die $sth->errstr unless defined $rv;
317              
318 320         4211 return ($rv, $sth);
319             }
320              
321             sub table {
322 1088     1088 1 42369 my ($self, $name) = @_;
323              
324             return $self->_tables->{$name}
325 1088 100       5538 if exists $self->_tables->{$name};
326              
327 77         1288 my $table_schema = $self->translator->schema->get_table($self->table_prefix . $name);
328              
329 77 50       6816 croak "Table '$name' does not exist."
330             unless $table_schema;
331              
332 77         22136 $self->_tables->{$name} = DBIx::EAV::Table->new(
333             dbh => $self->dbh,
334             tenant_id => $self->tenant_id,
335             name => $table_schema->name,
336             columns => [ $table_schema->field_names ]
337             );
338             }
339              
340             sub has_data_type {
341 114     114 1 26358 my ($self, $name) = @_;
342 114         149 foreach (@{$self->data_types}) {
  114         335  
343 343 100       862 return 1 if $_ eq $name;
344             }
345 0         0 0;
346             }
347              
348             sub db_driver_name {
349 25     25 1 1234 shift->dbh->{Driver}{Name};
350             }
351              
352              
353             1;
354              
355              
356             __END__