File Coverage

blib/lib/MySQL/Workbench/DBIC.pm
Criterion Covered Total %
statement 384 396 96.9
branch 161 176 91.4
condition 28 31 90.3
subroutine 27 27 100.0
pod 1 1 100.0
total 601 631 95.2


line stmt bran cond sub pod time code
1             package MySQL::Workbench::DBIC;
2              
3 38     38   4224194 use warnings;
  38         455  
  38         1370  
4 38     38   236 use strict;
  38         77  
  38         765  
5              
6 38     38   187 use Carp;
  38         75  
  38         2071  
7 38     38   25560 use Data::Dumper;
  38         270576  
  38         2663  
8 38     38   337 use File::Path qw(make_path);
  38         80  
  38         2626  
9 38     38   284 use File::Spec;
  38         79  
  38         790  
10 38     38   25014 use JSON;
  38         465937  
  38         233  
11 38     38   6234 use List::Util qw(first);
  38         98  
  38         2536  
12 38     38   20364 use Moo;
  38         434110  
  38         208  
13 38     38   76937 use MySQL::Workbench::Parser;
  38         20015285  
  38         200344  
14              
15             # ABSTRACT: create DBIC scheme for MySQL workbench .mwb files
16              
17             our $VERSION = '1.20';
18              
19             has output_path => ( is => 'ro', required => 1, default => sub { '.' } );
20             has file => ( is => 'ro', required => 1 );
21             has uppercase => ( is => 'ro' );
22             has inherit_from_core => ( is => 'ro' );
23             has namespace => ( is => 'ro', isa => sub{ _check_namespace( @_, 1) }, required => 1, default => sub { '' } );
24             has result_namespace => ( is => 'ro', isa => \&_check_namespace, required => 1, default => sub { '' } );
25             has resultset_namespace => ( is => 'ro', isa => \&_check_namespace, required => 1, default => sub { '' } );
26             has load_result_namespace => ( is => 'ro', isa => \&_check_namespace_array, default => sub { '' } );
27             has load_resultset_namespace => ( is => 'ro', isa => \&_check_namespace_array, default => sub { '' } );
28             has schema_name => ( is => 'rwp', isa => sub { defined $_[0] && $_[0] =~ m{ \A [A-Za-z0-9_]+ \z }xms } );
29             has parser => ( is => 'rwp' );
30             has version_add => ( is => 'ro', required => 1, default => sub { 0.01 } );
31             has column_details => ( is => 'ro', required => 1, default => sub { 0 } );
32             has use_fake_dbic => ( is => 'ro', required => 1, default => sub { 0 } );
33             has skip_indexes => ( is => 'ro', required => 1, default => sub { 0 } );
34             has belongs_to_prefix => ( is => 'ro', required => 1, default => sub { '' } );
35             has has_many_prefix => ( is => 'ro', required => 1, default => sub { '' } );
36             has has_one_prefix => ( is => 'ro', required => 1, default => sub { '' } );
37             has many_to_many_prefix => ( is => 'ro', required => 1, default => sub { '' } );
38             has utf8 => ( is => 'ro', required => 1, default => sub { 0 } );
39             has schema_base_class => ( is => 'ro', required => 1, default => sub { 'DBIx::Class::Schema' } );
40             has remove_table_prefix => ( is => 'ro' );
41              
42             has version => ( is => 'rwp' );
43             has classes => ( is => 'rwp', isa => sub { ref $_[0] && ref $_[0] eq 'ARRAY' }, default => sub { [] } );
44              
45             sub _check_namespace {
46 223     223   5372 my ($namespace, $allow_empty_string) = @_;
47              
48 223 100       606 return if !defined $namespace;
49 221 100       556 return if ref $namespace;
50              
51 218 100 100     1029 return 1 if $namespace eq '' && $allow_empty_string;
52              
53 205         3344 return $namespace =~ m{ \A [A-Z]\w*(::\w+)* \z }xms;
54             }
55              
56             sub _check_namespace_array {
57 89     89   5178 my ($namespaces) = @_;
58              
59 89 100       349 if ( !ref $namespaces ) {
60 76         228 return _check_namespace( $namespaces );
61             }
62              
63 13 100       42 return if 'ARRAY' ne ref $namespaces;
64              
65 11         17 for my $namespace ( @{ $namespaces } ) {
  11         25  
66 20 100       44 return if !_check_namespace( $namespace );
67             }
68              
69 7         78 return 1;
70             }
71              
72             around new => sub {
73             my ($next, $class, %args) = @_;
74              
75             if ( $args{use_fake_dbic} || !eval{ require DBIx::Class } ) {
76             require MySQL::Workbench::DBIC::FakeDBIC;
77             }
78              
79             my $self = $class->$next( %args );
80              
81             my $parser = MySQL::Workbench::Parser->new( file => $self->file );
82             $self->_set_parser( $parser );
83              
84             return $self;
85             };
86              
87             sub create_schema{
88 31     31 1 24784 my $self = shift;
89              
90 31         161 my $parser = $self->parser;
91 31         73 my @tables = @{ $parser->tables };
  31         894  
92              
93 31         2289435 my @classes;
94             my %relations;
95 31         113 for my $table ( @tables ){
96 87         249 my $name = $table->name;
97              
98 87         182 push @classes, $name;
99              
100 87         220 my $rels = $table->foreign_keys;
101 87         275 for my $to_table ( keys %$rels ){
102 51         279 $relations{$to_table}->{to}->{$name} = $rels->{$to_table};
103 51         195 $relations{$name}->{from}->{$to_table} = $rels->{$to_table};
104             }
105             }
106              
107 31         743 $self->_set_classes( \@classes );
108              
109 31         386 my @scheme = $self->_main_template;
110              
111 31         66 my @files;
112 31         88 for my $table ( @tables ){
113 87         268 my $custom_code = $self->_custom_code_table( $table );
114 87         628 push @files, $self->_class_template( $table, $relations{$table->name}, $custom_code );
115             }
116              
117 31 50       85 for my $view ( @{ $parser->views || [] } ) {
  31         760  
118 2         18 my $custom_code = $self->_custom_code_table( $view );
119 2         12 push @files, $self->_view_template( $view, $custom_code );
120             }
121              
122 31         446 push @files, @scheme;
123              
124 31         136 $self->_write_files( @files );
125             }
126              
127             sub _custom_code_table {
128 89     89   247 my ($self, $table) = @_;
129              
130 89         263 my $name = $table->name;
131 89 100       287 if ( $self->uppercase ) {
132 27         140 $name = join '', map{ ucfirst } split /[_-]/, $table->name;
  37         140  
133             }
134              
135 89         166 my @base_path;
136 89 100       330 push @base_path, $self->output_path if $self->output_path;
137              
138 89         1713 my $path = File::Spec->catfile(
139             @base_path,
140             (split /::/, $self->namespace),
141             $self->schema_name,
142             $self->result_namespace,
143             'Result',
144             $name . '.pm'
145             );
146              
147 89 100       1863 return '' if !-f $path;
148              
149 26         130 return $self->_custom_code( $path );
150             }
151              
152             sub _custom_code {
153 35     35   96 my ($self, $path) = @_;
154              
155 35         55 my $content = do { local (@ARGV, $/) = $path; <> };
  35         213  
  35         2578  
156              
157 35         469 my ($code) = $content =~ m{
158             ^[#] \s+ --- \s*
159             ^[#] \s+ Put \s+ your \s+ own \s+ code \s+ below \s+ this \s+ comment \s*
160             ^[#] \s+ --- \s*
161             (.*?) \s+
162             ^[#] \s+ --- \s*
163             }xms;
164              
165 35         132 return $code;
166             }
167              
168             sub _write_files{
169 33     33   1527 my ($self, %files) = @_;
170              
171 33         189 for my $package ( keys %files ){
172 122         380 my @path;
173 122 100       686 push @path, $self->output_path if $self->output_path;
174 122         819 push @path, split /::/, $package;
175 122         326 my $file = pop @path;
176 122         1390 my $dir = File::Spec->catdir( @path );
177              
178 122 100       2492 if( !-e $dir ){
179 32 100       16006 make_path( $dir ) or croak "Cannot create directory $dir";
180             }
181              
182 121 100       31002 if( open my $fh, '>', $dir . '/' . $file . '.pm' ){
183 120 100       741 if ( $self->utf8 ) {
184 4     1   90 binmode $fh, ':encoding(utf-8)';
  1         8  
  1         2  
  1         9  
185             }
186              
187 120         3045 print $fh $files{$package};
188 120         6317 close $fh;
189             }
190             else{
191 1         102 croak "Couldn't create $file.pm: $!";
192             }
193             }
194             }
195              
196             sub _has_many_template{
197 54     54   1022 my ($self, $to, $rels) = @_;
198              
199 54         103 my $name = $to;
200 54         136 my ($to_class, $package) = $self->_create_class_and_package_name( $to );
201              
202 54 50       220 if ( defined $self->remove_table_prefix ) {
203 0         0 my $prefix = $self->remove_table_prefix;
204 0         0 $name =~ s{\A\Q$prefix\E}{};
205             }
206              
207 54         97 my %has_many_rels;
208 54         106 my $counter = 1;
209              
210 54         101 my $string = '';
211 54 100       103 for my $field ( @{ $rels || [] } ) {
  54         204  
212 54         118 my $me_field = $field->{foreign};
213 54         113 my $foreign_field = $field->{me};
214              
215 54         193 my $temp_field = $self->has_many_prefix . $name;
216 54         188 while ( $has_many_rels{$temp_field} ) {
217 1         5 $temp_field = $self->has_many_prefix . $name . $counter++;
218             }
219              
220 54         170 $has_many_rels{$temp_field}++;
221              
222 54         352 $string .= qq~
223             __PACKAGE__->has_many($temp_field => '$package',
224             { 'foreign.$foreign_field' => 'self.$me_field' });
225             ~;
226             }
227              
228 54         224 return $string;
229             }
230              
231             sub _belongs_to_template{
232 54     54   1035 my ($self, $from, $rels) = @_;
233              
234 54         104 my $name = $from;
235 54         159 my ($from_class, $package) = $self->_create_class_and_package_name( $from );
236              
237 54 50       216 if ( defined $self->remove_table_prefix ) {
238 0         0 my $prefix = $self->remove_table_prefix;
239 0         0 $name =~ s{\A\Q$prefix\E}{};
240             }
241              
242 54         114 my %belongs_to_rels;
243 54         93 my $counter = 1;
244              
245 54         92 my $string = '';
246 54 100       98 for my $field ( @{ $rels || [] } ) {
  54         219  
247 54         140 my $me_field = $field->{me};
248 54         108 my $foreign_field = $field->{foreign};
249              
250 54         183 my $temp_field = $self->belongs_to_prefix . $name;
251 54         246 while ( $belongs_to_rels{$temp_field} ) {
252 1         5 $temp_field = $self->belongs_to_prefix . $name . $counter++;
253             }
254              
255 54         162 $belongs_to_rels{$temp_field}++;
256              
257 54         354 $string .= qq~
258             __PACKAGE__->belongs_to($temp_field => '$package',
259             { 'foreign.$foreign_field' => 'self.$me_field' });
260             ~;
261             }
262              
263 54         202 return $string;
264             }
265              
266             sub _create_class_and_package_name {
267 204     204   419 my ($self, $name) = @_;
268              
269 204         334 my $class = $name;
270              
271 204 100       611 if ( defined $self->remove_table_prefix ) {
272 1         3 my $prefix = $self->remove_table_prefix;
273 1         19 $class =~ s{\A\Q$prefix\E}{};
274             }
275              
276 204 100       513 if ( $self->uppercase ) {
277 63         249 $class = join '', map{ ucfirst $_ }split /[_-]/, $name;
  92         284  
278             }
279              
280 204 100       1320 my $package = join '::', (
    100          
281             ( $self->namespace ? $self->namespace : () ),
282             $self->schema_name,
283             ( length $self->result_namespace ? $self->result_namespace : () ),
284             'Result',
285             $class,
286             );
287              
288 204         626 return ($class, $package);
289             }
290              
291             sub _class_template{
292 91     91   5607 my ($self, $table, $relations, $custom_code) = @_;
293              
294 91         219 my $name = $table->name;
295 91         273 my ($class, $package) = $self->_create_class_and_package_name( $name );
296              
297 91         225 my ($has_many, $belongs_to) = ('','');
298              
299 91   100     478 my $comment = $table->comment // '{}';
300 91         293 utf8::upgrade( $comment );
301              
302 91         137 my $data;
303 91         153 my $table_comment_perl = '';
304 91         167 eval {
305 91         1229 $data = JSON->new->decode( $comment );
306             };
307              
308 91 100 100     915 if ( !ref $data || 'HASH' ne ref $data ) {
    100          
309 7         19 $data = {};
310 7 100       25 $table_comment_perl = $comment if $comment;
311             }
312             elsif ( $data->{comment} ) {
313 3         11 $table_comment_perl = $data->{comment};
314             }
315              
316 91 100       241 if ( $table_comment_perl ) {
317 7         37 $table_comment_perl = sprintf "\n\n=head1 DESCRIPTION\n\n%s\n\n=cut", $table_comment_perl;
318             }
319              
320 91 100       373 my @core_components = $self->inherit_from_core ? () : qw(PK::Auto Core);
321 91 100       174 my $components = join( ' ', @core_components, @{ $data->{components} || [] } );
  91         459  
322 91 100       334 my $load_components = $components ? "__PACKAGE__->load_components( qw/$components/ );" : '';
323              
324 91         173 my %foreign_keys;
325              
326 91         149 for my $to_table ( sort keys %{ $relations->{to} } ){
  91         460  
327 51         222 $has_many .= $self->_has_many_template( $to_table, $relations->{to}->{$to_table} );
328             }
329              
330 91         188 for my $from_table ( sort keys %{ $relations->{from} } ){
  91         412  
331 51         222 $belongs_to .= $self->_belongs_to_template( $from_table, $relations->{from}->{$from_table} );
332              
333 51         110 my @foreign_key_names = map{ $_->{me} }@{ $relations->{from}->{$from_table} };
  51         189  
  51         152  
334 51         246 @foreign_keys{ @foreign_key_names } = (1) x @foreign_key_names;
335             }
336              
337 91         214 my @columns = map{ $_->name }@{ $table->columns };
  184         1241  
  91         2375  
338 91         212 my $column_string = '';
339              
340 91 100       346 if ( !$self->column_details ) {
341 54         115 $column_string = "qw/\n" . join "\n", map{ " " . $_ }@columns, " /";
  161         422  
342             }
343             else {
344 37         68 my @columns = @{ $table->columns };
  37         595  
345              
346 37         296 for my $column ( @columns ) {
347 77         269 $column_string .= $self->_column_details( $table, $column, \%foreign_keys, $data );
348             }
349             }
350              
351 91         177 my @indexes = @{ $table->indexes };
  91         1788  
352 91         938 my $indexes_hook = $self->_indexes_template( @indexes );
353              
354 91         270 my $primary_key = join " ", @{ $table->primary_key };
  91         382  
355 91         313 my $version = $self->version;
356 91 100       314 my $inherit_from = $self->inherit_from_core ? '::Core' : '';
357 91 100       340 my $use_utf8 = $self->utf8 ? "\nuse utf8;" : '';
358              
359 91         1584 my $template = qq~package $package;
360              
361             # ABSTRACT: Result class for $name$table_comment_perl
362              
363             use strict;
364             use warnings;$use_utf8
365             use base qw(DBIx::Class$inherit_from);
366              
367             our \$VERSION = $version;
368              
369             $load_components
370             __PACKAGE__->table( '$name' );
371             __PACKAGE__->add_columns(
372             $column_string
373             );
374             __PACKAGE__->set_primary_key( qw/ $primary_key / );
375              
376             $has_many
377             $belongs_to
378              
379             $indexes_hook
380              
381             # ---
382             # Put your own code below this comment
383             # ---
384             $custom_code
385             # ---
386              
387             1;~;
388              
389 91         739 return $package, $template;
390             }
391              
392             sub _view_template{
393 2     2   6 my ($self, $view, $custom_code) = @_;
394              
395 2         8 my $name = $view->name;
396 2         7 my ($class, $package) = $self->_create_class_and_package_name( $name );
397              
398 2   50     14 my $comment = $view->comment // '{}';
399 2         8 utf8::upgrade( $comment );
400              
401 2         2 my $data;
402 2         6 my $view_comment_perl = '';
403 2         3 eval {
404 2         15 $data = JSON->new->decode( $comment );
405             };
406              
407 2 50 33     21 if ( !ref $data || 'HASH' ne ref $data ) {
    50          
408 0         0 $data = {};
409 0 0       0 $view_comment_perl = $comment if $comment;
410             }
411             elsif ( $data->{comment} ) {
412 0         0 $view_comment_perl = $data->{comment};
413             }
414              
415 2 50       6 if ( $view_comment_perl ) {
416 0         0 $view_comment_perl = sprintf "\n\n=head1 DESCRIPTION\n\n%s\n\n=cut", $view_comment_perl;
417             }
418              
419 2 50       9 my @core_components = $self->inherit_from_core ? () : qw(PK::Auto Core);
420 2 50       5 my $components = join( ' ', @core_components, @{ $data->{components} || [] } );
  2         12  
421 2 50       10 my $load_components = $components ? "__PACKAGE__->load_components( qw/$components/ );" : '';
422              
423 2         6 my @columns = map{ $_->name }@{ $view->columns };
  5         33  
  2         48  
424 2         6 my $column_string = '';
425              
426 2 50       9 if ( !$self->column_details ) {
427 2         5 $column_string = "qw/\n" . join "\n", map{ " " . $_ }@columns, " /";
  7         19  
428             }
429             else {
430 0         0 my @columns = @{ $view->columns };
  0         0  
431              
432 0         0 for my $column ( @columns ) {
433 0         0 $column_string .= $self->_column_details( $view, $column, {}, $data );
434             }
435             }
436              
437 2         5 my $version = $self->version;
438 2 50       8 my $inherit_from = $self->inherit_from_core ? '::Core' : '';
439 2 50       7 my $use_utf8 = $self->utf8 ? "\nuse utf8;" : '';
440 2         8 my $definition = $view->definition;
441             my $classes = join ', ', map {
442 3         26 my ($class, $package) = $self->_create_class_and_package_name( $_ );
443 3         13 qq~"$package"~
444 2 50       4 } @{ $view->tables || [] };
  2         37  
445              
446 2         36 my $template = qq~package $package;
447              
448             # ABSTRACT: Result class for $name$view_comment_perl
449              
450             use strict;
451             use warnings;$use_utf8
452             use base qw(DBIx::Class$inherit_from);
453              
454             our \$VERSION = $version;
455              
456             $load_components
457             __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
458             __PACKAGE__->table( '$name' );
459              
460             __PACKAGE__->result_source_instance->view_definition(
461             "$definition"
462             );
463              
464             __PACKAGE__->add_columns(
465             $column_string
466             );
467              
468             # ---
469             # Put your own code below this comment
470             # ---
471             $custom_code
472             # ---
473              
474             1;~;
475              
476 2         13 return $package, $template;
477             }
478              
479             sub _column_details {
480 88     88   9345 my ($self, $table, $column, $foreign_keys, $data) = @_;
481              
482 88   100     364 my $default_value = $column->default_value // '';
483 88         174 $default_value =~ s/'/\\'/g;
484              
485 88         299 my $size = $column->length;
486              
487 88 100 100     578 if ( $column->datatype =~ /char/i && $column->length <= 0 ) {
488 5         11 $size = 255;
489             }
490              
491 88         151 my @options;
492              
493 88         192 my $name = $column->name;
494 88         219 my $col_comment = $column->comment;
495              
496 88         324 push @options, "data_type => '" . $column->datatype . "',";
497 88 100       291 push @options, "is_auto_increment => 1," if $column->autoincrement;
498 88 100       602 push @options, "is_nullable => 1," if !$column->not_null;
499 88 100       293 push @options, "size => " . $size . "," if $size > 0;
500 88 100       292 push @options, "default_value => '" . $default_value . "'," if length $default_value;
501              
502 88 100   381   499 if ( first { $column->datatype eq $_ }qw/SMALLINT INT INTEGER BIGINT MEDIUMINT NUMERIC DECIMAL/ ) {
  381         763  
503 47         107 push @options, "is_numeric => 1,";
504             }
505              
506 88 100       466 if ( $table->isa('MySQL::Workbench::Parser::Table') ) {
507 77 100   87   227 push @options, "retrieve_on_insert => 1," if first{ $name eq $_ }@{ $table->primary_key };
  87         251  
  77         243  
508 77 100       293 push @options, "is_foreign_key => 1," if $foreign_keys->{$name};
509             }
510              
511 88         134 my %flags = %{ $column->flags };
  88         321  
512 88 100       236 if ( %flags ) {
513 2         9 my $extras = join ', ', map { "$_ => 1" }sort keys %flags;
  3         22  
514 2         12 push @options, sprintf "extra => {%s},", $extras;
515             }
516              
517 88         148 my $column_comment_perl_raw = '';
518              
519 88 100 100     526 if ( ( $data && $data->{column_info}->{$name} ) || $col_comment ) {
      100        
520 18         53 local $Data::Dumper::Sortkeys = 1;
521 18         37 local $Data::Dumper::Indent = 1;
522 18         43 local $Data::Dumper::Pad = ' ';
523              
524 18         63 utf8::upgrade( $col_comment );
525              
526 18         24 my $comment_data;
527             eval {
528 18         281 $comment_data = JSON->new->decode( $col_comment );
529 7         49 1;
530 18 100       36 } or do {
531 11 100       47 if ( $col_comment =~ /\{/ ) {
532 1         57 print STDERR $col_comment, ": ", $@;
533             }
534             };
535              
536 18 100 100     116 if ( !$comment_data || 'HASH' ne ref $comment_data ) {
537 12         28 $column_comment_perl_raw = $col_comment;
538 12         46 $comment_data = {};
539             }
540             else {
541 6   100     53 $column_comment_perl_raw = delete $comment_data->{comment} // '';
542             }
543              
544             my %hash = (
545 18 100       117 %{ $data->{column_info}->{$name} || {} },
546 18         37 %{ $comment_data },
  18         60  
547             );
548              
549 18 100       102 if ( %hash ) {
550 5         41 my $dump = Dumper( \%hash );
551 5         604 $dump =~ s{\$VAR1 \s+ = \s* \{ \s*? $}{}xms;
552 5         33 $dump =~ s{\A\s+\n\s{8}}{}xms;
553 5         37 $dump =~ s{\n[ ]+\};\s*\z}{}xms;
554              
555 5         30 push @options, $dump;
556             }
557             }
558              
559 88         295 my $option_string = join "\n ", @options;
560              
561 88         237 my @column_comment_lines = split /\r?\n/, $column_comment_perl_raw;
562 88         156 my $column_comment_perl = '';
563              
564 88 100       236 if ( @column_comment_lines ) {
565 12         61 my $sep = sprintf "\n%s%s%s# ", ' ' x 4, ' ' x length $name, ' ' x 6;
566 12         39 $column_comment_perl = ' # ' . join ( $sep, @column_comment_lines );
567             }
568              
569 88         434 my $details = sprintf " %s => {%s\n %s\n },\n",
570             $name,
571             $column_comment_perl,
572             $option_string;
573              
574 88         431 return $details;
575             }
576              
577             sub _indexes_template {
578 94     94   6962 my ($self, @indexes) = @_;
579              
580 94 100       303 return '' if !@indexes;
581 90 100       360 return '' if $self->skip_indexes;
582              
583 87         190 my $hooks = '';
584 87         156 my $indexlist = '';
585              
586 87         173 my $unique_indexes = '';
587              
588             INDEX:
589 87         198 for my $index ( @indexes ) {
590 156         438 my $type = $index->type;
591 156 100       368 $type = 'normal' if !$type;
592 156         333 $type = lc $type;
593              
594 156 100       486 next INDEX if $type eq 'primary';
595              
596 72 100       232 if ( $type eq 'unique' ) {
597             $unique_indexes .= sprintf q~__PACKAGE__->add_unique_constraint(
598             %s => [qw/%s/],
599 21         111 );~, $index->name, ( join ' ', @{ $index->columns } );
  21         404  
600 21         289 next INDEX;
601             }
602              
603 51 100       174 $type = 'normal' if $type eq 'index';
604              
605             $hooks .= sprintf ' $table->add_index(
606             type => "%s",
607             name => "%s",
608             fields => [%s],
609             );
610              
611 51         163 ', $type, $index->name, join ', ', map{ "'$_'" }@{ $index->columns };
  51         749  
  51         944  
612              
613 51         298 $indexlist.= sprintf "=item * %s\n\n", $index->name;
614             }
615              
616 87         172 my $sub_string = '';
617 87 100       228 $sub_string .= $unique_indexes if $unique_indexes;
618              
619 87 100       318 return $sub_string if !$hooks;
620              
621 27         166 $sub_string .= qq~
622             =head1 DEPLOYMENT
623              
624             =head2 sqlt_deploy_hook
625              
626             These indexes are added to the table during deployment
627              
628             =over 4
629              
630             $indexlist
631              
632             =back
633              
634             =cut
635              
636             sub sqlt_deploy_hook {
637             my (\$self, \$table) = \@_;
638              
639             $hooks
640             return 1;
641             }
642             ~;
643              
644 27         100 return $sub_string;
645             }
646              
647             sub _main_template{
648 40     40   6011 my ($self) = @_;
649              
650 40         88 my @class_names = @{ $self->classes };
  40         195  
651 40         131 my $classes = join "\n", map{ " " . $_ }@class_names;
  95         325  
652              
653 40         176 my $schema_name = $self->schema_name;
654 40 100       164 $schema_name = '' if !defined $schema_name;
655              
656 40 100       139 if (!$schema_name) {
657 27         113 my @schema_names = qw(DBIC_Schema Database DBIC MySchema MyDatabase DBIxClass_Schema);
658              
659 27         73 for my $schema ( @schema_names ){
660 32 100       79 if( !grep{ $_ eq $schema }@class_names ){
  98         252  
661 26         61 $schema_name = $schema;
662 26         92 last;
663             }
664             }
665             }
666              
667 40 100       314 croak "couldn't determine a package name for the schema" unless $schema_name;
668              
669              
670 39         818 $self->_set_schema_name( $schema_name );
671              
672 39         473 my $namespace = $self->namespace . '::' . $schema_name;
673 39         131 $namespace =~ s/^:://;
674              
675 39         79 my $version;
676 39         87 do {
677 39         150 my $lib_path = $self->output_path;
678 39         242 my @paths = @INC;
679 39         124 unshift @INC, $lib_path;
680              
681 39         2753 eval "require $namespace";
682 39         609 $version = $namespace->VERSION();
683             };
684              
685 39         156 my $custom_code;
686 39 100       288 if ( $version ) {
687 9         50 (my $path = $namespace) =~ s{::}{/}g;
688 9         50 my $schema_file = $self->output_path . '/' . $path . '.pm';
689 9         36 $custom_code = $self->_custom_code( $schema_file );
690             }
691              
692 39   100     369 $custom_code //= '';
693              
694 39         78 my %all_namespaces_to_load;
695 39 100       302 if ( $self->resultset_namespace ) {
696 8         15 push @{ $all_namespaces_to_load{resultset_namespace} }, sprintf "'%s'", $self->resultset_namespace;
  8         47  
697             }
698              
699 39 100       255 if ( $self->load_resultset_namespace ) {
700 3         26 push @{ $all_namespaces_to_load{resultset_namespace} }, map { "'$_'" }
  6         33  
701             ref $self->load_resultset_namespace ?
702 3 100       7 @{ $self->load_resultset_namespace } :
  2         9  
703             $self->load_resultset_namespace;
704             }
705              
706 39 100       232 if ( $self->load_result_namespace ) {
707 3         21 push @{ $all_namespaces_to_load{result_namespace} }, map { "'$_'" }
  6         18  
708             ref $self->load_result_namespace ?
709 3 100       8 @{ $self->load_result_namespace } :
  2         6  
710             $self->load_result_namespace;
711             }
712              
713 39 100       189 if ( $self->result_namespace ) {
714 12         51 my $namespace = sprintf "'%s::Result'", $self->result_namespace;
715 12         23 my $found = grep { $namespace eq $_ }@{ $all_namespaces_to_load{result_namespace} };
  6         17  
  12         34  
716 12 100       34 unshift @{ $all_namespaces_to_load{result_namespace} }, $namespace if !$found;
  11         31  
717             }
718              
719 39         171 my $version_add = $self->version_add;
720 39 100       185 $version_add = 0.01 if !$version_add;
721              
722 39 100       122 if ( $version ) {
723 9         30 $version += $version_add;
724             }
725              
726 39 100       130 $version = $version_add if !$version;
727              
728 39         170 $self->_set_version( $version );
729              
730 39         92 my @namespace_types;
731 39         185 for my $namespace_type ( sort keys %all_namespaces_to_load ) {
732 23         40 my @namespaces = @{ $all_namespaces_to_load{$namespace_type} };
  23         58  
733              
734 23 100       128 push @namespace_types, sprintf "\n %s => %s,",
735             $namespace_type,
736             ( @namespaces == 1 ? $namespaces[0] : '[' . (join ', ', @namespaces ) . ']' );
737             }
738              
739 39         137 my $namespaces_to_load = '';
740 39 100       209 $namespaces_to_load = "(" . (join '', @namespace_types) . "\n)" if @namespace_types;
741              
742 39 100       236 my $use_utf8 = $self->utf8 ? "\nuse utf8;" : '';
743 39 100       209 my $base_class = $self->schema_base_class ? $self->schema_base_class : 'DBIx::Class::Schema';
744              
745 39         528 my $template = qq~package $namespace;
746              
747             # ABSTRACT: Schema class
748              
749             use strict;
750             use warnings;$use_utf8
751              
752             use base qw/$base_class/;
753              
754             our \$VERSION = $version;
755              
756             __PACKAGE__->load_namespaces$namespaces_to_load;
757              
758             # ---
759             # Put your own code below this comment
760             # ---
761             $custom_code
762             # ---
763              
764             1;~;
765              
766 39         297 return $namespace, $template;
767             }
768              
769              
770             1;
771              
772             __END__