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