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