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