lib/DBIx/Class/Schema/Loader/Base.pm

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