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