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