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::Grouped Class::C3::Componentised/;
   6 use mro 'c3';
   7 use Carp::Clan qw/^DBIx::Class/;
   8 use DBIx::Class::Schema::Loader::RelBuilder ();
   9 use Data::Dump 'dump';
  10 use POSIX ();
  11 use File::Spec ();
  12 use Cwd ();
  13 use Digest::MD5 ();
  14 use Lingua::EN::Inflect::Number ();
  15 use Lingua::EN::Inflect::Phrase ();
  16 use String::ToIdentifier::EN ();
  17 use String::ToIdentifier::EN::Unicode ();
  18 use File::Temp ();
  19 use Class::Unload;
  20 use Class::Inspector ();
  21 use Scalar::Util 'looks_like_number';
  22 use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path slurp_file/;
  23 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
  24 use Try::Tiny;
  25 use DBIx::Class ();
  26 use Encode qw/encode decode/;
  27 use List::MoreUtils qw/all firstidx/;
  28 use File::Temp 'tempfile';
  29 use namespace::clean;
  30
  31 our $VERSION = '0.07012';
  32
  33 __PACKAGE__->mk_group_ro_accessors('simple', qw/
  34                                 schema
  35                                 schema_class
  36
  37                                 exclude
  38                                 constraint
  39                                 additional_classes
  40                                 additional_base_classes
  41                                 left_base_classes
  42                                 components
  43                                 schema_components
  44                                 skip_relationships
  45                                 skip_load_external
  46                                 moniker_map
  47                                 col_accessor_map
  48                                 custom_column_info
  49                                 inflect_singular
  50                                 inflect_plural
  51                                 debug
  52                                 dump_directory
  53                                 dump_overwrite
  54                                 really_erase_my_files
  55                                 resultset_namespace
  56                                 default_resultset_class
  57                                 schema_base_class
  58                                 result_base_class
  59                                 result_roles
  60                                 use_moose
  61                                 only_autoclean
  62                                 overwrite_modifications
  63
  64                                 relationship_attrs
  65
  66                                 _tables
  67                                 classes
  68                                 _upgrading_classes
  69                                 monikers
  70                                 dynamic
  71                                 naming
  72                                 datetime_timezone
  73                                 datetime_locale
  74                                 config_file
  75                                 loader_class
  76                                 table_comments_table
  77                                 column_comments_table
  78                                 class_to_table
  79                                 moniker_to_table
  80                                 uniq_to_primary
  81                                 quiet
  82 /);
  83
  84
  85 __PACKAGE__->mk_group_accessors('simple', qw/
  86                                 version_to_dump
  87                                 schema_version_to_dump
  88                                 _upgrading_from
  89                                 _upgrading_from_load_classes
  90                                 _downgrading_to_load_classes
  91                                 _rewriting_result_namespace
  92                                 use_namespaces
  93                                 result_namespace
  94                                 generate_pod
  95                                 pod_comment_mode
  96                                 pod_comment_spillover_length
  97                                 preserve_case
  98                                 col_collision_map
  99                                 rel_collision_map
 100                                 rel_name_map
 101                                 real_dump_directory
 102                                 result_components_map
 103                                 result_roles_map
 104                                 datetime_undef_if_invalid
 105                                 _result_class_methods
 106                                 naming_set
 107                                 filter_generated_code
 108                                 db_schema
 109                                 qualify_objects
 110                                 moniker_parts
 111 /);
 112
 113 my $CURRENT_V = 'v7';
 114
 115 my @CLASS_ARGS = qw(
 116     schema_components schema_base_class result_base_class
 117     additional_base_classes left_base_classes additional_classes components
 118     result_roles
 119 );
 120
 121 my $CR   = "\x0d";
 122 my $LF   = "\x0a";
 123 my $CRLF = "\x0d\x0a";
 124
 125 =head1 NAME
 126
 127 DBIx::Class::Schema::Loader::Base - Base DBIx::Class::Schema::Loader Implementation.
 128
 129 =head1 SYNOPSIS
 130
 131 See L<DBIx::Class::Schema::Loader>.
 132
 133 =head1 DESCRIPTION
 134
 135 This is the base class for the storage-specific C<DBIx::Class::Schema::*>
 136 classes, and implements the common functionality between them.
 137
 138 =head1 CONSTRUCTOR OPTIONS
 139
 140 These constructor options are the base options for
 141 L<DBIx::Class::Schema::Loader/loader_options>.  Available constructor options are:
 142
 143 =head2 skip_relationships
 144
 145 Skip setting up relationships.  The default is to attempt the loading
 146 of relationships.
 147
 148 =head2 skip_load_external
 149
 150 Skip loading of other classes in @INC. The default is to merge all other classes
 151 with the same name found in @INC into the schema file we are creating.
 152
 153 =head2 naming
 154
 155 Static schemas (ones dumped to disk) will, by default, use the new-style
 156 relationship names and singularized Results, unless you're overwriting an
 157 existing dump made by an older version of L<DBIx::Class::Schema::Loader>, in
 158 which case the backward compatible RelBuilder will be activated, and the
 159 appropriate monikerization used.
 160
 161 Specifying
 162
 163     naming => 'current'
 164
 165 will disable the backward-compatible RelBuilder and use
 166 the new-style relationship names along with singularized Results, even when
 167 overwriting a dump made with an earlier version.
 168
 169 The option also takes a hashref:
 170
 171     naming => {
 172         relationships    => 'v8',
 173         monikers         => 'v8',
 174         column_accessors => 'v8',
 175         force_ascii      => 1,
 176     }
 177
 178 or
 179
 180     naming => { ALL => 'v8', force_ascii => 1 }
 181
 182 The keys are:
 183
 184 =over 4
 185
 186 =item ALL
 187
 188 Set L</relationships>, L</monikers> and L</column_accessors> to the specified
 189 value.
 190
 191 =item relationships
 192
 193 How to name relationship accessors.
 194
 195 =item monikers
 196
 197 How to name Result classes.
 198
 199 =item column_accessors
 200
 201 How to name column accessors in Result classes.
 202
 203 =item force_ascii
 204
 205 For L</v8> mode and later, uses L<String::ToIdentifier::EN> instead of
 206 L<String::ToIdentifier::EM::Unicode> to force monikers and other identifiers to
 207 ASCII.
 208
 209 =back
 210
 211 The values can be:
 212
 213 =over 4
 214
 215 =item current
 216
 217 Latest style, whatever that happens to be.
 218
 219 =item v4
 220
 221 Unsingularlized monikers, C<has_many> only relationships with no _id stripping.
 222
 223 =item v5
 224
 225 Monikers singularized as whole words, C<might_have> relationships for FKs on
 226 C<UNIQUE> constraints, C<_id> stripping for belongs_to relationships.
 227
 228 Some of the C<_id> stripping edge cases in C<0.05003> have been reverted for
 229 the v5 RelBuilder.
 230
 231 =item v6
 232
 233 All monikers and relationships are inflected using
 234 L<Lingua::EN::Inflect::Phrase>, and there is more aggressive C<_id> stripping
 235 from relationship names.
 236
 237 In general, there is very little difference between v5 and v6 schemas.
 238
 239 =item v7
 240
 241 This mode is identical to C<v6> mode, except that monikerization of CamelCase
 242 table names is also done correctly.
 243
 244 CamelCase column names in case-preserving mode will also be handled correctly
 245 for relationship name inflection. See L</preserve_case>.
 246
 247 In this mode, CamelCase L</column_accessors> are normalized based on case
 248 transition instead of just being lowercased, so C<FooId> becomes C<foo_id>.
 249
 250 If you don't have any CamelCase table or column names, you can upgrade without
 251 breaking any of your code.
 252
 253 =item v8
 254
 255 (EXPERIMENTAL)
 256
 257 The default mode is L</v7>, to get L</v8> mode, you have to specify it in
 258 L</naming> explictly until C<0.08> comes out.
 259
 260 L</monikers> and L</column_accessors> are created using
 261 L<String::ToIdentifier::EN::Unicode> or L<String::ToIdentifier::EN> if
 262 L</force_ascii> is set; this is only significant for names with non-C<\w>
 263 characters such as C<.>.
 264
 265 CamelCase identifiers with words in all caps, e.g. C<VLANValidID> are supported
 266 correctly in this mode.
 267
 268 For relationships, belongs_to accessors are made from column names by stripping
 269 postfixes other than C<_id> as well, for example just C<Id>, C<_?ref>, C<_?cd>,
 270 C<_?code> and C<_?num>, case insensitively.
 271
 272 =item preserve
 273
 274 For L</monikers>, this option does not inflect the table names but makes
 275 monikers based on the actual name. For L</column_accessors> this option does
 276 not normalize CamelCase column names to lowercase column accessors, but makes
 277 accessors that are the same names as the columns (with any non-\w chars
 278 replaced with underscores.)
 279
 280 =item singular
 281
 282 For L</monikers>, singularizes the names using the most current inflector. This
 283 is the same as setting the option to L</current>.
 284
 285 =item plural
 286
 287 For L</monikers>, pluralizes the names, using the most current inflector.
 288
 289 =back
 290
 291 Dynamic schemas will always default to the 0.04XXX relationship names and won't
 292 singularize Results for backward compatibility, to activate the new RelBuilder
 293 and singularization put this in your C<Schema.pm> file:
 294
 295     __PACKAGE__->naming('current');
 296
 297 Or if you prefer to use 0.07XXX features but insure that nothing breaks in the
 298 next major version upgrade:
 299
 300     __PACKAGE__->naming('v7');
 301
 302 =head2 quiet
 303
 304 If true, will not print the usual C<Dumping manual schema ... Schema dump
 305 completed.> messages. Does not affect warnings (except for warnings related to
 306 L</really_erase_my_files>.)
 307
 308 =head2 generate_pod
 309
 310 By default POD will be generated for columns and relationships, using database
 311 metadata for the text if available and supported.
 312
 313 Comment metadata can be stored in two ways.
 314
 315 The first is that you can create two tables named C<table_comments> and
 316 C<column_comments> respectively. These tables must exist in the same database
 317 and schema as the tables they describe. They both need to have columns named
 318 C<table_name> and C<comment_text>. The second one needs to have a column named
 319 C<column_name>. Then data stored in these tables will be used as a source of
 320 metadata about tables and comments.
 321
 322 (If you wish you can change the name of these tables with the parameters
 323 L</table_comments_table> and L</column_comments_table>.)
 324
 325 As a fallback you can use built-in commenting mechanisms.  Currently this is
 326 only supported for PostgreSQL, Oracle and MySQL.  To create comments in
 327 PostgreSQL you add statements of the form C<COMMENT ON TABLE some_table IS
 328 '...'>, the same syntax is used in Oracle. To create comments in MySQL you add
 329 C<COMMENT '...'> to the end of the column or table definition.  Note that MySQL
 330 restricts the length of comments, and also does not handle complex Unicode
 331 characters properly.
 332
 333 Set this to C<0> to turn off all POD generation.
 334
 335 =head2 pod_comment_mode
 336
 337 Controls where table comments appear in the generated POD. Smaller table
 338 comments are appended to the C<NAME> section of the documentation, and larger
 339 ones are inserted into C<DESCRIPTION> instead. You can force a C<DESCRIPTION>
 340 section to be generated with the comment always, only use C<NAME>, or choose
 341 the length threshold at which the comment is forced into the description.
 342
 343 =over 4
 344
 345 =item name
 346
 347 Use C<NAME> section only.
 348
 349 =item description
 350
 351 Force C<DESCRIPTION> always.
 352
 353 =item auto
 354
 355 Use C<DESCRIPTION> if length > L</pod_comment_spillover_length>, this is the
 356 default.
 357
 358 =back
 359
 360 =head2 pod_comment_spillover_length
 361
 362 When pod_comment_mode is set to C<auto>, this is the length of the comment at
 363 which it will be forced into a separate description section.
 364
 365 The default is C<60>
 366
 367 =head2 table_comments_table
 368
 369 The table to look for comments about tables in.  By default C<table_comments>.
 370 See L</generate_pod> for details.
 371
 372 This must not be a fully qualified name, the table will be looked for in the
 373 same database and schema as the table whose comment is being retrieved.
 374
 375 =head2 column_comments_table
 376
 377 The table to look for comments about columns in.  By default C<column_comments>.
 378 See L</generate_pod> for details.
 379
 380 This must not be a fully qualified name, the table will be looked for in the
 381 same database and schema as the table/column whose comment is being retrieved.
 382
 383 =head2 relationship_attrs
 384
 385 Hashref of attributes to pass to each generated relationship, listed
 386 by type.  Also supports relationship type 'all', containing options to
 387 pass to all generated relationships.  Attributes set for more specific
 388 relationship types override those set in 'all'.
 389
 390 For example:
 391
 392   relationship_attrs => {
 393     belongs_to => { is_deferrable => 0 },
 394   },
 395
 396 use this to turn off DEFERRABLE on your foreign key constraints.
 397
 398 =head2 debug
 399
 400 If set to true, each constructive L<DBIx::Class> statement the loader
 401 decides to execute will be C<warn>-ed before execution.
 402
 403 =head2 db_schema
 404
 405 Set the name of the schema to load (schema in the sense that your database
 406 vendor means it).
 407
 408 Can be set to an arrayref of schema names for multiple schemas, or the special
 409 value C<%> for all schemas.
 410
 411 For MSSQL, Sybase ASE, and Informix can be set to a hashref of databases as
 412 keys and arrays of owners as values, set to the value:
 413
 414     { '%' => '%' }
 415
 416 for all owners in all databases.
 417
 418 You may need to control naming of monikers with L</moniker_parts> if you have
 419 name clashes for tables in different schemas/databases.
 420
 421 =head2 moniker_parts
 422
 423 The database table names are represented by the
 424 L<DBIx::Class::Schema::Loader::Table> class in the loader, the
 425 L<DBIx::Class::Schema::Loader::Table::Sybase> class for Sybase ASE and
 426 L<DBIx::Class::Schema::Loader::Table::Informix> for Informix.
 427
 428 Monikers are created normally based on just the
 429 L<name|DBIx::Class::Schema::Loader::DBObject/name> property, corresponding to
 430 the table name, but can consist of other parts of the fully qualified name of
 431 the table.
 432
 433 The L</moniker_parts> option is an arrayref of methods on the table class
 434 corresponding to parts of the fully qualified table name, defaulting to
 435 C<['name']>, in the order those parts are used to create the moniker name.
 436
 437 The C<'name'> entry B<must> be present.
 438
 439 Below is a table of supported databases and possible L</moniker_parts>.
 440
 441 =over 4
 442
 443 =item * DB2, Firebird, mysql, Oracle, Pg, SQLAnywhere, SQLite, MS Access
 444
 445 C<schema>, C<name>
 446
 447 =item * Informix, MSSQL, Sybase ASE
 448
 449 C<database>, C<schema>, C<name>
 450
 451 =back
 452
 453 =head2 constraint
 454
 455 Only load tables matching regex.  Best specified as a qr// regex.
 456
 457 =head2 exclude
 458
 459 Exclude tables matching regex.  Best specified as a qr// regex.
 460
 461 =head2 moniker_map
 462
 463 Overrides the default table name to moniker translation.  Can be either a
 464 hashref of table keys and moniker values, or a coderef for a translator
 465 function taking a L<table object|DBIx::Class::Schema::Loader::Table> argument
 466 and returning a scalar moniker.  If the hash entry does not exist, or the
 467 function returns a false value, the code falls back to default behavior for
 468 that table name.
 469
 470 The default behavior is to split on case transition and non-alphanumeric
 471 boundaries, singularize the resulting phrase, then join the titlecased words
 472 together. Examples:
 473
 474     Table Name       | Moniker Name
 475     ---------------------------------
 476     luser            | Luser
 477     luser_group      | LuserGroup
 478     luser-opts       | LuserOpt
 479     stations_visited | StationVisited
 480     routeChange      | RouteChange
 481
 482 =head2 col_accessor_map
 483
 484 Same as moniker_map, but for column accessor names.  If a coderef is
 485 passed, the code is called with arguments of
 486
 487    the name of the column in the underlying database,
 488    default accessor name that DBICSL would ordinarily give this column,
 489    {
 490       table_class     => name of the DBIC class we are building,
 491       table_moniker   => calculated moniker for this table (after moniker_map if present),
 492       table           => table object of interface DBIx::Class::Schema::Loader::Table,
 493       full_table_name => schema-qualified name of the database table (RDBMS specific),
 494       schema_class    => name of the schema class we are building,
 495       column_info     => hashref of column info (data_type, is_nullable, etc),
 496     }
 497
 498 =head2 rel_name_map
 499
 500 Similar in idea to moniker_map, but different in the details.  It can be
 501 a hashref or a code ref.
 502
 503 If it is a hashref, keys can be either the default relationship name, or the
 504 moniker. The keys that are the default relationship name should map to the
 505 name you want to change the relationship to. Keys that are monikers should map
 506 to hashes mapping relationship names to their translation.  You can do both at
 507 once, and the more specific moniker version will be picked up first.  So, for
 508 instance, you could have
 509
 510     {
 511         bar => "baz",
 512         Foo => {
 513             bar => "blat",
 514         },
 515     }
 516
 517 and relationships that would have been named C<bar> will now be named C<baz>
 518 except that in the table whose moniker is C<Foo> it will be named C<blat>.
 519
 520 If it is a coderef, the argument passed will be a hashref of this form:
 521
 522     {
 523         name           => default relationship name,
 524         type           => the relationship type eg: C<has_many>,
 525         local_class    => name of the DBIC class we are building,
 526         local_moniker  => moniker of the DBIC class we are building,
 527         local_columns  => columns in this table in the relationship,
 528         remote_class   => name of the DBIC class we are related to,
 529         remote_moniker => moniker of the DBIC class we are related to,
 530         remote_columns => columns in the other table in the relationship,
 531     }
 532
 533 DBICSL will try to use the value returned as the relationship name.
 534
 535 =head2 inflect_plural
 536
 537 Just like L</moniker_map> above (can be hash/code-ref, falls back to default
 538 if hash key does not exist or coderef returns false), but acts as a map
 539 for pluralizing relationship names.  The default behavior is to utilize
 540 L<Lingua::EN::Inflect::Phrase/to_PL>.
 541
 542 =head2 inflect_singular
 543
 544 As L</inflect_plural> above, but for singularizing relationship names.
 545 Default behavior is to utilize L<Lingua::EN::Inflect::Phrase/to_S>.
 546
 547 =head2 schema_base_class
 548
 549 Base class for your schema classes. Defaults to 'DBIx::Class::Schema'.
 550
 551 =head2 schema_components
 552
 553 List of components to load into the Schema class.
 554
 555 =head2 result_base_class
 556
 557 Base class for your table classes (aka result classes). Defaults to
 558 'DBIx::Class::Core'.
 559
 560 =head2 additional_base_classes
 561
 562 List of additional base classes all of your table classes will use.
 563
 564 =head2 left_base_classes
 565
 566 List of additional base classes all of your table classes will use
 567 that need to be leftmost.
 568
 569 =head2 additional_classes
 570
 571 List of additional classes which all of your table classes will use.
 572
 573 =head2 components
 574
 575 List of additional components to be loaded into all of your Result
 576 classes.  A good example would be
 577 L<InflateColumn::DateTime|DBIx::Class::InflateColumn::DateTime>
 578
 579 =head2 result_components_map
 580
 581 A hashref of moniker keys and component values.  Unlike L</components>, which
 582 loads the given components into every Result class, this option allows you to
 583 load certain components for specified Result classes. For example:
 584
 585   result_components_map => {
 586       StationVisited => '+YourApp::Schema::Component::StationVisited',
 587       RouteChange    => [
 588                             '+YourApp::Schema::Component::RouteChange',
 589                             'InflateColumn::DateTime',
 590                         ],
 591   }
 592
 593 You may use this in conjunction with L</components>.
 594
 595 =head2 result_roles
 596
 597 List of L<Moose> roles to be applied to all of your Result classes.
 598
 599 =head2 result_roles_map
 600
 601 A hashref of moniker keys and role values.  Unlike L</result_roles>, which
 602 applies the given roles to every Result class, this option allows you to apply
 603 certain roles for specified Result classes. For example:
 604
 605   result_roles_map => {
 606       StationVisited => [
 607                             'YourApp::Role::Building',
 608                             'YourApp::Role::Destination',
 609                         ],
 610       RouteChange    => 'YourApp::Role::TripEvent',
 611   }
 612
 613 You may use this in conjunction with L</result_roles>.
 614
 615 =head2 use_namespaces
 616
 617 This is now the default, to go back to L<DBIx::Class::Schema/load_classes> pass
 618 a C<0>.
 619
 620 Generate result class names suitable for
 621 L<DBIx::Class::Schema/load_namespaces> and call that instead of
 622 L<DBIx::Class::Schema/load_classes>. When using this option you can also
 623 specify any of the options for C<load_namespaces> (i.e. C<result_namespace>,
 624 C<resultset_namespace>, C<default_resultset_class>), and they will be added
 625 to the call (and the generated result class names adjusted appropriately).
 626
 627 =head2 dump_directory
 628
 629 The value of this option is a perl libdir pathname.  Within
 630 that directory this module will create a baseline manual
 631 L<DBIx::Class::Schema> module set, based on what it creates at runtime.
 632
 633 The created schema class will have the same classname as the one on
 634 which you are setting this option (and the ResultSource classes will be
 635 based on this name as well).
 636
 637 Normally you wouldn't hard-code this setting in your schema class, as it
 638 is meant for one-time manual usage.
 639
 640 See L<DBIx::Class::Schema::Loader/dump_to_dir> for examples of the
 641 recommended way to access this functionality.
 642
 643 =head2 dump_overwrite
 644
 645 Deprecated.  See L</really_erase_my_files> below, which does *not* mean
 646 the same thing as the old C<dump_overwrite> setting from previous releases.
 647
 648 =head2 really_erase_my_files
 649
 650 Default false.  If true, Loader will unconditionally delete any existing
 651 files before creating the new ones from scratch when dumping a schema to disk.
 652
 653 The default behavior is instead to only replace the top portion of the
 654 file, up to and including the final stanza which contains
 655 C<# DO NOT MODIFY THE FIRST PART OF THIS FILE>
 656 leaving any customizations you placed after that as they were.
 657
 658 When C<really_erase_my_files> is not set, if the output file already exists,
 659 but the aforementioned final stanza is not found, or the checksum
 660 contained there does not match the generated contents, Loader will
 661 croak and not touch the file.
 662
 663 You should really be using version control on your schema classes (and all
 664 of the rest of your code for that matter).  Don't blame me if a bug in this
 665 code wipes something out when it shouldn't have, you've been warned.
 666
 667 =head2 overwrite_modifications
 668
 669 Default false.  If false, when updating existing files, Loader will
 670 refuse to modify any Loader-generated code that has been modified
 671 since its last run (as determined by the checksum Loader put in its
 672 comment lines).
 673
 674 If true, Loader will discard any manual modifications that have been
 675 made to Loader-generated code.
 676
 677 Again, you should be using version control on your schema classes.  Be
 678 careful with this option.
 679
 680 =head2 custom_column_info
 681
 682 Hook for adding extra attributes to the
 683 L<column_info|DBIx::Class::ResultSource/column_info> for a column.
 684
 685 Must be a coderef that returns a hashref with the extra attributes.
 686
 687 Receives the L<table object|DBIx::Class::Schema::Loader::Table>, column name
 688 and column_info.
 689
 690 For example:
 691
 692   custom_column_info => sub {
 693       my ($table, $column_name, $column_info) = @_;
 694
 695       if ($column_name eq 'dog' && $column_info->{default_value} eq 'snoopy') {
 696           return { is_snoopy => 1 };
 697       }
 698   },
 699
 700 This attribute can also be used to set C<inflate_datetime> on a non-datetime
 701 column so it also receives the L</datetime_timezone> and/or L</datetime_locale>.
 702
 703 =head2 datetime_timezone
 704
 705 Sets the timezone attribute for L<DBIx::Class::InflateColumn::DateTime> for all
 706 columns with the DATE/DATETIME/TIMESTAMP data_types.
 707
 708 =head2 datetime_locale
 709
 710 Sets the locale attribute for L<DBIx::Class::InflateColumn::DateTime> for all
 711 columns with the DATE/DATETIME/TIMESTAMP data_types.
 712
 713 =head2 datetime_undef_if_invalid
 714
 715 Pass a C<0> for this option when using MySQL if you B<DON'T> want C<<
 716 datetime_undef_if_invalid => 1 >> in your column info for DATE, DATETIME and
 717 TIMESTAMP columns.
 718
 719 The default is recommended to deal with data such as C<00/00/00> which
 720 sometimes ends up in such columns in MySQL.
 721
 722 =head2 config_file
 723
 724 File in Perl format, which should return a HASH reference, from which to read
 725 loader options.
 726
 727 =head2 preserve_case
 728
 729 Normally database names are lowercased and split by underscore, use this option
 730 if you have CamelCase database names.
 731
 732 Drivers for case sensitive databases like Sybase ASE or MSSQL with a
 733 case-sensitive collation will turn this option on unconditionally.
 734
 735 B<NOTE:> L</naming> = C<v8> is highly recommended with this option as the
 736 semantics of this mode are much improved for CamelCase database names.
 737
 738 L</naming> = C<v7> or greater is required with this option.
 739
 740 =head2 qualify_objects
 741
 742 Set to true to prepend the L</db_schema> to table names for C<<
 743 __PACKAGE__->table >> calls, and to some other things like Oracle sequences.
 744
 745 This attribute is automatically set to true for multi db_schema configurations.
 746
 747 =head2 use_moose
 748
 749 Creates Schema and Result classes that use L<Moose>, L<MooseX::NonMoose> and
 750 L<MooseX::MarkAsMethods> (or L<namespace::autoclean>, see below). The default
 751 content after the md5 sum also makes the classes immutable.
 752
 753 It is safe to upgrade your existing Schema to this option.
 754
 755 =head2 only_autoclean
 756
 757 By default, we use L<MooseX::MarkAsMethods> to remove imported functions from
 758 your generated classes.  It uses L<namespace::autoclean> to do this, after
 759 telling your object's metaclass that any operator L<overload>s in your class
 760 are methods, which will cause namespace::autoclean to spare them from removal.
 761
 762 This prevents the "Hey, where'd my overloads go?!" effect.
 763
 764 If you don't care about operator overloads, enabling this option falls back to
 765 just using L<namespace::autoclean> itself.
 766
 767 If none of the above made any sense, or you don't have some pressing need to
 768 only use L<namespace::autoclean>, leaving this set to the default is
 769 recommended.
 770
 771 =head2 col_collision_map
 772
 773 This option controls how accessors for column names which collide with perl
 774 methods are named. See L</COLUMN ACCESSOR COLLISIONS> for more information.
 775
 776 This option takes either a single L<sprintf|perlfunc/sprintf> format or a hashref of
 777 strings which are compiled to regular expressions that map to
 778 L<sprintf|perlfunc/sprintf> formats.
 779
 780 Examples:
 781
 782     col_collision_map => 'column_%s'
 783
 784     col_collision_map => { '(.*)' => 'column_%s' }
 785
 786     col_collision_map => { '(foo).*(bar)' => 'column_%s_%s' }
 787
 788 =head2 rel_collision_map
 789
 790 Works just like L</col_collision_map>, but for relationship names/accessors
 791 rather than column names/accessors.
 792
 793 The default is to just append C<_rel> to the relationship name, see
 794 L</RELATIONSHIP NAME COLLISIONS>.
 795
 796 =head2 uniq_to_primary
 797
 798 Automatically promotes the largest unique constraints with non-nullable columns
 799 on tables to primary keys, assuming there is only one largest unique
 800 constraint.
 801
 802 =head2 filter_generated_code
 803
 804 An optional hook that lets you filter the generated text for various classes
 805 through a function that change it in any way that you want.  The function will
 806 receive the type of file, C<schema> or C<result>, class and code; and returns
 807 the new code to use instead.  For instance you could add custom comments, or do
 808 anything else that you want.
 809
 810 The option can also be set to a string, which is then used as a filter program,
 811 e.g. C<perltidy>.
 812
 813 If this exists but fails to return text matching C</\bpackage\b/>, no file will
 814 be generated.
 815
 816     filter_generated_code => sub {
 817         my ($type, $class, $text) = @_;
 818         ...
 819         return $new_code;
 820     }
 821
 822 =head1 METHODS
 823
 824 None of these methods are intended for direct invocation by regular
 825 users of L<DBIx::Class::Schema::Loader>. Some are proxied via
 826 L<DBIx::Class::Schema::Loader>.
 827
 828 =cut
 829
 830 # ensure that a peice of object data is a valid arrayref, creating
 831 # an empty one or encapsulating whatever's there.
 832 sub _ensure_arrayref {
 833     my $self = shift;
 834
 835     foreach (@_) {
 836         $self->{$_} ||= [];
 837         $self->{$_} = [ $self->{$_} ]
 838             unless ref $self->{$_} eq 'ARRAY';
 839     }
 840 }
 841
 842 =head2 new
 843
 844 Constructor for L<DBIx::Class::Schema::Loader::Base>, used internally
 845 by L<DBIx::Class::Schema::Loader>.
 846
 847 =cut
 848
 849 sub new {
 850     my ( $class, %args ) = @_;
 851
 852     if (exists $args{column_accessor_map}) {
 853         $args{col_accessor_map} = delete $args{column_accessor_map};
 854     }
 855
 856     my $self = { %args };
 857
 858     # don't lose undef options
 859     for (values %$self) {
 860         $_ = 0 unless defined $_;
 861     }
 862
 863     bless $self => $class;
 864
 865     if (my $config_file = $self->config_file) {
 866         my $config_opts = do $config_file;
 867
 868         croak "Error reading config from $config_file: $@" if $@;
 869
 870         croak "Config file $config_file must be a hashref" unless ref($config_opts) eq 'HASH';
 871
 872         while (my ($k, $v) = each %$config_opts) {
 873             $self->{$k} = $v unless exists $self->{$k};
 874         }
 875     }
 876
 877     if (defined $self->{result_component_map}) {
 878         if (defined $self->result_components_map) {
 879             croak "Specify only one of result_components_map or result_component_map";
 880         }
 881         $self->result_components_map($self->{result_component_map})
 882     }
 883
 884     if (defined $self->{result_role_map}) {
 885         if (defined $self->result_roles_map) {
 886             croak "Specify only one of result_roles_map or result_role_map";
 887         }
 888         $self->result_roles_map($self->{result_role_map})
 889     }
 890
 891     croak "the result_roles and result_roles_map options may only be used in conjunction with use_moose=1"
 892         if ((not defined $self->use_moose) || (not $self->use_moose))
 893             && ((defined $self->result_roles) || (defined $self->result_roles_map));
 894
 895     $self->_ensure_arrayref(qw/schema_components
 896                                additional_classes
 897                                additional_base_classes
 898                                left_base_classes
 899                                components
 900                                result_roles
 901                               /);
 902
 903     $self->_validate_class_args;
 904
 905     croak "result_components_map must be a hash"
 906         if defined $self->result_components_map
 907             && ref $self->result_components_map ne 'HASH';
 908
 909     if ($self->result_components_map) {
 910         my %rc_map = %{ $self->result_components_map };
 911         foreach my $moniker (keys %rc_map) {
 912             $rc_map{$moniker} = [ $rc_map{$moniker} ] unless ref $rc_map{$moniker};
 913         }
 914         $self->result_components_map(\%rc_map);
 915     }
 916     else {
 917         $self->result_components_map({});
 918     }
 919     $self->_validate_result_components_map;
 920
 921     croak "result_roles_map must be a hash"
 922         if defined $self->result_roles_map
 923             && ref $self->result_roles_map ne 'HASH';
 924
 925     if ($self->result_roles_map) {
 926         my %rr_map = %{ $self->result_roles_map };
 927         foreach my $moniker (keys %rr_map) {
 928             $rr_map{$moniker} = [ $rr_map{$moniker} ] unless ref $rr_map{$moniker};
 929         }
 930         $self->result_roles_map(\%rr_map);
 931     } else {
 932         $self->result_roles_map({});
 933     }
 934     $self->_validate_result_roles_map;
 935
 936     if ($self->use_moose) {
 937         if (not DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose')) {
 938             die sprintf "You must install the following CPAN modules to enable the use_moose option: %s.\n",
 939                 DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('use_moose');
 940         }
 941     }
 942
 943     $self->{_tables} = {};
 944     $self->{monikers} = {};
 945     $self->{moniker_to_table} = {};
 946     $self->{class_to_table} = {};
 947     $self->{classes}  = {};
 948     $self->{_upgrading_classes} = {};
 949
 950     $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
 951     $self->{schema} ||= $self->{schema_class};
 952     $self->{table_comments_table} ||= 'table_comments';
 953     $self->{column_comments_table} ||= 'column_comments';
 954
 955     croak "dump_overwrite is deprecated.  Please read the"
 956         . " DBIx::Class::Schema::Loader::Base documentation"
 957             if $self->{dump_overwrite};
 958
 959     $self->{dynamic} = ! $self->{dump_directory};
 960     $self->{temp_directory} ||= File::Temp::tempdir( 'dbicXXXX',
 961                                                      TMPDIR  => 1,
 962                                                      CLEANUP => 1,
 963                                                    );
 964
 965     $self->{dump_directory} ||= $self->{temp_directory};
 966
 967     $self->real_dump_directory($self->{dump_directory});
 968
 969     $self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
 970     $self->schema_version_to_dump($DBIx::Class::Schema::Loader::VERSION);
 971
 972     if (not defined $self->naming) {
 973         $self->naming_set(0);
 974     }
 975     else {
 976         $self->naming_set(1);
 977     }
 978
 979     if ((not ref $self->naming) && defined $self->naming) {
 980         my $naming_ver = $self->naming;
 981         $self->{naming} = {
 982             relationships => $naming_ver,
 983             monikers => $naming_ver,
 984             column_accessors => $naming_ver,
 985         };
 986     }
 987     elsif (ref $self->naming eq 'HASH' && exists $self->naming->{ALL}) {
 988         my $val = delete $self->naming->{ALL};
 989
 990         $self->naming->{$_} = $val
 991             foreach qw/relationships monikers column_accessors/;
 992     }
 993
 994     if ($self->naming) {
 995         foreach my $key (qw/relationships monikers column_accessors/) {
 996             $self->naming->{$key} = $CURRENT_V if ($self->naming->{$key}||'') eq 'current';
 997         }
 998     }
 999     $self->{naming} ||= {};
1000
1001     if ($self->custom_column_info && ref $self->custom_column_info ne 'CODE') {
1002         croak 'custom_column_info must be a CODE ref';
1003     }
1004
1005     $self->_check_back_compat;
1006
1007     $self->use_namespaces(1) unless defined $self->use_namespaces;
1008     $self->generate_pod(1)   unless defined $self->generate_pod;
1009     $self->pod_comment_mode('auto')         unless defined $self->pod_comment_mode;
1010     $self->pod_comment_spillover_length(60) unless defined $self->pod_comment_spillover_length;
1011
1012     if (my $col_collision_map = $self->col_collision_map) {
1013         if (my $reftype = ref $col_collision_map) {
1014             if ($reftype ne 'HASH') {
1015                 croak "Invalid type $reftype for option 'col_collision_map'";
1016             }
1017         }
1018         else {
1019             $self->col_collision_map({ '(.*)' => $col_collision_map });
1020         }
1021     }
1022
1023     if (my $rel_collision_map = $self->rel_collision_map) {
1024         if (my $reftype = ref $rel_collision_map) {
1025             if ($reftype ne 'HASH') {
1026                 croak "Invalid type $reftype for option 'rel_collision_map'";
1027             }
1028         }
1029         else {
1030             $self->rel_collision_map({ '(.*)' => $rel_collision_map });
1031         }
1032     }
1033
1034     if (defined(my $rel_name_map = $self->rel_name_map)) {
1035         my $reftype = ref $rel_name_map;
1036         if ($reftype ne 'HASH' && $reftype ne 'CODE') {
1037             croak "Invalid type $reftype for option 'rel_name_map', must be HASH or CODE";
1038         }
1039     }
1040
1041     if (defined(my $filter = $self->filter_generated_code)) {
1042         my $reftype = ref $filter;
1043         if ($reftype && $reftype ne 'CODE') {
1044             croak "Invalid type $reftype for option 'filter_generated_code, must be a scalar or a CODE reference";
1045         }
1046     }
1047
1048     if (defined $self->db_schema) {
1049         if (ref $self->db_schema eq 'ARRAY') {
1050             if (@{ $self->db_schema } > 1) {
1051                 $self->{qualify_objects} = 1;
1052             }
1053             elsif (@{ $self->db_schema } == 0) {
1054                 $self->{db_schema} = undef;
1055             }
1056         }
1057         elsif (not ref $self->db_schema) {
1058             if ($self->db_schema eq '%') {
1059                 $self->{qualify_objects} = 1;
1060             }
1061
1062             $self->{db_schema} = [ $self->db_schema ];
1063         }
1064     }
1065
1066     if (not $self->moniker_parts) {
1067         $self->moniker_parts(['name']);
1068     }
1069     else {
1070         if (not ref $self->moniker_parts) {
1071             $self->moniker_parts([ $self->moniker_parts ]);
1072         }
1073         if (ref $self->moniker_parts ne 'ARRAY') {
1074             croak 'moniker_parts must be an arrayref';
1075         }
1076         if ((firstidx { $_ eq 'name' } @{ $self->moniker_parts }) == -1) {
1077             croak "moniker_parts option *must* contain 'name'";
1078         }
1079     }
1080
1081     return $self;
1082 }
1083
1084 sub _check_back_compat {
1085     my ($self) = @_;
1086
1087 # dynamic schemas will always be in 0.04006 mode, unless overridden
1088     if ($self->dynamic) {
1089 # just in case, though no one is likely to dump a dynamic schema
1090         $self->schema_version_to_dump('0.04006');
1091
1092         if (not $self->naming_set) {
1093             warn <<EOF unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
1094
1095 Dynamic schema detected, will run in 0.04006 mode.
1096
1097 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
1098 to disable this warning.
1099
1100 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
1101 details.
1102 EOF
1103         }
1104         else {
1105             $self->_upgrading_from('v4');
1106         }
1107
1108         if ((not defined $self->use_namespaces) && ($self->naming_set)) {
1109             $self->use_namespaces(1);
1110         }
1111
1112         $self->naming->{relationships} ||= 'v4';
1113         $self->naming->{monikers}      ||= 'v4';
1114
1115         if ($self->use_namespaces) {
1116             $self->_upgrading_from_load_classes(1);
1117         }
1118         else {
1119             $self->use_namespaces(0);
1120         }
1121
1122         return;
1123     }
1124
1125 # otherwise check if we need backcompat mode for a static schema
1126     my $filename = $self->get_dump_filename($self->schema_class);
1127     return unless -e $filename;
1128
1129     my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom) =
1130       $self->_parse_generated_file($filename);
1131
1132     return unless $old_ver;
1133
1134     # determine if the existing schema was dumped with use_moose => 1
1135     if (! defined $self->use_moose) {
1136         $self->{use_moose} = 1 if $old_gen =~ /^ (?!\s*\#) use \s+ Moose/xm;
1137     }
1138
1139     my $load_classes = ($old_gen =~ /^__PACKAGE__->load_classes;/m) ? 1 : 0;
1140
1141     my $result_namespace = do { ($old_gen =~ /result_namespace => (.+)/) ? $1 : '' };
1142     my $ds = eval $result_namespace;
1143     die <<"EOF" if $@;
1144 Could not eval expression '$result_namespace' for result_namespace from
1145 $filename: $@
1146 EOF
1147     $result_namespace = $ds || '';
1148
1149     if ($load_classes && (not defined $self->use_namespaces)) {
1150         warn <<"EOF"  unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
1151
1152 'load_classes;' static schema detected, turning off 'use_namespaces'.
1153
1154 Set the 'use_namespaces' attribute or the SCHEMA_LOADER_BACKCOMPAT environment
1155 variable to disable this warning.
1156
1157 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
1158 details.
1159 EOF
1160         $self->use_namespaces(0);
1161     }
1162     elsif ($load_classes && $self->use_namespaces) {
1163         $self->_upgrading_from_load_classes(1);
1164     }
1165     elsif ((not $load_classes) && defined $self->use_namespaces && ! $self->use_namespaces) {
1166         $self->_downgrading_to_load_classes(
1167             $result_namespace || 'Result'
1168         );
1169     }
1170     elsif ((not defined $self->use_namespaces) || $self->use_namespaces) {
1171         if (not $self->result_namespace) {
1172             $self->result_namespace($result_namespace || 'Result');
1173         }
1174         elsif ($result_namespace ne $self->result_namespace) {
1175             $self->_rewriting_result_namespace(
1176                 $result_namespace || 'Result'
1177             );
1178         }
1179     }
1180
1181     # XXX when we go past .0 this will need fixing
1182     my ($v) = $old_ver =~ /([1-9])/;
1183     $v = "v$v";
1184
1185     return if ($v eq $CURRENT_V || $old_ver =~ /^0\.\d\d999/);
1186
1187     if (not %{ $self->naming }) {
1188         warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
1189
1190 Version $old_ver static schema detected, turning on backcompat mode.
1191
1192 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
1193 to disable this warning.
1194
1195 See: 'naming' in perldoc DBIx::Class::Schema::Loader::Base .
1196
1197 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 if upgrading
1198 from version 0.04006.
1199 EOF
1200
1201         $self->naming->{relationships}    ||= $v;
1202         $self->naming->{monikers}         ||= $v;
1203         $self->naming->{column_accessors} ||= $v;
1204
1205         $self->schema_version_to_dump($old_ver);
1206     }
1207     else {
1208         $self->_upgrading_from($v);
1209     }
1210 }
1211
1212 sub _validate_class_args {
1213     my $self = shift;
1214
1215     foreach my $k (@CLASS_ARGS) {
1216         next unless $self->$k;
1217
1218         my @classes = ref $self->$k eq 'ARRAY' ? @{ $self->$k } : $self->$k;
1219         $self->_validate_classes($k, \@classes);
1220     }
1221 }
1222
1223 sub _validate_result_components_map {
1224     my $self = shift;
1225
1226     foreach my $classes (values %{ $self->result_components_map }) {
1227         $self->_validate_classes('result_components_map', $classes);
1228     }
1229 }
1230
1231 sub _validate_result_roles_map {
1232     my $self = shift;
1233
1234     foreach my $classes (values %{ $self->result_roles_map }) {
1235         $self->_validate_classes('result_roles_map', $classes);
1236     }
1237 }
1238
1239 sub _validate_classes {
1240     my $self = shift;
1241     my $key  = shift;
1242     my $classes = shift;
1243
1244     # make a copy to not destroy original
1245     my @classes = @$classes;
1246
1247     foreach my $c (@classes) {
1248         # components default to being under the DBIx::Class namespace unless they
1249         # are preceeded with a '+'
1250         if ( $key =~ m/component/ && $c !~ s/^\+// ) {
1251             $c = 'DBIx::Class::' . $c;
1252         }
1253
1254         # 1 == installed, 0 == not installed, undef == invalid classname
1255         my $installed = Class::Inspector->installed($c);
1256         if ( defined($installed) ) {
1257             if ( $installed == 0 ) {
1258                 croak qq/$c, as specified in the loader option "$key", is not installed/;
1259             }
1260         } else {
1261             croak qq/$c, as specified in the loader option "$key", is an invalid class name/;
1262         }
1263     }
1264 }
1265
1266
1267 sub _find_file_in_inc {
1268     my ($self, $file) = @_;
1269
1270     foreach my $prefix (@INC) {
1271         my $fullpath = File::Spec->catfile($prefix, $file);
1272         return $fullpath if -f $fullpath
1273             # abs_path throws on Windows for nonexistant files
1274             and (try { Cwd::abs_path($fullpath) }) ne
1275                ((try { Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) }) || '');
1276     }
1277
1278     return;
1279 }
1280
1281 sub _find_class_in_inc {
1282     my ($self, $class) = @_;
1283
1284     return $self->_find_file_in_inc(class_path($class));
1285 }
1286
1287 sub _rewriting {
1288     my $self = shift;
1289
1290     return $self->_upgrading_from
1291         || $self->_upgrading_from_load_classes
1292         || $self->_downgrading_to_load_classes
1293         || $self->_rewriting_result_namespace
1294     ;
1295 }
1296
1297 sub _rewrite_old_classnames {
1298     my ($self, $code) = @_;
1299
1300     return $code unless $self->_rewriting;
1301
1302     my %old_classes = reverse %{ $self->_upgrading_classes };
1303
1304     my $re = join '|', keys %old_classes;
1305     $re = qr/\b($re)\b/;
1306
1307     $code =~ s/$re/$old_classes{$1} || $1/eg;
1308
1309     return $code;
1310 }
1311
1312 sub _load_external {
1313     my ($self, $class) = @_;
1314
1315     return if $self->{skip_load_external};
1316
1317     # so that we don't load our own classes, under any circumstances
1318     local *INC = [ grep $_ ne $self->dump_directory, @INC ];
1319
1320     my $real_inc_path = $self->_find_class_in_inc($class);
1321
1322     my $old_class = $self->_upgrading_classes->{$class}
1323         if $self->_rewriting;
1324
1325     my $old_real_inc_path = $self->_find_class_in_inc($old_class)
1326         if $old_class && $old_class ne $class;
1327
1328     return unless $real_inc_path || $old_real_inc_path;
1329
1330     if ($real_inc_path) {
1331         # If we make it to here, we loaded an external definition
1332         warn qq/# Loaded external class definition for '$class'\n/
1333             if $self->debug;
1334
1335         my $code = $self->_rewrite_old_classnames(slurp_file $real_inc_path);
1336
1337         if ($self->dynamic) { # load the class too
1338             eval_package_without_redefine_warnings($class, $code);
1339         }
1340
1341         $self->_ext_stmt($class,
1342           qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
1343          .qq|# They are now part of the custom portion of this file\n|
1344          .qq|# for you to hand-edit.  If you do not either delete\n|
1345          .qq|# this section or remove that file from \@INC, this section\n|
1346          .qq|# will be repeated redundantly when you re-create this\n|
1347          .qq|# file again via Loader!  See skip_load_external to disable\n|
1348          .qq|# this feature.\n|
1349         );
1350         chomp $code;
1351         $self->_ext_stmt($class, $code);
1352         $self->_ext_stmt($class,
1353             qq|# End of lines loaded from '$real_inc_path' |
1354         );
1355     }
1356
1357     if ($old_real_inc_path) {
1358         my $code = slurp_file $old_real_inc_path;
1359
1360         $self->_ext_stmt($class, <<"EOF");
1361
1362 # These lines were loaded from '$old_real_inc_path',
1363 # based on the Result class name that would have been created by an older
1364 # version of the Loader. For a static schema, this happens only once during
1365 # upgrade. See skip_load_external to disable this feature.
1366 EOF
1367
1368         $code = $self->_rewrite_old_classnames($code);
1369
1370         if ($self->dynamic) {
1371             warn <<"EOF";
1372
1373 Detected external content in '$old_real_inc_path', a class name that would have
1374 been used by an older version of the Loader.
1375
1376 * PLEASE RENAME THIS CLASS: from '$old_class' to '$class', as that is the
1377 new name of the Result.
1378 EOF
1379             eval_package_without_redefine_warnings($class, $code);
1380         }
1381
1382         chomp $code;
1383         $self->_ext_stmt($class, $code);
1384         $self->_ext_stmt($class,
1385             qq|# End of lines loaded from '$old_real_inc_path' |
1386         );
1387     }
1388 }
1389
1390 =head2 load
1391
1392 Does the actual schema-construction work.
1393
1394 =cut
1395
1396 sub load {
1397     my $self = shift;
1398
1399     $self->_load_tables(
1400         $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude })
1401     );
1402 }
1403
1404 =head2 rescan
1405
1406 Arguments: schema
1407
1408 Rescan the database for changes. Returns a list of the newly added table
1409 monikers.
1410
1411 The schema argument should be the schema class or object to be affected.  It
1412 should probably be derived from the original schema_class used during L</load>.
1413
1414 =cut
1415
1416 sub rescan {
1417     my ($self, $schema) = @_;
1418
1419     $self->{schema} = $schema;
1420     $self->_relbuilder->{schema} = $schema;
1421
1422     my @created;
1423     my @current = $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude });
1424
1425     foreach my $table (@current) {
1426         if(!exists $self->_tables->{$table->sql_name}) {
1427             push(@created, $table);
1428         }
1429     }
1430
1431     my %current;
1432     @current{map $_->sql_name, @current} = ();
1433     foreach my $table (values %{ $self->_tables }) {
1434         if (not exists $current{$table->sql_name}) {
1435             $self->_remove_table($table);
1436         }
1437     }
1438
1439     delete @$self{qw/_dump_storage _relations_started _uniqs_started/};
1440
1441     my $loaded = $self->_load_tables(@current);
1442
1443     foreach my $table (@created) {
1444         $self->monikers->{$table->sql_name} = $self->_table2moniker($table);
1445     }
1446
1447     return map { $self->monikers->{$_->sql_name} } @created;
1448 }
1449
1450 sub _relbuilder {
1451     my ($self) = @_;
1452
1453     return if $self->{skip_relationships};
1454
1455     return $self->{relbuilder} ||= do {
1456         my $relbuilder_suff =
1457             {qw{
1458                 v4  ::Compat::v0_040
1459                 v5  ::Compat::v0_05
1460                 v6  ::Compat::v0_06
1461                 v7  ::Compat::v0_07
1462             }}
1463             ->{$self->naming->{relationships}||$CURRENT_V} || '';
1464
1465         my $relbuilder_class = 'DBIx::Class::Schema::Loader::RelBuilder'.$relbuilder_suff;
1466         $self->ensure_class_loaded($relbuilder_class);
1467         $relbuilder_class->new($self);
1468     };
1469 }
1470
1471 sub _load_tables {
1472     my ($self, @tables) = @_;
1473
1474     # Save the new tables to the tables list
1475     foreach (@tables) {
1476         $self->_tables->{$_->sql_name} = $_;
1477     }
1478
1479     $self->_make_src_class($_) for @tables;
1480
1481     # sanity-check for moniker clashes
1482     my $inverse_moniker_idx;
1483     foreach my $table (values %{ $self->_tables }) {
1484       push @{ $inverse_moniker_idx->{$self->monikers->{$table->sql_name}} }, $table;
1485     }
1486
1487     my @clashes;
1488     foreach my $moniker (keys %$inverse_moniker_idx) {
1489       my $tables = $inverse_moniker_idx->{$moniker};
1490       if (@$tables > 1) {
1491         push @clashes, sprintf ("tables %s reduced to the same source moniker '%s'",
1492           join (', ', map $_->sql_name, @$tables),
1493           $moniker,
1494         );
1495       }
1496     }
1497
1498     if (@clashes) {
1499       die   'Unable to load schema - chosen moniker/class naming style results in moniker clashes. '
1500           . 'In multi db_schema configurations you may need to set moniker_parts, '
1501           . 'otherwise change the naming style, or supply an explicit moniker_map: '
1502           . join ('; ', @clashes)
1503           . "\n"
1504       ;
1505     }
1506
1507     $self->_setup_src_meta($_) for @tables;
1508
1509     if(!$self->skip_relationships) {
1510         # The relationship loader needs a working schema
1511         local $self->{quiet} = 1;
1512         local $self->{dump_directory} = $self->{temp_directory};
1513         $self->_reload_classes(\@tables);
1514         $self->_load_relationships(\@tables);
1515
1516         # Remove that temp dir from INC so it doesn't get reloaded
1517         @INC = grep $_ ne $self->dump_directory, @INC;
1518     }
1519
1520     $self->_load_roles($_) for @tables;
1521
1522     $self->_load_external($_)
1523         for map { $self->classes->{$_->sql_name} } @tables;
1524
1525     # Reload without unloading first to preserve any symbols from external
1526     # packages.
1527     $self->_reload_classes(\@tables, { unload => 0 });
1528
1529     # Drop temporary cache
1530     delete $self->{_cache};
1531
1532     return \@tables;
1533 }
1534
1535 sub _reload_classes {
1536     my ($self, $tables, $opts) = @_;
1537
1538     my @tables = @$tables;
1539
1540     my $unload = $opts->{unload};
1541     $unload = 1 unless defined $unload;
1542
1543     # so that we don't repeat custom sections
1544     @INC = grep $_ ne $self->dump_directory, @INC;
1545
1546     $self->_dump_to_dir(map { $self->classes->{$_->sql_name} } @tables);
1547
1548     unshift @INC, $self->dump_directory;
1549
1550     my @to_register;
1551     my %have_source = map { $_ => $self->schema->source($_) }
1552         $self->schema->sources;
1553
1554     for my $table (@tables) {
1555         my $moniker = $self->monikers->{$table->sql_name};
1556         my $class = $self->classes->{$table->sql_name};
1557
1558         {
1559             no warnings 'redefine';
1560             local *Class::C3::reinitialize = sub {};  # to speed things up, reinitialized below
1561             use warnings;
1562
1563             if (my $mc = $self->_moose_metaclass($class)) {
1564                 $mc->make_mutable;
1565             }
1566             Class::Unload->unload($class) if $unload;
1567             my ($source, $resultset_class);
1568             if (
1569                 ($source = $have_source{$moniker})
1570                 && ($resultset_class = $source->resultset_class)
1571                 && ($resultset_class ne 'DBIx::Class::ResultSet')
1572             ) {
1573                 my $has_file = Class::Inspector->loaded_filename($resultset_class);
1574                 if (my $mc = $self->_moose_metaclass($resultset_class)) {
1575                     $mc->make_mutable;
1576                 }
1577                 Class::Unload->unload($resultset_class) if $unload;
1578                 $self->_reload_class($resultset_class) if $has_file;
1579             }
1580             $self->_reload_class($class);
1581         }
1582         push @to_register, [$moniker, $class];
1583     }
1584
1585     Class::C3->reinitialize;
1586     for (@to_register) {
1587         $self->schema->register_class(@$_);
1588     }
1589 }
1590
1591 sub _moose_metaclass {
1592   return undef unless $INC{'Class/MOP.pm'};   # if CMOP is not loaded the class could not have loaded in the 1st place
1593
1594   my $class = $_[1];
1595
1596   my $mc = try { Class::MOP::class_of($class) }
1597     or return undef;
1598
1599   return $mc->isa('Moose::Meta::Class') ? $mc : undef;
1600 }
1601
1602 # We use this instead of ensure_class_loaded when there are package symbols we
1603 # want to preserve.
1604 sub _reload_class {
1605     my ($self, $class) = @_;
1606
1607     delete $INC{ +class_path($class) };
1608
1609     try {
1610         eval_package_without_redefine_warnings ($class, "require $class");
1611     }
1612     catch {
1613         my $source = slurp_file $self->_get_dump_filename($class);
1614         die "Failed to reload class $class: $_.\n\nCLASS SOURCE:\n\n$source";
1615     };
1616 }
1617
1618 sub _get_dump_filename {
1619     my ($self, $class) = (@_);
1620
1621     $class =~ s{::}{/}g;
1622     return $self->dump_directory . q{/} . $class . q{.pm};
1623 }
1624
1625 =head2 get_dump_filename
1626
1627 Arguments: class
1628
1629 Returns the full path to the file for a class that the class has been or will
1630 be dumped to. This is a file in a temp dir for a dynamic schema.
1631
1632 =cut
1633
1634 sub get_dump_filename {
1635     my ($self, $class) = (@_);
1636
1637     local $self->{dump_directory} = $self->real_dump_directory;
1638
1639     return $self->_get_dump_filename($class);
1640 }
1641
1642 sub _ensure_dump_subdirs {
1643     my ($self, $class) = (@_);
1644
1645     my @name_parts = split(/::/, $class);
1646     pop @name_parts; # we don't care about the very last element,
1647                      # which is a filename
1648
1649     my $dir = $self->dump_directory;
1650     while (1) {
1651         if(!-d $dir) {
1652             mkdir($dir) or croak "mkdir('$dir') failed: $!";
1653         }
1654         last if !@name_parts;
1655         $dir = File::Spec->catdir($dir, shift @name_parts);
1656     }
1657 }
1658
1659 sub _dump_to_dir {
1660     my ($self, @classes) = @_;
1661
1662     my $schema_class = $self->schema_class;
1663     my $schema_base_class = $self->schema_base_class || 'DBIx::Class::Schema';
1664
1665     my $target_dir = $self->dump_directory;
1666     warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
1667         unless $self->dynamic or $self->quiet;
1668
1669     my $schema_text =
1670           qq|use utf8;\n|
1671         . qq|package $schema_class;\n\n|
1672         . qq|# Created by DBIx::Class::Schema::Loader\n|
1673         . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
1674
1675     my $autoclean
1676         = $self->only_autoclean
1677         ? 'namespace::autoclean'
1678         : 'MooseX::MarkAsMethods autoclean => 1'
1679         ;
1680
1681     if ($self->use_moose) {
1682
1683         $schema_text.= qq|use Moose;\nuse $autoclean;\nextends '$schema_base_class';\n\n|;
1684     }
1685     else {
1686         $schema_text .= qq|use strict;\nuse warnings;\n\nuse base '$schema_base_class';\n\n|;
1687     }
1688
1689     my @schema_components = @{ $self->schema_components || [] };
1690
1691     if (@schema_components) {
1692         my $schema_components = dump @schema_components;
1693         $schema_components = "($schema_components)" if @schema_components == 1;
1694
1695         $schema_text .= "__PACKAGE__->load_components${schema_components};\n\n";
1696     }
1697
1698     if ($self->use_namespaces) {
1699         $schema_text .= qq|__PACKAGE__->load_namespaces|;
1700         my $namespace_options;
1701
1702         my @attr = qw/resultset_namespace default_resultset_class/;
1703
1704         unshift @attr, 'result_namespace' unless (not $self->result_namespace) || $self->result_namespace eq 'Result';
1705
1706         for my $attr (@attr) {
1707             if ($self->$attr) {
1708                 my $code = dumper_squashed $self->$attr;
1709                 $namespace_options .= qq|    $attr => $code,\n|
1710             }
1711         }
1712         $schema_text .= qq|(\n$namespace_options)| if $namespace_options;
1713         $schema_text .= qq|;\n|;
1714     }
1715     else {
1716         $schema_text .= qq|__PACKAGE__->load_classes;\n|;
1717     }
1718
1719     {
1720         local $self->{version_to_dump} = $self->schema_version_to_dump;
1721         $self->_write_classfile($schema_class, $schema_text, 1);
1722     }
1723
1724     my $result_base_class = $self->result_base_class || 'DBIx::Class::Core';
1725
1726     foreach my $src_class (@classes) {
1727         my $src_text =
1728               qq|use utf8;\n|
1729             . qq|package $src_class;\n\n|
1730             . qq|# Created by DBIx::Class::Schema::Loader\n|
1731             . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
1732
1733         $src_text .= $self->_make_pod_heading($src_class);
1734
1735         $src_text .= qq|use strict;\nuse warnings;\n\n|;
1736
1737         $src_text .= $self->_base_class_pod($result_base_class)
1738             unless $result_base_class eq 'DBIx::Class::Core';
1739
1740         if ($self->use_moose) {
1741             $src_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse $autoclean;|;
1742
1743             # these options 'use base' which is compile time
1744             if (@{ $self->left_base_classes } || @{ $self->additional_base_classes }) {
1745                 $src_text .= qq|\nBEGIN { extends '$result_base_class' }\n|;
1746             }
1747             else {
1748                 $src_text .= qq|\nextends '$result_base_class';\n|;
1749             }
1750         }
1751         else {
1752              $src_text .= qq|use base '$result_base_class';\n|;
1753         }
1754
1755         $self->_write_classfile($src_class, $src_text);
1756     }
1757
1758     # remove Result dir if downgrading from use_namespaces, and there are no
1759     # files left.
1760     if (my $result_ns = $self->_downgrading_to_load_classes
1761                         || $self->_rewriting_result_namespace) {
1762         my $result_namespace = $self->_result_namespace(
1763             $schema_class,
1764             $result_ns,
1765         );
1766
1767         (my $result_dir = $result_namespace) =~ s{::}{/}g;
1768         $result_dir = $self->dump_directory . '/' . $result_dir;
1769
1770         unless (my @files = glob "$result_dir/*") {
1771             rmdir $result_dir;
1772         }
1773     }
1774
1775     warn "Schema dump completed.\n" unless $self->dynamic or $self->quiet;
1776 }
1777
1778 sub _sig_comment {
1779     my ($self, $version, $ts) = @_;
1780     return qq|\n\n# Created by DBIx::Class::Schema::Loader|
1781          . qq| v| . $version
1782          . q| @ | . $ts
1783          . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
1784 }
1785
1786 sub _write_classfile {
1787     my ($self, $class, $text, $is_schema) = @_;
1788
1789     my $filename = $self->_get_dump_filename($class);
1790     $self->_ensure_dump_subdirs($class);
1791
1792     if (-f $filename && $self->really_erase_my_files) {
1793         warn "Deleting existing file '$filename' due to "
1794             . "'really_erase_my_files' setting\n" unless $self->quiet;
1795         unlink($filename);
1796     }
1797
1798     my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom)
1799         = $self->_parse_generated_file($filename);
1800
1801     if (! $old_gen && -f $filename) {
1802         croak "Cannot overwrite '$filename' without 'really_erase_my_files',"
1803             . " it does not appear to have been generated by Loader"
1804     }
1805
1806     my $custom_content = $old_custom || '';
1807
1808     # Use custom content from a renamed class, the class names in it are
1809     # rewritten below.
1810     if (my $renamed_class = $self->_upgrading_classes->{$class}) {
1811         my $old_filename = $self->_get_dump_filename($renamed_class);
1812
1813         if (-f $old_filename) {
1814             $custom_content = ($self->_parse_generated_file ($old_filename))[4];
1815
1816             unlink $old_filename;
1817         }
1818     }
1819
1820     $custom_content ||= $self->_default_custom_content($is_schema);
1821
1822     # If upgrading to use_moose=1 replace default custom content with default Moose custom content.
1823     # If there is already custom content, which does not have the Moose content, add it.
1824     if ($self->use_moose) {
1825
1826         my $non_moose_custom_content = do {
1827             local $self->{use_moose} = 0;
1828             $self->_default_custom_content;
1829         };
1830
1831         if ($custom_content eq $non_moose_custom_content) {
1832             $custom_content = $self->_default_custom_content($is_schema);
1833         }
1834         elsif ($custom_content !~ /\Q@{[$self->_default_moose_custom_content($is_schema)]}\E/) {
1835             $custom_content .= $self->_default_custom_content($is_schema);
1836         }
1837     }
1838     elsif (defined $self->use_moose && $old_gen) {
1839         croak 'It is not possible to "downgrade" a schema that was loaded with use_moose => 1 to use_moose => 0, due to differing custom content'
1840             if $old_gen =~ /use \s+ MooseX?\b/x;
1841     }
1842
1843     $custom_content = $self->_rewrite_old_classnames($custom_content);
1844
1845     $text .= qq|$_\n|
1846         for @{$self->{_dump_storage}->{$class} || []};
1847
1848     if ($self->filter_generated_code) {
1849         my $filter = $self->filter_generated_code;
1850
1851         if (ref $filter eq 'CODE') {
1852             $text = $filter->(
1853                 ($is_schema ? 'schema' : 'result'),
1854                 $class,
1855                 $text
1856             );
1857         }
1858         else {
1859             my ($fh, $temp_file) = tempfile();
1860
1861             binmode $fh, ':encoding(UTF-8)';
1862             print $fh $text;
1863             close $fh;
1864
1865             open my $out, qq{$filter < "$temp_file"|}
1866                 or croak "Could not open pipe to $filter: $!";
1867
1868             $text = decode('UTF-8', do { local $/; <$out> });
1869
1870             $text =~ s/$CR?$LF/\n/g;
1871
1872             close $out;
1873
1874             my $exit_code = $? >> 8;
1875
1876             unlink $temp_file
1877                 or croak "Could not remove temporary file '$temp_file': $!";
1878
1879             if ($exit_code != 0) {
1880                 croak "filter '$filter' exited non-zero: $exit_code";
1881             }
1882         }
1883         if (not $text or not $text =~ /\bpackage\b/) {
1884             warn("$class skipped due to filter") if $self->debug;
1885             return;
1886         }
1887     }
1888
1889     # Check and see if the dump is in fact different
1890
1891     my $compare_to;
1892     if ($old_md5) {
1893       $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
1894       if (Digest::MD5::md5_base64(encode 'UTF-8', $compare_to) eq $old_md5) {
1895         return unless $self->_upgrading_from && $is_schema;
1896       }
1897     }
1898
1899     $text .= $self->_sig_comment(
1900       $self->version_to_dump,
1901       POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
1902     );
1903
1904     open(my $fh, '>:encoding(UTF-8)', $filename)
1905         or croak "Cannot open '$filename' for writing: $!";
1906
1907     # Write the top half and its MD5 sum
1908     print $fh $text . Digest::MD5::md5_base64(encode 'UTF-8', $text) . "\n";
1909
1910     # Write out anything loaded via external partial class file in @INC
1911     print $fh qq|$_\n|
1912         for @{$self->{_ext_storage}->{$class} || []};
1913
1914     # Write out any custom content the user has added
1915     print $fh $custom_content;
1916
1917     close($fh)
1918         or croak "Error closing '$filename': $!";
1919 }
1920
1921 sub _default_moose_custom_content {
1922     my ($self, $is_schema) = @_;
1923
1924     if (not $is_schema) {
1925         return qq|\n__PACKAGE__->meta->make_immutable;|;
1926     }
1927
1928     return qq|\n__PACKAGE__->meta->make_immutable(inline_constructor => 0);|;
1929 }
1930
1931 sub _default_custom_content {
1932     my ($self, $is_schema) = @_;
1933     my $default = qq|\n\n# You can replace this text with custom|
1934          . qq| code or comments, and it will be preserved on regeneration|;
1935     if ($self->use_moose) {
1936         $default .= $self->_default_moose_custom_content($is_schema);
1937     }
1938     $default .= qq|\n1;\n|;
1939     return $default;
1940 }
1941
1942 sub _parse_generated_file {
1943     my ($self, $fn) = @_;
1944
1945     return unless -f $fn;
1946
1947     open(my $fh, '<:encoding(UTF-8)', $fn)
1948         or croak "Cannot open '$fn' for reading: $!";
1949
1950     my $mark_re =
1951         qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\r?\n};
1952
1953     my ($md5, $ts, $ver, $gen);
1954     while(<$fh>) {
1955         if(/$mark_re/) {
1956             my $pre_md5 = $1;
1957             $md5 = $2;
1958
1959             # Pull out the version and timestamp from the line above
1960             ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)\r?\Z/m;
1961
1962             $gen .= $pre_md5;
1963             croak "Checksum mismatch in '$fn', the auto-generated part of the file has been modified outside of this loader.  Aborting.\nIf you want to overwrite these modifications, set the 'overwrite_modifications' loader option.\n"
1964                 if !$self->overwrite_modifications && Digest::MD5::md5_base64(encode 'UTF-8', $gen) ne $md5;
1965
1966             last;
1967         }
1968         else {
1969             $gen .= $_;
1970         }
1971     }
1972
1973     my $custom = do { local $/; <$fh> }
1974         if $md5;
1975
1976     $custom ||= '';
1977     $custom =~ s/$CRLF|$LF/\n/g;
1978
1979     close $fh;
1980
1981     return ($gen, $md5, $ver, $ts, $custom);
1982 }
1983
1984 sub _use {
1985     my $self = shift;
1986     my $target = shift;
1987
1988     foreach (@_) {
1989         warn "$target: use $_;" if $self->debug;
1990         $self->_raw_stmt($target, "use $_;");
1991     }
1992 }
1993
1994 sub _inject {
1995     my $self = shift;
1996     my $target = shift;
1997
1998     my $blist = join(q{ }, @_);
1999
2000     return unless $blist;
2001
2002     warn "$target: use base qw/$blist/;" if $self->debug;
2003     $self->_raw_stmt($target, "use base qw/$blist/;");
2004 }
2005
2006 sub _with {
2007     my $self = shift;
2008     my $target = shift;
2009
2010     my $rlist = join(q{, }, map { qq{'$_'} } @_);
2011
2012     return unless $rlist;
2013
2014     warn "$target: with $rlist;" if $self->debug;
2015     $self->_raw_stmt($target, "\nwith $rlist;");
2016 }
2017
2018 sub _result_namespace {
2019     my ($self, $schema_class, $ns) = @_;
2020     my @result_namespace;
2021
2022     $ns = $ns->[0] if ref $ns;
2023
2024     if ($ns =~ /^\+(.*)/) {
2025         # Fully qualified namespace
2026         @result_namespace = ($1)
2027     }
2028     else {
2029         # Relative namespace
2030         @result_namespace = ($schema_class, $ns);
2031     }
2032
2033     return wantarray ? @result_namespace : join '::', @result_namespace;
2034 }
2035
2036 # Create class with applicable bases, setup monikers, etc
2037 sub _make_src_class {
2038     my ($self, $table) = @_;
2039
2040     my $schema       = $self->schema;
2041     my $schema_class = $self->schema_class;
2042
2043     my $table_moniker = $self->_table2moniker($table);
2044     my @result_namespace = ($schema_class);
2045     if ($self->use_namespaces) {
2046         my $result_namespace = $self->result_namespace || 'Result';
2047         @result_namespace = $self->_result_namespace(
2048             $schema_class,
2049             $result_namespace,
2050         );
2051     }
2052     my $table_class = join(q{::}, @result_namespace, $table_moniker);
2053
2054     if ((my $upgrading_v = $self->_upgrading_from)
2055             || $self->_rewriting) {
2056         local $self->naming->{monikers} = $upgrading_v
2057             if $upgrading_v;
2058
2059         my @result_namespace = @result_namespace;
2060         if ($self->_upgrading_from_load_classes) {
2061             @result_namespace = ($schema_class);
2062         }
2063         elsif (my $ns = $self->_downgrading_to_load_classes) {
2064             @result_namespace = $self->_result_namespace(
2065                 $schema_class,
2066                 $ns,
2067             );
2068         }
2069         elsif ($ns = $self->_rewriting_result_namespace) {
2070             @result_namespace = $self->_result_namespace(
2071                 $schema_class,
2072                 $ns,
2073             );
2074         }
2075
2076         my $old_table_moniker = do {
2077             local $self->naming->{monikers} = $upgrading_v;
2078             $self->_table2moniker($table);
2079         };
2080
2081         my $old_class = join(q{::}, @result_namespace, $old_table_moniker);
2082
2083         $self->_upgrading_classes->{$table_class} = $old_class
2084             unless $table_class eq $old_class;
2085     }
2086
2087     $self->classes->{$table->sql_name}  = $table_class;
2088     $self->monikers->{$table->sql_name} = $table_moniker;
2089     $self->moniker_to_table->{$table_moniker} = $table;
2090     $self->class_to_table->{$table_class} = $table;
2091
2092     $self->_pod_class_list($table_class, 'ADDITIONAL CLASSES USED', @{$self->additional_classes});
2093
2094     $self->_use   ($table_class, @{$self->additional_classes});
2095
2096     $self->_pod_class_list($table_class, 'LEFT BASE CLASSES', @{$self->left_base_classes});
2097
2098     $self->_inject($table_class, @{$self->left_base_classes});
2099
2100     my @components = @{ $self->components || [] };
2101
2102     push @components, @{ $self->result_components_map->{$table_moniker} }
2103         if exists $self->result_components_map->{$table_moniker};
2104
2105     my @fq_components = @components;
2106     foreach my $component (@fq_components) {
2107         if ($component !~ s/^\+//) {
2108             $component = "DBIx::Class::$component";
2109         }
2110     }
2111
2112     $self->_pod_class_list($table_class, 'COMPONENTS LOADED', @fq_components);
2113
2114     $self->_dbic_stmt($table_class, 'load_components', @components) if @components;
2115
2116     $self->_pod_class_list($table_class, 'ADDITIONAL BASE CLASSES', @{$self->additional_base_classes});
2117
2118     $self->_inject($table_class, @{$self->additional_base_classes});
2119 }
2120
2121 sub _is_result_class_method {
2122     my ($self, $name, $table) = @_;
2123
2124     my $table_moniker = $table ? $self->monikers->{$table->sql_name} : '';
2125
2126     $self->_result_class_methods({})
2127         if not defined $self->_result_class_methods;
2128
2129     if (not exists $self->_result_class_methods->{$table_moniker}) {
2130         my (@methods, %methods);
2131         my $base       = $self->result_base_class || 'DBIx::Class::Core';
2132
2133         my @components = @{ $self->components || [] };
2134
2135         push @components, @{ $self->result_components_map->{$table_moniker} }
2136             if exists $self->result_components_map->{$table_moniker};
2137
2138         for my $c (@components) {
2139             $c = $c =~ /^\+/ ? substr($c,1) : "DBIx::Class::$c";
2140         }
2141
2142         my @roles = @{ $self->result_roles || [] };
2143
2144         push @roles, @{ $self->result_roles_map->{$table_moniker} }
2145             if exists $self->result_roles_map->{$table_moniker};
2146
2147         for my $class ($base, @components,
2148                        ($self->use_moose ? 'Moose::Object' : ()), @roles) {
2149             $self->ensure_class_loaded($class);
2150
2151             push @methods, @{ Class::Inspector->methods($class) || [] };
2152         }
2153
2154         push @methods, @{ Class::Inspector->methods('UNIVERSAL') };
2155
2156         @methods{@methods} = ();
2157
2158         $self->_result_class_methods->{$table_moniker} = \%methods;
2159     }
2160     my $result_methods = $self->_result_class_methods->{$table_moniker};
2161
2162     return exists $result_methods->{$name};
2163 }
2164
2165 sub _resolve_col_accessor_collisions {
2166     my ($self, $table, $col_info) = @_;
2167
2168     while (my ($col, $info) = each %$col_info) {
2169         my $accessor = $info->{accessor} || $col;
2170
2171         next if $accessor eq 'id'; # special case (very common column)
2172
2173         if ($self->_is_result_class_method($accessor, $table)) {
2174             my $mapped = 0;
2175
2176             if (my $map = $self->col_collision_map) {
2177                 for my $re (keys %$map) {
2178                     if (my @matches = $col =~ /$re/) {
2179                         $info->{accessor} = sprintf $map->{$re}, @matches;
2180                         $mapped = 1;
2181                     }
2182                 }
2183             }
2184
2185             if (not $mapped) {
2186                 warn <<"EOF";
2187 Column '$col' in table '$table' collides with an inherited method.
2188 See "COLUMN ACCESSOR COLLISIONS" in perldoc DBIx::Class::Schema::Loader::Base .
2189 EOF
2190                 $info->{accessor} = undef;
2191             }
2192         }
2193     }
2194 }
2195
2196 # use the same logic to run moniker_map, col_accessor_map
2197 sub _run_user_map {
2198     my ( $self, $map, $default_code, $ident, @extra ) = @_;
2199
2200     my $default_ident = $default_code->( $ident, @extra );
2201     my $new_ident;
2202     if( $map && ref $map eq 'HASH' ) {
2203         $new_ident = $map->{ $ident };
2204     }
2205     elsif( $map && ref $map eq 'CODE' ) {
2206         $new_ident = $map->( $ident, $default_ident, @extra );
2207     }
2208
2209     $new_ident ||= $default_ident;
2210
2211     return $new_ident;
2212 }
2213
2214 sub _default_column_accessor_name {
2215     my ( $self, $column_name ) = @_;
2216
2217     my $preserve = ($self->naming->{column_accessors}||'') eq 'preserve';
2218
2219     my $v = $self->_get_naming_v('column_accessors');
2220
2221     my $accessor_name = $preserve ?
2222         $self->_to_identifier('column_accessors', $column_name) # assume CamelCase
2223         :
2224         $self->_to_identifier('column_accessors', $column_name, '_');
2225
2226     $accessor_name =~ s/\W+/_/g; # only if naming < v8, otherwise to_identifier
2227                                  # takes care of it
2228
2229     if ($preserve) {
2230         return $accessor_name;
2231     }
2232     elsif ($v < 7 || (not $self->preserve_case)) {
2233         # older naming just lc'd the col accessor and that's all.
2234         return lc $accessor_name;
2235     }
2236
2237     return join '_', map lc, split_name $column_name, $v;
2238 }
2239
2240 sub _make_column_accessor_name {
2241     my ($self, $column_name, $column_context_info ) = @_;
2242
2243     my $accessor = $self->_run_user_map(
2244         $self->col_accessor_map,
2245         sub { $self->_default_column_accessor_name( shift ) },
2246         $column_name,
2247         $column_context_info,
2248        );
2249
2250     return $accessor;
2251 }
2252
2253 # Set up metadata (cols, pks, etc)
2254 sub _setup_src_meta {
2255     my ($self, $table) = @_;
2256
2257     my $schema       = $self->schema;
2258     my $schema_class = $self->schema_class;
2259
2260     my $table_class   = $self->classes->{$table->sql_name};
2261     my $table_moniker = $self->monikers->{$table->sql_name};
2262
2263     $self->_dbic_stmt($table_class, 'table', $table->dbic_name);
2264
2265     my $cols     = $self->_table_columns($table);
2266     my $col_info = $self->__columns_info_for($table);
2267
2268     ### generate all the column accessor names
2269     while (my ($col, $info) = each %$col_info) {
2270         # hashref of other info that could be used by
2271         # user-defined accessor map functions
2272         my $context = {
2273             table_class     => $table_class,
2274             table_moniker   => $table_moniker,
2275             table_name      => $table,
2276             full_table_name => $table->dbic_name,
2277             schema_class    => $schema_class,
2278             column_info     => $info,
2279         };
2280
2281         $info->{accessor} = $self->_make_column_accessor_name( $col, $context );
2282     }
2283
2284     $self->_resolve_col_accessor_collisions($table, $col_info);
2285
2286     # prune any redundant accessor names
2287     while (my ($col, $info) = each %$col_info) {
2288         no warnings 'uninitialized';
2289         delete $info->{accessor} if $info->{accessor} eq $col;
2290     }
2291
2292     my $fks = $self->_table_fk_info($table);
2293
2294     foreach my $fkdef (@$fks) {
2295         for my $col (@{ $fkdef->{local_columns} }) {
2296             $col_info->{$col}{is_foreign_key} = 1;
2297         }
2298     }
2299
2300     my $pks = $self->_table_pk_info($table) || [];
2301
2302     my %uniq_tag; # used to eliminate duplicate uniqs
2303
2304     $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
2305
2306     my $uniqs = $self->_table_uniq_info($table) || [];
2307     my @uniqs;
2308
2309     foreach my $uniq (@$uniqs) {
2310         my ($name, $cols) = @$uniq;
2311         next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
2312         push @uniqs, [$name, $cols];
2313     }
2314
2315     my @non_nullable_uniqs = grep {
2316         all { $col_info->{$_}{is_nullable} == 0 } @{ $_->[1] }
2317     } @uniqs;
2318
2319     if ($self->uniq_to_primary && (not @$pks) && @non_nullable_uniqs) {
2320         my @by_colnum = sort { $b->[0] <=> $a->[0] }
2321             map [ scalar @{ $_->[1] }, $_ ], @non_nullable_uniqs;
2322
2323         if (not (@by_colnum > 1 && $by_colnum[0][0] == $by_colnum[1][0])) {
2324             my @keys = map $_->[1], @by_colnum;
2325
2326             my $pk = $keys[0];
2327
2328             # remove the uniq from list
2329             @uniqs = grep { $_->[0] ne $pk->[0] } @uniqs;
2330
2331             $pks = $pk->[1];
2332         }
2333     }
2334
2335     foreach my $pkcol (@$pks) {
2336         $col_info->{$pkcol}{is_nullable} = 0;
2337     }
2338
2339     $self->_dbic_stmt(
2340         $table_class,
2341         'add_columns',
2342         map { $_, ($col_info->{$_}||{}) } @$cols
2343     );
2344
2345     $self->_dbic_stmt($table_class, 'set_primary_key', @$pks)
2346         if @$pks;
2347
2348     # Sort unique constraints by constraint name for repeatable results (rels
2349     # are sorted as well elsewhere.)
2350     @uniqs = sort { $a->[0] cmp $b->[0] } @uniqs;
2351
2352     foreach my $uniq (@uniqs) {
2353         my ($name, $cols) = @$uniq;
2354         $self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
2355     }
2356 }
2357
2358 sub __columns_info_for {
2359     my ($self, $table) = @_;
2360
2361     my $result = $self->_columns_info_for($table);
2362
2363     while (my ($col, $info) = each %$result) {
2364         $info = { %$info, %{ $self->_custom_column_info  ($table, $col, $info) } };
2365         $info = { %$info, %{ $self->_datetime_column_info($table, $col, $info) } };
2366
2367         $result->{$col} = $info;
2368     }
2369
2370     return $result;
2371 }
2372
2373 =head2 tables
2374
2375 Returns a sorted list of loaded tables, using the original database table
2376 names.
2377
2378 =cut
2379
2380 sub tables {
2381     my $self = shift;
2382
2383     return values %{$self->_tables};
2384 }
2385
2386 sub _get_naming_v {
2387     my ($self, $naming_key) = @_;
2388
2389     my $v;
2390
2391     if (($self->naming->{$naming_key}||'') =~ /^v(\d+)\z/) {
2392         $v = $1;
2393     }
2394     else {
2395         ($v) = $CURRENT_V =~ /^v(\d+)\z/;
2396     }
2397
2398     return $v;
2399 }
2400
2401 sub _to_identifier {
2402     my ($self, $naming_key, $name, $sep_char, $force) = @_;
2403
2404     my $v = $self->_get_naming_v($naming_key);
2405
2406     my $to_identifier = $self->naming->{force_ascii} ?
2407         \&String::ToIdentifier::EN::to_identifier
2408         : \&String::ToIdentifier::EN::Unicode::to_identifier;
2409
2410     return $v >= 8 || $force ? $to_identifier->($name, $sep_char) : $name;
2411 }
2412
2413 # Make a moniker from a table
2414 sub _default_table2moniker {
2415     my ($self, $table) = @_;
2416
2417     my $v = $self->_get_naming_v('monikers');
2418
2419     my @name_parts = map $table->$_, @{ $self->moniker_parts };
2420
2421     my $name_idx = firstidx { $_ eq 'name' } @{ $self->moniker_parts };
2422
2423     my @all_parts;
2424
2425     foreach my $i (0 .. $#name_parts) {
2426         my $part = $name_parts[$i];
2427
2428         if ($i != $name_idx || $v >= 8) {
2429             $part = $self->_to_identifier('monikers', $part, '_', 1);
2430         }
2431
2432         if ($i == $name_idx && $v == 5) {
2433             $part = Lingua::EN::Inflect::Number::to_S($part);
2434         }
2435
2436         my @part_parts = map lc, $v > 6 ?
2437             # use v8 semantics for all moniker parts except name
2438             ($i == $name_idx ? split_name $part, $v : split_name $part)
2439             : split /[\W_]+/, $part;
2440
2441         if ($i == $name_idx && $v >= 6) {
2442             my $as_phrase = join ' ', @part_parts;
2443
2444             my $inflected = ($self->naming->{monikers}||'') eq 'plural' ?
2445                 Lingua::EN::Inflect::Phrase::to_PL($as_phrase)
2446                 :
2447                 ($self->naming->{monikers}||'') eq 'preserve' ?
2448                     $as_phrase
2449                     :
2450                     Lingua::EN::Inflect::Phrase::to_S($as_phrase);
2451
2452             @part_parts = split /\s+/, $inflected;
2453         }
2454
2455         push @all_parts, map ucfirst, @part_parts;
2456     }
2457
2458     return join '', @all_parts;
2459 }
2460
2461 sub _table2moniker {
2462     my ( $self, $table ) = @_;
2463
2464     $self->_run_user_map(
2465         $self->moniker_map,
2466         sub { $self->_default_table2moniker( shift ) },
2467         $table
2468        );
2469 }
2470
2471 sub _load_relationships {
2472     my ($self, $tables) = @_;
2473
2474     my @tables;
2475
2476     foreach my $table (@$tables) {
2477         my $local_moniker = $self->monikers->{$table->sql_name};
2478
2479         my $tbl_fk_info = $self->_table_fk_info($table);
2480
2481         foreach my $fkdef (@$tbl_fk_info) {
2482             $fkdef->{local_table}   = $table;
2483             $fkdef->{local_moniker} = $local_moniker;
2484             $fkdef->{remote_source} =
2485                 $self->monikers->{$fkdef->{remote_table}->sql_name};
2486         }
2487         my $tbl_uniq_info = $self->_table_uniq_info($table);
2488
2489         push @tables, [ $local_moniker, $tbl_fk_info, $tbl_uniq_info ];
2490     }
2491
2492     my $rel_stmts = $self->_relbuilder->generate_code(\@tables);
2493
2494     foreach my $src_class (sort keys %$rel_stmts) {
2495         # sort by rel name
2496         my @src_stmts = map $_->[1],
2497             sort { $a->[0] cmp $b->[0] }
2498             map [ $_->{args}[0], $_ ], @{ $rel_stmts->{$src_class} };
2499
2500         foreach my $stmt (@src_stmts) {
2501             $self->_dbic_stmt($src_class,$stmt->{method}, @{$stmt->{args}});
2502         }
2503     }
2504 }
2505
2506 sub _load_roles {
2507     my ($self, $table) = @_;
2508
2509     my $table_moniker = $self->monikers->{$table->sql_name};
2510     my $table_class   = $self->classes->{$table->sql_name};
2511
2512     my @roles = @{ $self->result_roles || [] };
2513     push @roles, @{ $self->result_roles_map->{$table_moniker} }
2514         if exists $self->result_roles_map->{$table_moniker};
2515
2516     if (@roles) {
2517         $self->_pod_class_list($table_class, 'L<Moose> ROLES APPLIED', @roles);
2518
2519         $self->_with($table_class, @roles);
2520     }
2521 }
2522
2523 # Overload these in driver class:
2524
2525 # Returns an arrayref of column names
2526 sub _table_columns { croak "ABSTRACT METHOD" }
2527
2528 # Returns arrayref of pk col names
2529 sub _table_pk_info { croak "ABSTRACT METHOD" }
2530
2531 # Returns an arrayref of uniqs [ [ foo => [ col1, col2 ] ], [ bar => [ ... ] ] ]
2532 sub _table_uniq_info { croak "ABSTRACT METHOD" }
2533
2534 # Returns an arrayref of foreign key constraints, each
2535 #   being a hashref with 3 keys:
2536 #   local_columns (arrayref), remote_columns (arrayref), remote_table
2537 sub _table_fk_info { croak "ABSTRACT METHOD" }
2538
2539 # Returns an array of lower case table names
2540 sub _tables_list { croak "ABSTRACT METHOD" }
2541
2542 # Execute a constructive DBIC class method, with debug/dump_to_dir hooks.
2543 sub _dbic_stmt {
2544     my $self   = shift;
2545     my $class  = shift;
2546     my $method = shift;
2547
2548     # generate the pod for this statement, storing it with $self->_pod
2549     $self->_make_pod( $class, $method, @_ ) if $self->generate_pod;
2550
2551     my $args = dump(@_);
2552     $args = '(' . $args . ')' if @_ < 2;
2553     my $stmt = $method . $args . q{;};
2554
2555     warn qq|$class\->$stmt\n| if $self->debug;
2556     $self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
2557     return;
2558 }
2559
2560 sub _make_pod_heading {
2561     my ($self, $class) = @_;
2562
2563     return '' if not $self->generate_pod;
2564
2565     my $table = $self->class_to_table->{$class};
2566     my $pod;
2567
2568     my $pcm = $self->pod_comment_mode;
2569     my ($comment, $comment_overflows, $comment_in_name, $comment_in_desc);
2570     $comment = $self->__table_comment($table);
2571     $comment_overflows = ($comment and length $comment > $self->pod_comment_spillover_length);
2572     $comment_in_name   = ($pcm eq 'name' or ($pcm eq 'auto' and !$comment_overflows));
2573     $comment_in_desc   = ($pcm eq 'description' or ($pcm eq 'auto' and $comment_overflows));
2574
2575     $pod .= "=head1 NAME\n\n";
2576
2577     my $table_descr = $class;
2578     $table_descr .= " - " . $comment if $comment and $comment_in_name;
2579
2580     $pod .= "$table_descr\n\n";
2581
2582     if ($comment and $comment_in_desc) {
2583         $pod .= "=head1 DESCRIPTION\n\n${comment}\n\n";
2584     }
2585     $pod .= "=cut\n\n";
2586
2587     return $pod;
2588 }
2589
2590 # generates the accompanying pod for a DBIC class method statement,
2591 # storing it with $self->_pod
2592 sub _make_pod {
2593     my $self   = shift;
2594     my $class  = shift;
2595     my $method = shift;
2596
2597     if ($method eq 'table') {
2598         my $table = $_[0];
2599         $table = $$table if ref $table eq 'SCALAR';
2600         $self->_pod($class, "=head1 TABLE: C<$table>");
2601         $self->_pod_cut($class);
2602     }
2603     elsif ( $method eq 'add_columns' ) {
2604         $self->_pod( $class, "=head1 ACCESSORS" );
2605         my $col_counter = 0;
2606         my @cols = @_;
2607         while( my ($name,$attrs) = splice @cols,0,2 ) {
2608             $col_counter++;
2609             $self->_pod( $class, '=head2 ' . $name  );
2610             $self->_pod( $class,
2611                 join "\n", map {
2612                     my $s = $attrs->{$_};
2613                     $s = !defined $s          ? 'undef'             :
2614                         length($s) == 0       ? '(empty string)'    :
2615                         ref($s) eq 'SCALAR'   ? $$s                 :
2616                         ref($s)               ? dumper_squashed $s  :
2617                         looks_like_number($s) ? $s                  : qq{'$s'};
2618
2619                     "  $_: $s"
2620                  } sort keys %$attrs,
2621             );
2622             if (my $comment = $self->__column_comment($self->class_to_table->{$class}, $col_counter, $name)) {
2623                 $self->_pod( $class, $comment );
2624             }
2625         }
2626         $self->_pod_cut( $class );
2627     } elsif ( $method =~ /^(belongs_to|has_many|might_have)$/ ) {
2628         $self->_pod( $class, "=head1 RELATIONS" ) unless $self->{_relations_started} { $class } ;
2629         my ( $accessor, $rel_class ) = @_;
2630         $self->_pod( $class, "=head2 $accessor" );
2631         $self->_pod( $class, 'Type: ' . $method );
2632         $self->_pod( $class, "Related object: L<$rel_class>" );
2633         $self->_pod_cut( $class );
2634         $self->{_relations_started} { $class } = 1;
2635     }
2636     elsif ($method eq 'add_unique_constraint') {
2637         $self->_pod($class, '=head1 UNIQUE CONSTRAINTS')
2638             unless $self->{_uniqs_started}{$class};
2639
2640         my ($name, $cols) = @_;
2641
2642         $self->_pod($class, "=head2 C<$name>");
2643         $self->_pod($class, '=over 4');
2644
2645         foreach my $col (@$cols) {
2646             $self->_pod($class, "=item \* L</$col>");
2647         }
2648
2649         $self->_pod($class, '=back');
2650         $self->_pod_cut($class);
2651
2652         $self->{_uniqs_started}{$class} = 1;
2653     }
2654     elsif ($method eq 'set_primary_key') {
2655         $self->_pod($class, "=head1 PRIMARY KEY");
2656         $self->_pod($class, '=over 4');
2657
2658         foreach my $col (@_) {
2659             $self->_pod($class, "=item \* L</$col>");
2660         }
2661
2662         $self->_pod($class, '=back');
2663         $self->_pod_cut($class);
2664     }
2665 }
2666
2667 sub _pod_class_list {
2668     my ($self, $class, $title, @classes) = @_;
2669
2670     return unless @classes && $self->generate_pod;
2671
2672     $self->_pod($class, "=head1 $title");
2673     $self->_pod($class, '=over 4');
2674
2675     foreach my $link (@classes) {
2676         $self->_pod($class, "=item * L<$link>");
2677     }
2678
2679     $self->_pod($class, '=back');
2680     $self->_pod_cut($class);
2681 }
2682
2683 sub _base_class_pod {
2684     my ($self, $base_class) = @_;
2685
2686     return '' unless $self->generate_pod;
2687
2688     return <<"EOF"
2689 =head1 BASE CLASS: L<$base_class>
2690
2691 =cut
2692
2693 EOF
2694 }
2695
2696 sub _filter_comment {
2697     my ($self, $txt) = @_;
2698
2699     $txt = '' if not defined $txt;
2700
2701     $txt =~ s/(?:\015?\012|\015\012?)/\n/g;
2702
2703     return $txt;
2704 }
2705
2706 sub __table_comment {
2707     my $self = shift;
2708
2709     if (my $code = $self->can('_table_comment')) {
2710         return $self->_filter_comment($self->$code(@_));
2711     }
2712
2713     return '';
2714 }
2715
2716 sub __column_comment {
2717     my $self = shift;
2718
2719     if (my $code = $self->can('_column_comment')) {
2720         return $self->_filter_comment($self->$code(@_));
2721     }
2722
2723     return '';
2724 }
2725
2726 # Stores a POD documentation
2727 sub _pod {
2728     my ($self, $class, $stmt) = @_;
2729     $self->_raw_stmt( $class, "\n" . $stmt  );
2730 }
2731
2732 sub _pod_cut {
2733     my ($self, $class ) = @_;
2734     $self->_raw_stmt( $class, "\n=cut\n" );
2735 }
2736
2737 # Store a raw source line for a class (for dumping purposes)
2738 sub _raw_stmt {
2739     my ($self, $class, $stmt) = @_;
2740     push(@{$self->{_dump_storage}->{$class}}, $stmt);
2741 }
2742
2743 # Like above, but separately for the externally loaded stuff
2744 sub _ext_stmt {
2745     my ($self, $class, $stmt) = @_;
2746     push(@{$self->{_ext_storage}->{$class}}, $stmt);
2747 }
2748
2749 sub _custom_column_info {
2750     my ( $self, $table_name, $column_name, $column_info ) = @_;
2751
2752     if (my $code = $self->custom_column_info) {
2753         return $code->($table_name, $column_name, $column_info) || {};
2754     }
2755     return {};
2756 }
2757
2758 sub _datetime_column_info {
2759     my ( $self, $table_name, $column_name, $column_info ) = @_;
2760     my $result = {};
2761     my $type = $column_info->{data_type} || '';
2762     if ((grep $_, @{ $column_info }{map "inflate_$_", qw/date datetime timestamp/})
2763             or ($type =~ /date|timestamp/i)) {
2764         $result->{timezone} = $self->datetime_timezone if $self->datetime_timezone;
2765         $result->{locale}   = $self->datetime_locale   if $self->datetime_locale;
2766     }
2767     return $result;
2768 }
2769
2770 sub _lc {
2771     my ($self, $name) = @_;
2772
2773     return $self->preserve_case ? $name : lc($name);
2774 }
2775
2776 sub _uc {
2777     my ($self, $name) = @_;
2778
2779     return $self->preserve_case ? $name : uc($name);
2780 }
2781
2782 sub _remove_table {
2783     my ($self, $table) = @_;
2784
2785     try {
2786         my $schema = $self->schema;
2787         # in older DBIC it's a private method
2788         my $unregister = $schema->can('unregister_source') || $schema->can('_unregister_source');
2789         $schema->$unregister(delete $self->monikers->{$table->sql_name});
2790         delete $self->_upgrading_classes->{delete $self->classes->{$table->sql_name}};
2791         delete $self->_tables->{$table->sql_name};
2792     };
2793 }
2794
2795 # remove the dump dir from @INC on destruction
2796 sub DESTROY {
2797     my $self = shift;
2798
2799     @INC = grep $_ ne $self->dump_directory, @INC;
2800 }
2801
2802 =head2 monikers
2803
2804 Returns a hashref of loaded table to moniker mappings.  There will
2805 be two entries for each table, the original name and the "normalized"
2806 name, in the case that the two are different (such as databases
2807 that like uppercase table names, or preserve your original mixed-case
2808 definitions, or what-have-you).
2809
2810 =head2 classes
2811
2812 Returns a hashref of table to class mappings.  In some cases it will
2813 contain multiple entries per table for the original and normalized table
2814 names, as above in L</monikers>.
2815
2816 =head1 NON-ENGLISH DATABASES
2817
2818 If you use the loader on a database with table and column names in a language
2819 other than English, you will want to turn off the English language specific
2820 heuristics.
2821
2822 To do so, use something like this in your loader options:
2823
2824     naming           => { monikers => 'v4' },
2825     inflect_singular => sub { "$_[0]_rel" },
2826     inflect_plural   => sub { "$_[0]_rel" },
2827
2828 =head1 COLUMN ACCESSOR COLLISIONS
2829
2830 Occasionally you may have a column name that collides with a perl method, such
2831 as C<can>. In such cases, the default action is to set the C<accessor> of the
2832 column spec to C<undef>.
2833
2834 You can then name the accessor yourself by placing code such as the following
2835 below the md5:
2836
2837     __PACKAGE__->add_column('+can' => { accessor => 'my_can' });
2838
2839 Another option is to use the L</col_collision_map> option.
2840
2841 =head1 RELATIONSHIP NAME COLLISIONS
2842
2843 In very rare cases, you may get a collision between a generated relationship
2844 name and a method in your Result class, for example if you have a foreign key
2845 called C<belongs_to>.
2846
2847 This is a problem because relationship names are also relationship accessor
2848 methods in L<DBIx::Class>.
2849
2850 The default behavior is to append C<_rel> to the relationship name and print
2851 out a warning that refers to this text.
2852
2853 You can also control the renaming with the L</rel_collision_map> option.
2854
2855 =head1 SEE ALSO
2856
2857 L<DBIx::Class::Schema::Loader>, L<dbicdump>
2858
2859 =head1 AUTHOR
2860
2861 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
2862
2863 =head1 LICENSE
2864
2865 This library is free software; you can redistribute it and/or modify it under
2866 the same terms as Perl itself.
2867
2868 =cut
2869
2870 1;
2871 # vim:et sts=4 sw=4 tw=0: