added test to check for correct file count in common tests
[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
4daef04f 426 # so that we don't repeat custom sections
427 @INC = grep $_ ne $self->dump_directory, @INC;
428
181cc907 429 $self->_dump_to_dir(map { $self->classes->{$_} } @tables);
e9b8719e 430
431 unshift @INC, $self->dump_directory;
af31090c 432
706ef173 433 my @to_register;
434 my %have_source = map { $_ => $self->schema->source($_) }
435 $self->schema->sources;
436
181cc907 437 for my $table (@tables) {
438 my $moniker = $self->monikers->{$table};
439 my $class = $self->classes->{$table};
0ae6b65d 440
441 {
442 no warnings 'redefine';
443 local *Class::C3::reinitialize = sub {};
444 use warnings;
445
706ef173 446 Class::Unload->unload($class);
447 my ($source, $resultset_class);
448 if (
449 ($source = $have_source{$moniker})
450 && ($resultset_class = $source->resultset_class)
451 && ($resultset_class ne 'DBIx::Class::ResultSet')
452 ) {
453 my $has_file = Class::Inspector->loaded_filename($resultset_class);
454 Class::Unload->unload($resultset_class);
6ae3f335 455 $self->ensure_class_loaded($resultset_class) if $has_file;
0ae6b65d 456 }
6ae3f335 457 $self->ensure_class_loaded($class);
af31090c 458 }
706ef173 459 push @to_register, [$moniker, $class];
460 }
af31090c 461
706ef173 462 Class::C3->reinitialize;
463 for (@to_register) {
464 $self->schema->register_class(@$_);
af31090c 465 }
466}
467
996be9ee 468sub _get_dump_filename {
469 my ($self, $class) = (@_);
470
471 $class =~ s{::}{/}g;
472 return $self->dump_directory . q{/} . $class . q{.pm};
473}
474
475sub _ensure_dump_subdirs {
476 my ($self, $class) = (@_);
477
478 my @name_parts = split(/::/, $class);
dd03ee1a 479 pop @name_parts; # we don't care about the very last element,
480 # which is a filename
481
996be9ee 482 my $dir = $self->dump_directory;
7cab3ab7 483 while (1) {
484 if(!-d $dir) {
25328cc4 485 mkdir($dir) or croak "mkdir('$dir') failed: $!";
996be9ee 486 }
7cab3ab7 487 last if !@name_parts;
488 $dir = File::Spec->catdir($dir, shift @name_parts);
996be9ee 489 }
490}
491
492sub _dump_to_dir {
af31090c 493 my ($self, @classes) = @_;
996be9ee 494
fc2b71fd 495 my $schema_class = $self->schema_class;
9c9c2f2b 496 my $schema_base_class = $self->schema_base_class || 'DBIx::Class::Schema';
996be9ee 497
e9b8719e 498 my $target_dir = $self->dump_directory;
af31090c 499 warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
500 unless $self->{dynamic} or $self->{quiet};
996be9ee 501
7cab3ab7 502 my $schema_text =
503 qq|package $schema_class;\n\n|
b4dcbcc5 504 . qq|# Created by DBIx::Class::Schema::Loader\n|
505 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
7cab3ab7 506 . qq|use strict;\nuse warnings;\n\n|
9c9c2f2b 507 . qq|use base '$schema_base_class';\n\n|;
f44ecc2f 508
f44ecc2f 509 if ($self->use_namespaces) {
510 $schema_text .= qq|__PACKAGE__->load_namespaces|;
511 my $namespace_options;
512 for my $attr (qw(result_namespace
513 resultset_namespace
514 default_resultset_class)) {
515 if ($self->$attr) {
516 $namespace_options .= qq| $attr => '| . $self->$attr . qq|',\n|
517 }
518 }
519 $schema_text .= qq|(\n$namespace_options)| if $namespace_options;
520 $schema_text .= qq|;\n|;
521 }
522 else {
523 $schema_text .= qq|__PACKAGE__->load_classes;\n|;
f44ecc2f 524 }
996be9ee 525
7cab3ab7 526 $self->_write_classfile($schema_class, $schema_text);
996be9ee 527
9c9c2f2b 528 my $result_base_class = $self->result_base_class || 'DBIx::Class';
529
af31090c 530 foreach my $src_class (@classes) {
7cab3ab7 531 my $src_text =
532 qq|package $src_class;\n\n|
b4dcbcc5 533 . qq|# Created by DBIx::Class::Schema::Loader\n|
534 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
7cab3ab7 535 . qq|use strict;\nuse warnings;\n\n|
9c9c2f2b 536 . qq|use base '$result_base_class';\n\n|;
996be9ee 537
7cab3ab7 538 $self->_write_classfile($src_class, $src_text);
02356864 539 }
996be9ee 540
af31090c 541 warn "Schema dump completed.\n" unless $self->{dynamic} or $self->{quiet};
542
7cab3ab7 543}
544
79193756 545sub _sig_comment {
546 my ($self, $version, $ts) = @_;
547 return qq|\n\n# Created by DBIx::Class::Schema::Loader|
548 . qq| v| . $version
549 . q| @ | . $ts
550 . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
551}
552
7cab3ab7 553sub _write_classfile {
554 my ($self, $class, $text) = @_;
555
556 my $filename = $self->_get_dump_filename($class);
557 $self->_ensure_dump_subdirs($class);
558
28b4691d 559 if (-f $filename && $self->really_erase_my_files) {
7cab3ab7 560 warn "Deleting existing file '$filename' due to "
af31090c 561 . "'really_erase_my_files' setting\n" unless $self->{quiet};
7cab3ab7 562 unlink($filename);
563 }
564
79193756 565 my ($custom_content, $old_md5, $old_ver, $old_ts) = $self->_get_custom_content($class, $filename);
17ca645f 566
7cab3ab7 567 $text .= qq|$_\n|
568 for @{$self->{_dump_storage}->{$class} || []};
569
79193756 570 # Check and see if the dump is infact differnt
571
572 my $compare_to;
573 if ($old_md5) {
574 $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
575
576
577 if (Digest::MD5::md5_base64($compare_to) eq $old_md5) {
578 return;
579 }
580 }
581
582 $text .= $self->_sig_comment(
583 $DBIx::Class::Schema::Loader::VERSION,
584 POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
585 );
7cab3ab7 586
587 open(my $fh, '>', $filename)
588 or croak "Cannot open '$filename' for writing: $!";
589
590 # Write the top half and its MD5 sum
a4476f41 591 print $fh $text . Digest::MD5::md5_base64($text) . "\n";
7cab3ab7 592
593 # Write out anything loaded via external partial class file in @INC
594 print $fh qq|$_\n|
595 for @{$self->{_ext_storage}->{$class} || []};
596
1eea4fb1 597 # Write out any custom content the user has added
7cab3ab7 598 print $fh $custom_content;
599
600 close($fh)
e9b8719e 601 or croak "Error closing '$filename': $!";
7cab3ab7 602}
603
79193756 604sub _default_custom_content {
605 return qq|\n\n# You can replace this text with custom|
606 . qq| content, and it will be preserved on regeneration|
607 . qq|\n1;\n|;
608}
609
7cab3ab7 610sub _get_custom_content {
611 my ($self, $class, $filename) = @_;
612
79193756 613 return ($self->_default_custom_content) if ! -f $filename;
614
7cab3ab7 615 open(my $fh, '<', $filename)
616 or croak "Cannot open '$filename' for reading: $!";
617
618 my $mark_re =
419a2eeb 619 qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n};
7cab3ab7 620
7cab3ab7 621 my $buffer = '';
79193756 622 my ($md5, $ts, $ver);
7cab3ab7 623 while(<$fh>) {
79193756 624 if(!$md5 && /$mark_re/) {
625 $md5 = $2;
626 my $line = $1;
627
628 # Pull out the previous version and timestamp
629 ($ver, $ts) = $buffer =~ m/# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)$/s;
630
631 $buffer .= $line;
7cab3ab7 632 croak "Checksum mismatch in '$filename'"
79193756 633 if Digest::MD5::md5_base64($buffer) ne $md5;
7cab3ab7 634
635 $buffer = '';
636 }
637 else {
638 $buffer .= $_;
639 }
996be9ee 640 }
641
28b4691d 642 croak "Cannot not overwrite '$filename' without 'really_erase_my_files',"
419a2eeb 643 . " it does not appear to have been generated by Loader"
79193756 644 if !$md5;
645
646 # Default custom content:
647 $buffer ||= $self->_default_custom_content;
5ef3c771 648
79193756 649 return ($buffer, $md5, $ver, $ts);
996be9ee 650}
651
652sub _use {
653 my $self = shift;
654 my $target = shift;
655
656 foreach (@_) {
cb54990b 657 warn "$target: use $_;" if $self->debug;
996be9ee 658 $self->_raw_stmt($target, "use $_;");
996be9ee 659 }
660}
661
662sub _inject {
663 my $self = shift;
664 my $target = shift;
665 my $schema_class = $self->schema_class;
666
af31090c 667 my $blist = join(q{ }, @_);
668 warn "$target: use base qw/ $blist /;" if $self->debug && @_;
669 $self->_raw_stmt($target, "use base qw/ $blist /;") if @_;
996be9ee 670}
671
f96ef30f 672# Create class with applicable bases, setup monikers, etc
673sub _make_src_class {
674 my ($self, $table) = @_;
996be9ee 675
a13b2803 676 my $schema = $self->schema;
677 my $schema_class = $self->schema_class;
996be9ee 678
f96ef30f 679 my $table_moniker = $self->_table2moniker($table);
f44ecc2f 680 my @result_namespace = ($schema_class);
681 if ($self->use_namespaces) {
682 my $result_namespace = $self->result_namespace || 'Result';
683 if ($result_namespace =~ /^\+(.*)/) {
684 # Fully qualified namespace
685 @result_namespace = ($1)
686 }
687 else {
688 # Relative namespace
689 push @result_namespace, $result_namespace;
690 }
691 }
692 my $table_class = join(q{::}, @result_namespace, $table_moniker);
996be9ee 693
f96ef30f 694 my $table_normalized = lc $table;
695 $self->classes->{$table} = $table_class;
696 $self->classes->{$table_normalized} = $table_class;
697 $self->monikers->{$table} = $table_moniker;
698 $self->monikers->{$table_normalized} = $table_moniker;
996be9ee 699
f96ef30f 700 $self->_use ($table_class, @{$self->additional_classes});
af31090c 701 $self->_inject($table_class, @{$self->left_base_classes});
996be9ee 702
605fcea8 703 $self->_dbic_stmt($table_class, 'load_components', @{$self->components}, 'Core');
996be9ee 704
f96ef30f 705 $self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
706 if @{$self->resultset_components};
af31090c 707 $self->_inject($table_class, @{$self->additional_base_classes});
f96ef30f 708}
996be9ee 709
af31090c 710# Set up metadata (cols, pks, etc)
f96ef30f 711sub _setup_src_meta {
712 my ($self, $table) = @_;
996be9ee 713
f96ef30f 714 my $schema = $self->schema;
715 my $schema_class = $self->schema_class;
a13b2803 716
f96ef30f 717 my $table_class = $self->classes->{$table};
718 my $table_moniker = $self->monikers->{$table};
996be9ee 719
ff30991a 720 my $table_name = $table;
721 my $name_sep = $self->schema->storage->sql_maker->name_sep;
722
c177d483 723 if ($name_sep && $table_name =~ /\Q$name_sep\E/) {
ff30991a 724 $table_name = \ $self->_quote_table_name($table_name);
725 }
726
727 $self->_dbic_stmt($table_class,'table',$table_name);
996be9ee 728
f96ef30f 729 my $cols = $self->_table_columns($table);
730 my $col_info;
731 eval { $col_info = $self->_columns_info_for($table) };
732 if($@) {
733 $self->_dbic_stmt($table_class,'add_columns',@$cols);
734 }
735 else {
0906d55b 736 if ($self->_is_case_sensitive) {
737 for my $col (keys %$col_info) {
738 $col_info->{$col}{accessor} = lc $col
739 if $col ne lc($col);
740 }
741 } else {
742 $col_info = { map { lc($_), $col_info->{$_} } keys %$col_info };
c9373b79 743 }
744
e7213f4f 745 my $fks = $self->_table_fk_info($table);
565335e6 746
e7213f4f 747 for my $fkdef (@$fks) {
748 for my $col (@{ $fkdef->{local_columns} }) {
565335e6 749 $col_info->{$col}{is_foreign_key} = 1;
e7213f4f 750 }
751 }
f96ef30f 752 $self->_dbic_stmt(
753 $table_class,
754 'add_columns',
565335e6 755 map { $_, ($col_info->{$_}||{}) } @$cols
f96ef30f 756 );
996be9ee 757 }
758
d70c335f 759 my %uniq_tag; # used to eliminate duplicate uniqs
760
f96ef30f 761 my $pks = $self->_table_pk_info($table) || [];
762 @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
763 : carp("$table has no primary key");
d70c335f 764 $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
996be9ee 765
f96ef30f 766 my $uniqs = $self->_table_uniq_info($table) || [];
d70c335f 767 for (@$uniqs) {
768 my ($name, $cols) = @$_;
769 next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
770 $self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
771 }
772
996be9ee 773}
774
775=head2 tables
776
777Returns a sorted list of loaded tables, using the original database table
778names.
779
780=cut
781
782sub tables {
783 my $self = shift;
784
b97c2c1e 785 return keys %{$self->_tables};
996be9ee 786}
787
788# Make a moniker from a table
c39e403e 789sub _default_table2moniker {
790 my ($self, $table) = @_;
791
792 return join '', map ucfirst, split /[\W_]+/,
793 Lingua::EN::Inflect::Number::to_S(lc $table);
794}
795
996be9ee 796sub _table2moniker {
797 my ( $self, $table ) = @_;
798
799 my $moniker;
800
801 if( ref $self->moniker_map eq 'HASH' ) {
802 $moniker = $self->moniker_map->{$table};
803 }
804 elsif( ref $self->moniker_map eq 'CODE' ) {
805 $moniker = $self->moniker_map->($table);
806 }
807
c39e403e 808 $moniker ||= $self->_default_table2moniker($table);
996be9ee 809
810 return $moniker;
811}
812
813sub _load_relationships {
e8ad6491 814 my ($self, $table) = @_;
996be9ee 815
e8ad6491 816 my $tbl_fk_info = $self->_table_fk_info($table);
817 foreach my $fkdef (@$tbl_fk_info) {
818 $fkdef->{remote_source} =
819 $self->monikers->{delete $fkdef->{remote_table}};
996be9ee 820 }
26f1c8c9 821 my $tbl_uniq_info = $self->_table_uniq_info($table);
996be9ee 822
e8ad6491 823 my $local_moniker = $self->monikers->{$table};
26f1c8c9 824 my $rel_stmts = $self->{relbuilder}->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
996be9ee 825
996be9ee 826 foreach my $src_class (sort keys %$rel_stmts) {
827 my $src_stmts = $rel_stmts->{$src_class};
828 foreach my $stmt (@$src_stmts) {
829 $self->_dbic_stmt($src_class,$stmt->{method},@{$stmt->{args}});
830 }
831 }
832}
833
834# Overload these in driver class:
835
836# Returns an arrayref of column names
837sub _table_columns { croak "ABSTRACT METHOD" }
838
839# Returns arrayref of pk col names
840sub _table_pk_info { croak "ABSTRACT METHOD" }
841
842# Returns an arrayref of uniqs [ [ foo => [ col1, col2 ] ], [ bar => [ ... ] ] ]
843sub _table_uniq_info { croak "ABSTRACT METHOD" }
844
845# Returns an arrayref of foreign key constraints, each
846# being a hashref with 3 keys:
847# local_columns (arrayref), remote_columns (arrayref), remote_table
848sub _table_fk_info { croak "ABSTRACT METHOD" }
849
850# Returns an array of lower case table names
851sub _tables_list { croak "ABSTRACT METHOD" }
852
853# Execute a constructive DBIC class method, with debug/dump_to_dir hooks.
854sub _dbic_stmt {
855 my $self = shift;
856 my $class = shift;
857 my $method = shift;
858
996be9ee 859 my $args = dump(@_);
860 $args = '(' . $args . ')' if @_ < 2;
861 my $stmt = $method . $args . q{;};
862
863 warn qq|$class\->$stmt\n| if $self->debug;
996be9ee 864 $self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
865}
866
867# Store a raw source line for a class (for dumping purposes)
868sub _raw_stmt {
869 my ($self, $class, $stmt) = @_;
af31090c 870 push(@{$self->{_dump_storage}->{$class}}, $stmt);
996be9ee 871}
872
7cab3ab7 873# Like above, but separately for the externally loaded stuff
874sub _ext_stmt {
875 my ($self, $class, $stmt) = @_;
af31090c 876 push(@{$self->{_ext_storage}->{$class}}, $stmt);
7cab3ab7 877}
878
565335e6 879sub _quote_table_name {
880 my ($self, $table) = @_;
881
882 my $qt = $self->schema->storage->sql_maker->quote_char;
883
c177d483 884 return $table unless $qt;
885
565335e6 886 if (ref $qt) {
887 return $qt->[0] . $table . $qt->[1];
888 }
889
890 return $qt . $table . $qt;
891}
892
893sub _is_case_sensitive { 0 }
894
996be9ee 895=head2 monikers
896
8f9d7ce5 897Returns a hashref of loaded table to moniker mappings. There will
996be9ee 898be two entries for each table, the original name and the "normalized"
899name, in the case that the two are different (such as databases
900that like uppercase table names, or preserve your original mixed-case
901definitions, or what-have-you).
902
903=head2 classes
904
8f9d7ce5 905Returns a hashref of table to class mappings. In some cases it will
996be9ee 906contain multiple entries per table for the original and normalized table
907names, as above in L</monikers>.
908
909=head1 SEE ALSO
910
911L<DBIx::Class::Schema::Loader>
912
be80bba7 913=head1 AUTHOR
914
915See L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
916
917=head1 LICENSE
918
919This library is free software; you can redistribute it and/or modify it under
920the same terms as Perl itself.
921
996be9ee 922=cut
923
9241;