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