handle un-parenthesized default numeric/integer values for some versions of MSSQL...
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Base.pm
CommitLineData
996be9ee 1package DBIx::Class::Schema::Loader::Base;
2
3use strict;
4use warnings;
6ae3f335 5use base qw/Class::Accessor::Fast Class::C3::Componentised/;
996be9ee 6use Class::C3;
fa994d3c 7use Carp::Clan qw/^DBIx::Class/;
996be9ee 8use DBIx::Class::Schema::Loader::RelBuilder;
9use Data::Dump qw/ dump /;
10use POSIX qw//;
dd03ee1a 11use File::Spec qw//;
419a2eeb 12use Cwd qw//;
7cab3ab7 13use Digest::MD5 qw//;
22270947 14use Lingua::EN::Inflect::Number qw//;
af31090c 15use File::Temp qw//;
16use Class::Unload;
996be9ee 17require DBIx::Class;
18
b1ad1a84 19our $VERSION = '0.04999_10';
32f784fc 20
996be9ee 21__PACKAGE__->mk_ro_accessors(qw/
22 schema
23 schema_class
24
25 exclude
26 constraint
27 additional_classes
28 additional_base_classes
29 left_base_classes
30 components
31 resultset_components
59cfa251 32 skip_relationships
996be9ee 33 moniker_map
34 inflect_singular
35 inflect_plural
36 debug
37 dump_directory
d65cda9e 38 dump_overwrite
28b4691d 39 really_erase_my_files
f44ecc2f 40 use_namespaces
41 result_namespace
42 resultset_namespace
43 default_resultset_class
9c9c2f2b 44 schema_base_class
45 result_base_class
996be9ee 46
996be9ee 47 db_schema
48 _tables
49 classes
50 monikers
51 /);
52
53=head1 NAME
54
55DBIx::Class::Schema::Loader::Base - Base DBIx::Class::Schema::Loader Implementation.
56
57=head1 SYNOPSIS
58
59See L<DBIx::Class::Schema::Loader>
60
61=head1 DESCRIPTION
62
63This is the base class for the storage-specific C<DBIx::Class::Schema::*>
64classes, and implements the common functionality between them.
65
66=head1 CONSTRUCTOR OPTIONS
67
68These constructor options are the base options for
29ddb54c 69L<DBIx::Class::Schema::Loader/loader_options>. Available constructor options are:
3953cbee 70
59cfa251 71=head2 skip_relationships
996be9ee 72
59cfa251 73Skip setting up relationships. The default is to attempt the loading
74of relationships.
996be9ee 75
76=head2 debug
77
78If set to true, each constructive L<DBIx::Class> statement the loader
79decides to execute will be C<warn>-ed before execution.
80
d65cda9e 81=head2 db_schema
82
83Set the name of the schema to load (schema in the sense that your database
84vendor means it). Does not currently support loading more than one schema
85name.
86
996be9ee 87=head2 constraint
88
89Only load tables matching regex. Best specified as a qr// regex.
90
91=head2 exclude
92
93Exclude tables matching regex. Best specified as a qr// regex.
94
95=head2 moniker_map
96
8f9d7ce5 97Overrides the default table name to moniker translation. Can be either
98a hashref of table keys and moniker values, or a coderef for a translator
996be9ee 99function taking a single scalar table name argument and returning
100a scalar moniker. If the hash entry does not exist, or the function
101returns a false value, the code falls back to default behavior
102for that table name.
103
104The default behavior is: C<join '', map ucfirst, split /[\W_]+/, lc $table>,
105which is to say: lowercase everything, split up the table name into chunks
106anywhere a non-alpha-numeric character occurs, change the case of first letter
107of each chunk to upper case, and put the chunks back together. Examples:
108
109 Table Name | Moniker Name
110 ---------------------------
111 luser | Luser
112 luser_group | LuserGroup
113 luser-opts | LuserOpts
114
115=head2 inflect_plural
116
117Just like L</moniker_map> above (can be hash/code-ref, falls back to default
118if hash key does not exist or coderef returns false), but acts as a map
119for pluralizing relationship names. The default behavior is to utilize
120L<Lingua::EN::Inflect::Number/to_PL>.
121
122=head2 inflect_singular
123
124As L</inflect_plural> above, but for singularizing relationship names.
125Default behavior is to utilize L<Lingua::EN::Inflect::Number/to_S>.
126
9c9c2f2b 127=head2 schema_base_class
128
129Base class for your schema classes. Defaults to 'DBIx::Class::Schema'.
130
131=head2 result_base_class
132
133Base class for your table classes (aka result classes). Defaults to 'DBIx::Class'.
134
996be9ee 135=head2 additional_base_classes
136
137List of additional base classes all of your table classes will use.
138
139=head2 left_base_classes
140
141List of additional base classes all of your table classes will use
142that need to be leftmost.
143
144=head2 additional_classes
145
146List of additional classes which all of your table classes will use.
147
148=head2 components
149
150List of additional components to be loaded into all of your table
151classes. A good example would be C<ResultSetManager>.
152
153=head2 resultset_components
154
8f9d7ce5 155List of additional ResultSet components to be loaded into your table
996be9ee 156classes. A good example would be C<AlwaysRS>. Component
157C<ResultSetManager> will be automatically added to the above
158C<components> list if this option is set.
159
f44ecc2f 160=head2 use_namespaces
161
162Generate result class names suitable for
163L<DBIx::Class::Schema/load_namespaces> and call that instead of
164L<DBIx::Class::Schema/load_classes>. When using this option you can also
165specify any of the options for C<load_namespaces> (i.e. C<result_namespace>,
166C<resultset_namespace>, C<default_resultset_class>), and they will be added
167to the call (and the generated result class names adjusted appropriately).
168
996be9ee 169=head2 dump_directory
170
171This option is designed to be a tool to help you transition from this
172loader to a manually-defined schema when you decide it's time to do so.
173
174The value of this option is a perl libdir pathname. Within
175that directory this module will create a baseline manual
176L<DBIx::Class::Schema> module set, based on what it creates at runtime
177in memory.
178
179The created schema class will have the same classname as the one on
180which you are setting this option (and the ResultSource classes will be
7cab3ab7 181based on this name as well).
996be9ee 182
8f9d7ce5 183Normally you wouldn't hard-code this setting in your schema class, as it
996be9ee 184is meant for one-time manual usage.
185
186See L<DBIx::Class::Schema::Loader/dump_to_dir> for examples of the
187recommended way to access this functionality.
188
d65cda9e 189=head2 dump_overwrite
190
28b4691d 191Deprecated. See L</really_erase_my_files> below, which does *not* mean
192the same thing as the old C<dump_overwrite> setting from previous releases.
193
194=head2 really_erase_my_files
195
7cab3ab7 196Default false. If true, Loader will unconditionally delete any existing
197files before creating the new ones from scratch when dumping a schema to disk.
198
199The default behavior is instead to only replace the top portion of the
200file, up to and including the final stanza which contains
201C<# DO NOT MODIFY THIS OR ANYTHING ABOVE!>
202leaving any customizations you placed after that as they were.
203
28b4691d 204When C<really_erase_my_files> is not set, if the output file already exists,
7cab3ab7 205but the aforementioned final stanza is not found, or the checksum
206contained there does not match the generated contents, Loader will
207croak and not touch the file.
d65cda9e 208
28b4691d 209You should really be using version control on your schema classes (and all
210of the rest of your code for that matter). Don't blame me if a bug in this
211code wipes something out when it shouldn't have, you've been warned.
212
996be9ee 213=head1 METHODS
214
215None of these methods are intended for direct invocation by regular
216users of L<DBIx::Class::Schema::Loader>. Anything you can find here
217can also be found via standard L<DBIx::Class::Schema> methods somehow.
218
219=cut
220
221# ensure that a peice of object data is a valid arrayref, creating
222# an empty one or encapsulating whatever's there.
223sub _ensure_arrayref {
224 my $self = shift;
225
226 foreach (@_) {
227 $self->{$_} ||= [];
228 $self->{$_} = [ $self->{$_} ]
229 unless ref $self->{$_} eq 'ARRAY';
230 }
231}
232
233=head2 new
234
235Constructor for L<DBIx::Class::Schema::Loader::Base>, used internally
236by L<DBIx::Class::Schema::Loader>.
237
238=cut
239
240sub new {
241 my ( $class, %args ) = @_;
242
243 my $self = { %args };
244
245 bless $self => $class;
246
996be9ee 247 $self->_ensure_arrayref(qw/additional_classes
248 additional_base_classes
249 left_base_classes
250 components
251 resultset_components
252 /);
253
254 push(@{$self->{components}}, 'ResultSetManager')
255 if @{$self->{resultset_components}};
256
257 $self->{monikers} = {};
258 $self->{classes} = {};
259
996be9ee 260 $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
261 $self->{schema} ||= $self->{schema_class};
262
28b4691d 263 croak "dump_overwrite is deprecated. Please read the"
264 . " DBIx::Class::Schema::Loader::Base documentation"
265 if $self->{dump_overwrite};
266
af31090c 267 $self->{dynamic} = ! $self->{dump_directory};
79193756 268 $self->{temp_directory} ||= File::Temp::tempdir( 'dbicXXXX',
af31090c 269 TMPDIR => 1,
270 CLEANUP => 1,
271 );
272
79193756 273 $self->{dump_directory} ||= $self->{temp_directory};
274
e8ad6491 275 $self->{relbuilder} = DBIx::Class::Schema::Loader::RelBuilder->new(
706ef173 276 $self->schema, $self->inflect_plural, $self->inflect_singular
e8ad6491 277 ) if !$self->{skip_relationships};
278
996be9ee 279 $self;
280}
281
419a2eeb 282sub _find_file_in_inc {
283 my ($self, $file) = @_;
284
285 foreach my $prefix (@INC) {
af31090c 286 my $fullpath = File::Spec->catfile($prefix, $file);
287 return $fullpath if -f $fullpath
288 and Cwd::abs_path($fullpath) ne
289 Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) || '';
419a2eeb 290 }
291
292 return;
293}
294
996be9ee 295sub _load_external {
f96ef30f 296 my ($self, $class) = @_;
297
298 my $class_path = $class;
299 $class_path =~ s{::}{/}g;
300 $class_path .= '.pm';
301
af31090c 302 my $real_inc_path = $self->_find_file_in_inc($class_path);
f96ef30f 303
af31090c 304 return if !$real_inc_path;
f96ef30f 305
306 # If we make it to here, we loaded an external definition
307 warn qq/# Loaded external class definition for '$class'\n/
308 if $self->debug;
309
f96ef30f 310 croak 'Failed to locate actual external module file for '
311 . "'$class'"
312 if !$real_inc_path;
313 open(my $fh, '<', $real_inc_path)
314 or croak "Failed to open '$real_inc_path' for reading: $!";
315 $self->_ext_stmt($class,
565ca24d 316 qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
317 .qq|# They are now part of the custom portion of this file\n|
318 .qq|# for you to hand-edit. If you do not either delete\n|
319 .qq|# this section or remove that file from \@INC, this section\n|
320 .qq|# will be repeated redundantly when you re-create this\n|
321 .qq|# file again via Loader!\n|
f96ef30f 322 );
323 while(<$fh>) {
324 chomp;
325 $self->_ext_stmt($class, $_);
996be9ee 326 }
f96ef30f 327 $self->_ext_stmt($class,
70b72fab 328 qq|# End of lines loaded from '$real_inc_path' |
f96ef30f 329 );
330 close($fh)
331 or croak "Failed to close $real_inc_path: $!";
996be9ee 332}
333
334=head2 load
335
336Does the actual schema-construction work.
337
338=cut
339
340sub load {
341 my $self = shift;
342
b97c2c1e 343 $self->_load_tables($self->_tables_list);
344}
345
346=head2 rescan
347
a60b5b8d 348Arguments: schema
349
b97c2c1e 350Rescan the database for newly added tables. Does
a60b5b8d 351not process drops or changes. Returns a list of
352the newly added table monikers.
353
354The schema argument should be the schema class
355or object to be affected. It should probably
356be derived from the original schema_class used
357during L</load>.
b97c2c1e 358
359=cut
360
361sub rescan {
a60b5b8d 362 my ($self, $schema) = @_;
363
364 $self->{schema} = $schema;
706ef173 365 $self->{relbuilder}{schema} = $schema;
b97c2c1e 366
367 my @created;
368 my @current = $self->_tables_list;
369 foreach my $table ($self->_tables_list) {
370 if(!exists $self->{_tables}->{$table}) {
371 push(@created, $table);
372 }
373 }
374
c39e3507 375 my $loaded = $self->_load_tables(@created);
a60b5b8d 376
c39e3507 377 return map { $self->monikers->{$_} } @$loaded;
b97c2c1e 378}
379
380sub _load_tables {
381 my ($self, @tables) = @_;
382
f96ef30f 383 # First, use _tables_list with constraint and exclude
384 # to get a list of tables to operate on
385
386 my $constraint = $self->constraint;
387 my $exclude = $self->exclude;
f96ef30f 388
b97c2c1e 389 @tables = grep { /$constraint/ } @tables if $constraint;
390 @tables = grep { ! /$exclude/ } @tables if $exclude;
f96ef30f 391
b97c2c1e 392 # Save the new tables to the tables list
a60b5b8d 393 foreach (@tables) {
394 $self->{_tables}->{$_} = 1;
395 }
f96ef30f 396
af31090c 397 $self->_make_src_class($_) for @tables;
f96ef30f 398 $self->_setup_src_meta($_) for @tables;
399
e8ad6491 400 if(!$self->skip_relationships) {
181cc907 401 # The relationship loader needs a working schema
af31090c 402 $self->{quiet} = 1;
79193756 403 local $self->{dump_directory} = $self->{temp_directory};
181cc907 404 $self->_reload_classes(@tables);
e8ad6491 405 $self->_load_relationships($_) for @tables;
af31090c 406 $self->{quiet} = 0;
79193756 407
408 # Remove that temp dir from INC so it doesn't get reloaded
409 @INC = grep { $_ ne $self->{dump_directory} } @INC;
e8ad6491 410 }
411
f96ef30f 412 $self->_load_external($_)
75451704 413 for map { $self->classes->{$_} } @tables;
f96ef30f 414
181cc907 415 $self->_reload_classes(@tables);
996be9ee 416
5223f24a 417 # Drop temporary cache
418 delete $self->{_cache};
419
c39e3507 420 return \@tables;
996be9ee 421}
422
af31090c 423sub _reload_classes {
181cc907 424 my ($self, @tables) = @_;
425
426 $self->_dump_to_dir(map { $self->classes->{$_} } @tables);
e9b8719e 427
428 unshift @INC, $self->dump_directory;
af31090c 429
706ef173 430 my @to_register;
431 my %have_source = map { $_ => $self->schema->source($_) }
432 $self->schema->sources;
433
181cc907 434 for my $table (@tables) {
435 my $moniker = $self->monikers->{$table};
436 my $class = $self->classes->{$table};
0ae6b65d 437
438 {
439 no warnings 'redefine';
440 local *Class::C3::reinitialize = sub {};
441 use warnings;
442
706ef173 443 Class::Unload->unload($class);
444 my ($source, $resultset_class);
445 if (
446 ($source = $have_source{$moniker})
447 && ($resultset_class = $source->resultset_class)
448 && ($resultset_class ne 'DBIx::Class::ResultSet')
449 ) {
450 my $has_file = Class::Inspector->loaded_filename($resultset_class);
451 Class::Unload->unload($resultset_class);
6ae3f335 452 $self->ensure_class_loaded($resultset_class) if $has_file;
0ae6b65d 453 }
6ae3f335 454 $self->ensure_class_loaded($class);
af31090c 455 }
706ef173 456 push @to_register, [$moniker, $class];
457 }
af31090c 458
706ef173 459 Class::C3->reinitialize;
460 for (@to_register) {
461 $self->schema->register_class(@$_);
af31090c 462 }
463}
464
996be9ee 465sub _get_dump_filename {
466 my ($self, $class) = (@_);
467
468 $class =~ s{::}{/}g;
469 return $self->dump_directory . q{/} . $class . q{.pm};
470}
471
472sub _ensure_dump_subdirs {
473 my ($self, $class) = (@_);
474
475 my @name_parts = split(/::/, $class);
dd03ee1a 476 pop @name_parts; # we don't care about the very last element,
477 # which is a filename
478
996be9ee 479 my $dir = $self->dump_directory;
7cab3ab7 480 while (1) {
481 if(!-d $dir) {
25328cc4 482 mkdir($dir) or croak "mkdir('$dir') failed: $!";
996be9ee 483 }
7cab3ab7 484 last if !@name_parts;
485 $dir = File::Spec->catdir($dir, shift @name_parts);
996be9ee 486 }
487}
488
489sub _dump_to_dir {
af31090c 490 my ($self, @classes) = @_;
996be9ee 491
fc2b71fd 492 my $schema_class = $self->schema_class;
9c9c2f2b 493 my $schema_base_class = $self->schema_base_class || 'DBIx::Class::Schema';
996be9ee 494
e9b8719e 495 my $target_dir = $self->dump_directory;
af31090c 496 warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
497 unless $self->{dynamic} or $self->{quiet};
996be9ee 498
7cab3ab7 499 my $schema_text =
500 qq|package $schema_class;\n\n|
b4dcbcc5 501 . qq|# Created by DBIx::Class::Schema::Loader\n|
502 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
7cab3ab7 503 . qq|use strict;\nuse warnings;\n\n|
9c9c2f2b 504 . qq|use base '$schema_base_class';\n\n|;
f44ecc2f 505
f44ecc2f 506 if ($self->use_namespaces) {
507 $schema_text .= qq|__PACKAGE__->load_namespaces|;
508 my $namespace_options;
509 for my $attr (qw(result_namespace
510 resultset_namespace
511 default_resultset_class)) {
512 if ($self->$attr) {
513 $namespace_options .= qq| $attr => '| . $self->$attr . qq|',\n|
514 }
515 }
516 $schema_text .= qq|(\n$namespace_options)| if $namespace_options;
517 $schema_text .= qq|;\n|;
518 }
519 else {
520 $schema_text .= qq|__PACKAGE__->load_classes;\n|;
f44ecc2f 521 }
996be9ee 522
7cab3ab7 523 $self->_write_classfile($schema_class, $schema_text);
996be9ee 524
9c9c2f2b 525 my $result_base_class = $self->result_base_class || 'DBIx::Class';
526
af31090c 527 foreach my $src_class (@classes) {
7cab3ab7 528 my $src_text =
529 qq|package $src_class;\n\n|
b4dcbcc5 530 . qq|# Created by DBIx::Class::Schema::Loader\n|
531 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
7cab3ab7 532 . qq|use strict;\nuse warnings;\n\n|
9c9c2f2b 533 . qq|use base '$result_base_class';\n\n|;
996be9ee 534
7cab3ab7 535 $self->_write_classfile($src_class, $src_text);
02356864 536 }
996be9ee 537
af31090c 538 warn "Schema dump completed.\n" unless $self->{dynamic} or $self->{quiet};
539
7cab3ab7 540}
541
79193756 542sub _sig_comment {
543 my ($self, $version, $ts) = @_;
544 return qq|\n\n# Created by DBIx::Class::Schema::Loader|
545 . qq| v| . $version
546 . q| @ | . $ts
547 . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
548}
549
7cab3ab7 550sub _write_classfile {
551 my ($self, $class, $text) = @_;
552
553 my $filename = $self->_get_dump_filename($class);
554 $self->_ensure_dump_subdirs($class);
555
28b4691d 556 if (-f $filename && $self->really_erase_my_files) {
7cab3ab7 557 warn "Deleting existing file '$filename' due to "
af31090c 558 . "'really_erase_my_files' setting\n" unless $self->{quiet};
7cab3ab7 559 unlink($filename);
560 }
561
79193756 562 my ($custom_content, $old_md5, $old_ver, $old_ts) = $self->_get_custom_content($class, $filename);
17ca645f 563
7cab3ab7 564 $text .= qq|$_\n|
565 for @{$self->{_dump_storage}->{$class} || []};
566
79193756 567 # Check and see if the dump is infact differnt
568
569 my $compare_to;
570 if ($old_md5) {
571 $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
572
573
574 if (Digest::MD5::md5_base64($compare_to) eq $old_md5) {
575 return;
576 }
577 }
578
579 $text .= $self->_sig_comment(
580 $DBIx::Class::Schema::Loader::VERSION,
581 POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
582 );
7cab3ab7 583
584 open(my $fh, '>', $filename)
585 or croak "Cannot open '$filename' for writing: $!";
586
587 # Write the top half and its MD5 sum
a4476f41 588 print $fh $text . Digest::MD5::md5_base64($text) . "\n";
7cab3ab7 589
590 # Write out anything loaded via external partial class file in @INC
591 print $fh qq|$_\n|
592 for @{$self->{_ext_storage}->{$class} || []};
593
1eea4fb1 594 # Write out any custom content the user has added
7cab3ab7 595 print $fh $custom_content;
596
597 close($fh)
e9b8719e 598 or croak "Error closing '$filename': $!";
7cab3ab7 599}
600
79193756 601sub _default_custom_content {
602 return qq|\n\n# You can replace this text with custom|
603 . qq| content, and it will be preserved on regeneration|
604 . qq|\n1;\n|;
605}
606
7cab3ab7 607sub _get_custom_content {
608 my ($self, $class, $filename) = @_;
609
79193756 610 return ($self->_default_custom_content) if ! -f $filename;
611
7cab3ab7 612 open(my $fh, '<', $filename)
613 or croak "Cannot open '$filename' for reading: $!";
614
615 my $mark_re =
419a2eeb 616 qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n};
7cab3ab7 617
7cab3ab7 618 my $buffer = '';
79193756 619 my ($md5, $ts, $ver);
7cab3ab7 620 while(<$fh>) {
79193756 621 if(!$md5 && /$mark_re/) {
622 $md5 = $2;
623 my $line = $1;
624
625 # Pull out the previous version and timestamp
626 ($ver, $ts) = $buffer =~ m/# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)$/s;
627
628 $buffer .= $line;
7cab3ab7 629 croak "Checksum mismatch in '$filename'"
79193756 630 if Digest::MD5::md5_base64($buffer) ne $md5;
7cab3ab7 631
632 $buffer = '';
633 }
634 else {
635 $buffer .= $_;
636 }
996be9ee 637 }
638
28b4691d 639 croak "Cannot not overwrite '$filename' without 'really_erase_my_files',"
419a2eeb 640 . " it does not appear to have been generated by Loader"
79193756 641 if !$md5;
642
643 # Default custom content:
644 $buffer ||= $self->_default_custom_content;
5ef3c771 645
79193756 646 return ($buffer, $md5, $ver, $ts);
996be9ee 647}
648
649sub _use {
650 my $self = shift;
651 my $target = shift;
652
653 foreach (@_) {
cb54990b 654 warn "$target: use $_;" if $self->debug;
996be9ee 655 $self->_raw_stmt($target, "use $_;");
996be9ee 656 }
657}
658
659sub _inject {
660 my $self = shift;
661 my $target = shift;
662 my $schema_class = $self->schema_class;
663
af31090c 664 my $blist = join(q{ }, @_);
665 warn "$target: use base qw/ $blist /;" if $self->debug && @_;
666 $self->_raw_stmt($target, "use base qw/ $blist /;") if @_;
996be9ee 667}
668
f96ef30f 669# Create class with applicable bases, setup monikers, etc
670sub _make_src_class {
671 my ($self, $table) = @_;
996be9ee 672
a13b2803 673 my $schema = $self->schema;
674 my $schema_class = $self->schema_class;
996be9ee 675
f96ef30f 676 my $table_moniker = $self->_table2moniker($table);
f44ecc2f 677 my @result_namespace = ($schema_class);
678 if ($self->use_namespaces) {
679 my $result_namespace = $self->result_namespace || 'Result';
680 if ($result_namespace =~ /^\+(.*)/) {
681 # Fully qualified namespace
682 @result_namespace = ($1)
683 }
684 else {
685 # Relative namespace
686 push @result_namespace, $result_namespace;
687 }
688 }
689 my $table_class = join(q{::}, @result_namespace, $table_moniker);
996be9ee 690
f96ef30f 691 my $table_normalized = lc $table;
692 $self->classes->{$table} = $table_class;
693 $self->classes->{$table_normalized} = $table_class;
694 $self->monikers->{$table} = $table_moniker;
695 $self->monikers->{$table_normalized} = $table_moniker;
996be9ee 696
f96ef30f 697 $self->_use ($table_class, @{$self->additional_classes});
af31090c 698 $self->_inject($table_class, @{$self->left_base_classes});
996be9ee 699
605fcea8 700 $self->_dbic_stmt($table_class, 'load_components', @{$self->components}, 'Core');
996be9ee 701
f96ef30f 702 $self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
703 if @{$self->resultset_components};
af31090c 704 $self->_inject($table_class, @{$self->additional_base_classes});
f96ef30f 705}
996be9ee 706
af31090c 707# Set up metadata (cols, pks, etc)
f96ef30f 708sub _setup_src_meta {
709 my ($self, $table) = @_;
996be9ee 710
f96ef30f 711 my $schema = $self->schema;
712 my $schema_class = $self->schema_class;
a13b2803 713
f96ef30f 714 my $table_class = $self->classes->{$table};
715 my $table_moniker = $self->monikers->{$table};
996be9ee 716
ff30991a 717 my $table_name = $table;
718 my $name_sep = $self->schema->storage->sql_maker->name_sep;
719
c177d483 720 if ($name_sep && $table_name =~ /\Q$name_sep\E/) {
ff30991a 721 $table_name = \ $self->_quote_table_name($table_name);
722 }
723
724 $self->_dbic_stmt($table_class,'table',$table_name);
996be9ee 725
f96ef30f 726 my $cols = $self->_table_columns($table);
727 my $col_info;
728 eval { $col_info = $self->_columns_info_for($table) };
729 if($@) {
730 $self->_dbic_stmt($table_class,'add_columns',@$cols);
731 }
732 else {
0906d55b 733 if ($self->_is_case_sensitive) {
734 for my $col (keys %$col_info) {
735 $col_info->{$col}{accessor} = lc $col
736 if $col ne lc($col);
737 }
738 } else {
739 $col_info = { map { lc($_), $col_info->{$_} } keys %$col_info };
c9373b79 740 }
741
e7213f4f 742 my $fks = $self->_table_fk_info($table);
565335e6 743
e7213f4f 744 for my $fkdef (@$fks) {
745 for my $col (@{ $fkdef->{local_columns} }) {
565335e6 746 $col_info->{$col}{is_foreign_key} = 1;
e7213f4f 747 }
748 }
f96ef30f 749 $self->_dbic_stmt(
750 $table_class,
751 'add_columns',
565335e6 752 map { $_, ($col_info->{$_}||{}) } @$cols
f96ef30f 753 );
996be9ee 754 }
755
d70c335f 756 my %uniq_tag; # used to eliminate duplicate uniqs
757
f96ef30f 758 my $pks = $self->_table_pk_info($table) || [];
759 @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
760 : carp("$table has no primary key");
d70c335f 761 $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
996be9ee 762
f96ef30f 763 my $uniqs = $self->_table_uniq_info($table) || [];
d70c335f 764 for (@$uniqs) {
765 my ($name, $cols) = @$_;
766 next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
767 $self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
768 }
769
996be9ee 770}
771
772=head2 tables
773
774Returns a sorted list of loaded tables, using the original database table
775names.
776
777=cut
778
779sub tables {
780 my $self = shift;
781
b97c2c1e 782 return keys %{$self->_tables};
996be9ee 783}
784
785# Make a moniker from a table
c39e403e 786sub _default_table2moniker {
787 my ($self, $table) = @_;
788
789 return join '', map ucfirst, split /[\W_]+/,
790 Lingua::EN::Inflect::Number::to_S(lc $table);
791}
792
996be9ee 793sub _table2moniker {
794 my ( $self, $table ) = @_;
795
796 my $moniker;
797
798 if( ref $self->moniker_map eq 'HASH' ) {
799 $moniker = $self->moniker_map->{$table};
800 }
801 elsif( ref $self->moniker_map eq 'CODE' ) {
802 $moniker = $self->moniker_map->($table);
803 }
804
c39e403e 805 $moniker ||= $self->_default_table2moniker($table);
996be9ee 806
807 return $moniker;
808}
809
810sub _load_relationships {
e8ad6491 811 my ($self, $table) = @_;
996be9ee 812
e8ad6491 813 my $tbl_fk_info = $self->_table_fk_info($table);
814 foreach my $fkdef (@$tbl_fk_info) {
815 $fkdef->{remote_source} =
816 $self->monikers->{delete $fkdef->{remote_table}};
996be9ee 817 }
26f1c8c9 818 my $tbl_uniq_info = $self->_table_uniq_info($table);
996be9ee 819
e8ad6491 820 my $local_moniker = $self->monikers->{$table};
26f1c8c9 821 my $rel_stmts = $self->{relbuilder}->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
996be9ee 822
996be9ee 823 foreach my $src_class (sort keys %$rel_stmts) {
824 my $src_stmts = $rel_stmts->{$src_class};
825 foreach my $stmt (@$src_stmts) {
826 $self->_dbic_stmt($src_class,$stmt->{method},@{$stmt->{args}});
827 }
828 }
829}
830
831# Overload these in driver class:
832
833# Returns an arrayref of column names
834sub _table_columns { croak "ABSTRACT METHOD" }
835
836# Returns arrayref of pk col names
837sub _table_pk_info { croak "ABSTRACT METHOD" }
838
839# Returns an arrayref of uniqs [ [ foo => [ col1, col2 ] ], [ bar => [ ... ] ] ]
840sub _table_uniq_info { croak "ABSTRACT METHOD" }
841
842# Returns an arrayref of foreign key constraints, each
843# being a hashref with 3 keys:
844# local_columns (arrayref), remote_columns (arrayref), remote_table
845sub _table_fk_info { croak "ABSTRACT METHOD" }
846
847# Returns an array of lower case table names
848sub _tables_list { croak "ABSTRACT METHOD" }
849
850# Execute a constructive DBIC class method, with debug/dump_to_dir hooks.
851sub _dbic_stmt {
852 my $self = shift;
853 my $class = shift;
854 my $method = shift;
855
996be9ee 856 my $args = dump(@_);
857 $args = '(' . $args . ')' if @_ < 2;
858 my $stmt = $method . $args . q{;};
859
860 warn qq|$class\->$stmt\n| if $self->debug;
996be9ee 861 $self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
862}
863
864# Store a raw source line for a class (for dumping purposes)
865sub _raw_stmt {
866 my ($self, $class, $stmt) = @_;
af31090c 867 push(@{$self->{_dump_storage}->{$class}}, $stmt);
996be9ee 868}
869
7cab3ab7 870# Like above, but separately for the externally loaded stuff
871sub _ext_stmt {
872 my ($self, $class, $stmt) = @_;
af31090c 873 push(@{$self->{_ext_storage}->{$class}}, $stmt);
7cab3ab7 874}
875
565335e6 876sub _quote_table_name {
877 my ($self, $table) = @_;
878
879 my $qt = $self->schema->storage->sql_maker->quote_char;
880
c177d483 881 return $table unless $qt;
882
565335e6 883 if (ref $qt) {
884 return $qt->[0] . $table . $qt->[1];
885 }
886
887 return $qt . $table . $qt;
888}
889
890sub _is_case_sensitive { 0 }
891
996be9ee 892=head2 monikers
893
8f9d7ce5 894Returns a hashref of loaded table to moniker mappings. There will
996be9ee 895be two entries for each table, the original name and the "normalized"
896name, in the case that the two are different (such as databases
897that like uppercase table names, or preserve your original mixed-case
898definitions, or what-have-you).
899
900=head2 classes
901
8f9d7ce5 902Returns a hashref of table to class mappings. In some cases it will
996be9ee 903contain multiple entries per table for the original and normalized table
904names, as above in L</monikers>.
905
906=head1 SEE ALSO
907
908L<DBIx::Class::Schema::Loader>
909
be80bba7 910=head1 AUTHOR
911
912See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
913
914=head1 LICENSE
915
916This library is free software; you can redistribute it and/or modify it under
917the same terms as Perl itself.
918
996be9ee 919=cut
920
9211;