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 Class::C3;
   7 use Carp::Clan qw/^DBIx::Class/;
   8 use DBIx::Class::Schema::Loader::RelBuilder;
   9 use Data::Dump qw/ dump /;
  10 use POSIX qw//;
  11 use File::Spec qw//;
  12 use Cwd qw//;
  13 use Digest::MD5 qw//;
  14 use Lingua::EN::Inflect::Number qw//;
  15 use File::Temp qw//;
  16 use Class::Unload;
  17 require DBIx::Class;
  18
  19 our $VERSION = '0.04999_13';
  20
  21 __PACKAGE__->mk_group_ro_accessors('simple', qw/
  22                                 schema
  23                                 schema_class
  24
  25                                 exclude
  26                                 constraint
  27                                 additional_classes
  28                                 additional_base_classes
  29                                 left_base_classes
  30                                 components
  31                                 resultset_components
  32                                 skip_relationships
  33                                 skip_load_external
  34                                 moniker_map
  35                                 inflect_singular
  36                                 inflect_plural
  37                                 debug
  38                                 dump_directory
  39                                 dump_overwrite
  40                                 really_erase_my_files
  41                                 result_namespace
  42                                 resultset_namespace
  43                                 default_resultset_class
  44                                 schema_base_class
  45                                 result_base_class
  46                                 overwrite_modifications
  47
  48                                 relationship_attrs
  49
  50                                 db_schema
  51                                 _tables
  52                                 classes
  53                                 _upgrading_classes
  54                                 monikers
  55                                 dynamic
  56                                 naming
  57 /);
  58
  59
  60 __PACKAGE__->mk_group_accessors('simple', qw/
  61                                 version_to_dump
  62                                 schema_version_to_dump
  63                                 _upgrading_from
  64                                 _upgrading_from_load_classes
  65                                 _downgrading_to_load_classes
  66                                 use_namespaces
  67 /);
  68
  69 =head1 NAME
  70
  71 DBIx::Class::Schema::Loader::Base - Base DBIx::Class::Schema::Loader Implementation.
  72
  73 =head1 SYNOPSIS
  74
  75 See L<DBIx::Class::Schema::Loader>
  76
  77 =head1 DESCRIPTION
  78
  79 This is the base class for the storage-specific C<DBIx::Class::Schema::*>
  80 classes, and implements the common functionality between them.
  81
  82 =head1 CONSTRUCTOR OPTIONS
  83
  84 These constructor options are the base options for
  85 L<DBIx::Class::Schema::Loader/loader_options>.  Available constructor options are:
  86
  87 =head2 skip_relationships
  88
  89 Skip setting up relationships.  The default is to attempt the loading
  90 of relationships.
  91
  92 =head2 skip_load_external
  93
  94 Skip loading of other classes in @INC. The default is to merge all other classes
  95 with the same name found in @INC into the schema file we are creating.
  96
  97 =head2 naming
  98
  99 Static schemas (ones dumped to disk) will, by default, use the new-style 0.05XXX
 100 relationship names and singularized Results, unless you're overwriting an
 101 existing dump made by a 0.04XXX version of L<DBIx::Class::Schema::Loader>, in
 102 which case the backward compatible RelBuilder will be activated, and
 103 singularization will be turned off.
 104
 105 Specifying
 106
 107     naming => 'v5'
 108
 109 will disable the backward-compatible RelBuilder and use
 110 the new-style relationship names along with singularized Results, even when
 111 overwriting a dump made with an earlier version.
 112
 113 The option also takes a hashref:
 114
 115     naming => { relationships => 'v5', monikers => 'v4' }
 116
 117 The keys are:
 118
 119 =over 4
 120
 121 =item relationships
 122
 123 How to name relationship accessors.
 124
 125 =item monikers
 126
 127 How to name Result classes.
 128
 129 =back
 130
 131 The values can be:
 132
 133 =over 4
 134
 135 =item current
 136
 137 Latest default style, whatever that happens to be.
 138
 139 =item v5
 140
 141 Version 0.05XXX style.
 142
 143 =item v4
 144
 145 Version 0.04XXX style.
 146
 147 =back
 148
 149 Dynamic schemas will always default to the 0.04XXX relationship names and won't
 150 singularize Results for backward compatibility, to activate the new RelBuilder
 151 and singularization put this in your C<Schema.pm> file:
 152
 153     __PACKAGE__->naming('current');
 154
 155 Or if you prefer to use 0.05XXX features but insure that nothing breaks in the
 156 next major version upgrade:
 157
 158     __PACKAGE__->naming('v5');
 159
 160 =head2 relationship_attrs
 161
 162 Hashref of attributes to pass to each generated relationship, listed
 163 by type.  Also supports relationship type 'all', containing options to
 164 pass to all generated relationships.  Attributes set for more specific
 165 relationship types override those set in 'all'.
 166
 167 For example:
 168
 169   relationship_attrs => {
 170     all      => { cascade_delete => 0 },
 171     has_many => { cascade_delete => 1 },
 172   },
 173
 174 will set the C<cascade_delete> option to 0 for all generated relationships,
 175 except for C<has_many>, which will have cascade_delete as 1.
 176
 177 NOTE: this option is not supported if v4 backward-compatible naming is
 178 set either globally (naming => 'v4') or just for relationships.
 179
 180 =head2 debug
 181
 182 If set to true, each constructive L<DBIx::Class> statement the loader
 183 decides to execute will be C<warn>-ed before execution.
 184
 185 =head2 db_schema
 186
 187 Set the name of the schema to load (schema in the sense that your database
 188 vendor means it).  Does not currently support loading more than one schema
 189 name.
 190
 191 =head2 constraint
 192
 193 Only load tables matching regex.  Best specified as a qr// regex.
 194
 195 =head2 exclude
 196
 197 Exclude tables matching regex.  Best specified as a qr// regex.
 198
 199 =head2 moniker_map
 200
 201 Overrides the default table name to moniker translation.  Can be either
 202 a hashref of table keys and moniker values, or a coderef for a translator
 203 function taking a single scalar table name argument and returning
 204 a scalar moniker.  If the hash entry does not exist, or the function
 205 returns a false value, the code falls back to default behavior
 206 for that table name.
 207
 208 The default behavior is to singularize the table name, and: C<join '', map
 209 ucfirst, split /[\W_]+/, lc $table>, which is to say: lowercase everything,
 210 split up the table name into chunks anywhere a non-alpha-numeric character
 211 occurs, change the case of first letter of each chunk to upper case, and put
 212 the chunks back together.  Examples:
 213
 214     Table Name  | Moniker Name
 215     ---------------------------
 216     luser       | Luser
 217     luser_group | LuserGroup
 218     luser-opts  | LuserOpt
 219
 220 =head2 inflect_plural
 221
 222 Just like L</moniker_map> above (can be hash/code-ref, falls back to default
 223 if hash key does not exist or coderef returns false), but acts as a map
 224 for pluralizing relationship names.  The default behavior is to utilize
 225 L<Lingua::EN::Inflect::Number/to_PL>.
 226
 227 =head2 inflect_singular
 228
 229 As L</inflect_plural> above, but for singularizing relationship names.
 230 Default behavior is to utilize L<Lingua::EN::Inflect::Number/to_S>.
 231
 232 =head2 schema_base_class
 233
 234 Base class for your schema classes. Defaults to 'DBIx::Class::Schema'.
 235
 236 =head2 result_base_class
 237
 238 Base class for your table classes (aka result classes). Defaults to
 239 'DBIx::Class::Core'.
 240
 241 =head2 additional_base_classes
 242
 243 List of additional base classes all of your table classes will use.
 244
 245 =head2 left_base_classes
 246
 247 List of additional base classes all of your table classes will use
 248 that need to be leftmost.
 249
 250 =head2 additional_classes
 251
 252 List of additional classes which all of your table classes will use.
 253
 254 =head2 components
 255
 256 List of additional components to be loaded into all of your table
 257 classes.  A good example would be C<ResultSetManager>.
 258
 259 =head2 resultset_components
 260
 261 List of additional ResultSet components to be loaded into your table
 262 classes.  A good example would be C<AlwaysRS>.  Component
 263 C<ResultSetManager> will be automatically added to the above
 264 C<components> list if this option is set.
 265
 266 =head2 use_namespaces
 267
 268 This is now the default, to go back to L<DBIx::Class::Schema/load_classes> pass
 269 a C<0>.
 270
 271 Generate result class names suitable for
 272 L<DBIx::Class::Schema/load_namespaces> and call that instead of
 273 L<DBIx::Class::Schema/load_classes>. When using this option you can also
 274 specify any of the options for C<load_namespaces> (i.e. C<result_namespace>,
 275 C<resultset_namespace>, C<default_resultset_class>), and they will be added
 276 to the call (and the generated result class names adjusted appropriately).
 277
 278 =head2 dump_directory
 279
 280 This option is designed to be a tool to help you transition from this
 281 loader to a manually-defined schema when you decide it's time to do so.
 282
 283 The value of this option is a perl libdir pathname.  Within
 284 that directory this module will create a baseline manual
 285 L<DBIx::Class::Schema> module set, based on what it creates at runtime
 286 in memory.
 287
 288 The created schema class will have the same classname as the one on
 289 which you are setting this option (and the ResultSource classes will be
 290 based on this name as well).
 291
 292 Normally you wouldn't hard-code this setting in your schema class, as it
 293 is meant for one-time manual usage.
 294
 295 See L<DBIx::Class::Schema::Loader/dump_to_dir> for examples of the
 296 recommended way to access this functionality.
 297
 298 =head2 dump_overwrite
 299
 300 Deprecated.  See L</really_erase_my_files> below, which does *not* mean
 301 the same thing as the old C<dump_overwrite> setting from previous releases.
 302
 303 =head2 really_erase_my_files
 304
 305 Default false.  If true, Loader will unconditionally delete any existing
 306 files before creating the new ones from scratch when dumping a schema to disk.
 307
 308 The default behavior is instead to only replace the top portion of the
 309 file, up to and including the final stanza which contains
 310 C<# DO NOT MODIFY THIS OR ANYTHING ABOVE!>
 311 leaving any customizations you placed after that as they were.
 312
 313 When C<really_erase_my_files> is not set, if the output file already exists,
 314 but the aforementioned final stanza is not found, or the checksum
 315 contained there does not match the generated contents, Loader will
 316 croak and not touch the file.
 317
 318 You should really be using version control on your schema classes (and all
 319 of the rest of your code for that matter).  Don't blame me if a bug in this
 320 code wipes something out when it shouldn't have, you've been warned.
 321
 322 =head2 overwrite_modifications
 323
 324 Default false.  If false, when updating existing files, Loader will
 325 refuse to modify any Loader-generated code that has been modified
 326 since its last run (as determined by the checksum Loader put in its
 327 comment lines).
 328
 329 If true, Loader will discard any manual modifications that have been
 330 made to Loader-generated code.
 331
 332 Again, you should be using version control on your schema classes.  Be
 333 careful with this option.
 334
 335 =head1 METHODS
 336
 337 None of these methods are intended for direct invocation by regular
 338 users of L<DBIx::Class::Schema::Loader>.  Anything you can find here
 339 can also be found via standard L<DBIx::Class::Schema> methods somehow.
 340
 341 =cut
 342
 343 use constant CURRENT_V => 'v5';
 344
 345 # ensure that a peice of object data is a valid arrayref, creating
 346 # an empty one or encapsulating whatever's there.
 347 sub _ensure_arrayref {
 348     my $self = shift;
 349
 350     foreach (@_) {
 351         $self->{$_} ||= [];
 352         $self->{$_} = [ $self->{$_} ]
 353             unless ref $self->{$_} eq 'ARRAY';
 354     }
 355 }
 356
 357 =head2 new
 358
 359 Constructor for L<DBIx::Class::Schema::Loader::Base>, used internally
 360 by L<DBIx::Class::Schema::Loader>.
 361
 362 =cut
 363
 364 sub new {
 365     my ( $class, %args ) = @_;
 366
 367     my $self = { %args };
 368
 369     bless $self => $class;
 370
 371     $self->_ensure_arrayref(qw/additional_classes
 372                                additional_base_classes
 373                                left_base_classes
 374                                components
 375                                resultset_components
 376                               /);
 377
 378     push(@{$self->{components}}, 'ResultSetManager')
 379         if @{$self->{resultset_components}};
 380
 381     $self->{monikers} = {};
 382     $self->{classes} = {};
 383     $self->{_upgrading_classes} = {};
 384
 385     $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
 386     $self->{schema} ||= $self->{schema_class};
 387
 388     croak "dump_overwrite is deprecated.  Please read the"
 389         . " DBIx::Class::Schema::Loader::Base documentation"
 390             if $self->{dump_overwrite};
 391
 392     $self->{dynamic} = ! $self->{dump_directory};
 393     $self->{temp_directory} ||= File::Temp::tempdir( 'dbicXXXX',
 394                                                      TMPDIR  => 1,
 395                                                      CLEANUP => 1,
 396                                                    );
 397
 398     $self->{dump_directory} ||= $self->{temp_directory};
 399
 400     $self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
 401     $self->schema_version_to_dump($DBIx::Class::Schema::Loader::VERSION);
 402
 403     if ((not ref $self->naming) && defined $self->naming) {
 404         my $naming_ver = $self->naming;
 405         $self->{naming} = {
 406             relationships => $naming_ver,
 407             monikers => $naming_ver,
 408         };
 409     }
 410
 411     if ($self->naming) {
 412         for (values %{ $self->naming }) {
 413             $_ = CURRENT_V if $_ eq 'current';
 414         }
 415     }
 416     $self->{naming} ||= {};
 417
 418     $self->_check_back_compat;
 419
 420     $self->use_namespaces(1) unless defined $self->use_namespaces;
 421
 422     $self;
 423 }
 424
 425 sub _check_back_compat {
 426     my ($self) = @_;
 427
 428 # dynamic schemas will always be in 0.04006 mode, unless overridden
 429     if ($self->dynamic) {
 430 # just in case, though no one is likely to dump a dynamic schema
 431         $self->schema_version_to_dump('0.04006');
 432
 433         if (not %{ $self->naming }) {
 434             warn <<EOF unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
 435
 436 Dynamic schema detected, will run in 0.04006 mode.
 437
 438 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
 439 to disable this warning.
 440
 441 Also consider setting 'use_namespaces => 1' if/when upgrading.
 442
 443 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
 444 details.
 445 EOF
 446         }
 447         else {
 448             $self->_upgrading_from('v4');
 449         }
 450
 451         $self->naming->{relationships} ||= 'v4';
 452         $self->naming->{monikers}      ||= 'v4';
 453
 454         if ($self->use_namespaces) {
 455             $self->_upgrading_from_load_classes(1);
 456         }
 457         else {
 458             $self->use_namespaces(0);
 459         }
 460
 461         return;
 462     }
 463
 464 # otherwise check if we need backcompat mode for a static schema
 465     my $filename = $self->_get_dump_filename($self->schema_class);
 466     return unless -e $filename;
 467
 468     open(my $fh, '<', $filename)
 469         or croak "Cannot open '$filename' for reading: $!";
 470
 471     my $load_classes = 0;
 472     my $result_namespace;
 473
 474     while (<$fh>) {
 475         if (/^__PACKAGE__->load_classes;/) {
 476             $load_classes = 1;
 477         } elsif (($result_namespace) = /result_namespace => '([^']+)'/) {
 478         } elsif (my ($real_ver) =
 479                 /^# Created by DBIx::Class::Schema::Loader v(\d+\.\d+)/) {
 480
 481             if ($load_classes && (not defined $self->use_namespaces)) {
 482                 warn <<"EOF"  unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
 483
 484 'load_classes;' static schema detected, turning off 'use_namespaces'.
 485
 486 Set the 'use_namespaces' attribute or the SCHEMA_LOADER_BACKCOMPAT environment
 487 variable to disable this warning.
 488
 489 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
 490 details.
 491 EOF
 492                 $self->use_namespaces(0);
 493             }
 494             elsif ($load_classes && $self->use_namespaces) {
 495                 $self->_upgrading_from_load_classes(1);
 496             }
 497             elsif ((not $load_classes) && (not $self->use_namespaces)) {
 498                 $self->_downgrading_to_load_classes(
 499                     $result_namespace || 'Result'
 500                 );
 501             }
 502
 503             # XXX when we go past .0 this will need fixing
 504             my ($v) = $real_ver =~ /([1-9])/;
 505             $v = "v$v";
 506
 507             last if $v eq CURRENT_V || $real_ver =~ /^0\.\d\d999/;
 508
 509             if (not %{ $self->naming }) {
 510                 warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
 511
 512 Version $real_ver static schema detected, turning on backcompat mode.
 513
 514 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
 515 to disable this warning.
 516
 517 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
 518 details.
 519 EOF
 520             }
 521             else {
 522                 $self->_upgrading_from($v);
 523                 last;
 524             }
 525
 526             $self->naming->{relationships} ||= $v;
 527             $self->naming->{monikers}      ||= $v;
 528
 529             $self->schema_version_to_dump($real_ver);
 530
 531             last;
 532         }
 533     }
 534     close $fh;
 535 }
 536
 537 sub _find_file_in_inc {
 538     my ($self, $file) = @_;
 539
 540     foreach my $prefix (@INC) {
 541         my $fullpath = File::Spec->catfile($prefix, $file);
 542         return $fullpath if -f $fullpath
 543             and Cwd::abs_path($fullpath) ne
 544                (Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) || '');
 545     }
 546
 547     return;
 548 }
 549
 550 sub _class_path {
 551     my ($self, $class) = @_;
 552
 553     my $class_path = $class;
 554     $class_path =~ s{::}{/}g;
 555     $class_path .= '.pm';
 556
 557     return $class_path;
 558 }
 559
 560 sub _find_class_in_inc {
 561     my ($self, $class) = @_;
 562
 563     return $self->_find_file_in_inc($self->_class_path($class));
 564 }
 565
 566 sub _rewriting {
 567     my $self = shift;
 568
 569     return $self->_upgrading_from
 570         || $self->_upgrading_from_load_classes
 571         || $self->_downgrading_to_load_classes;
 572 }
 573
 574 sub _rewrite_old_classnames {
 575     my ($self, $code) = @_;
 576
 577     return $code unless $self->_rewriting;
 578
 579     my %old_classes = reverse %{ $self->_upgrading_classes };
 580
 581     my $re = join '|', keys %old_classes;
 582     $re = qr/\b($re)\b/;
 583
 584     $code =~ s/$re/$old_classes{$1} || $1/eg;
 585
 586     return $code;
 587 }
 588
 589 sub _load_external {
 590     my ($self, $class) = @_;
 591
 592     return if $self->{skip_load_external};
 593
 594     # so that we don't load our own classes, under any circumstances
 595     local *INC = [ grep $_ ne $self->dump_directory, @INC ];
 596
 597     my $real_inc_path = $self->_find_class_in_inc($class);
 598
 599     my $old_class = $self->_upgrading_classes->{$class}
 600         if $self->_rewriting;
 601
 602     my $old_real_inc_path = $self->_find_class_in_inc($old_class)
 603         if $old_class && $old_class ne $class;
 604
 605     return unless $real_inc_path || $old_real_inc_path;
 606
 607     if ($real_inc_path) {
 608         # If we make it to here, we loaded an external definition
 609         warn qq/# Loaded external class definition for '$class'\n/
 610             if $self->debug;
 611
 612         open(my $fh, '<', $real_inc_path)
 613             or croak "Failed to open '$real_inc_path' for reading: $!";
 614         my $code = do { local $/; <$fh> };
 615         close($fh)
 616             or croak "Failed to close $real_inc_path: $!";
 617         $code = $self->_rewrite_old_classnames($code);
 618
 619         if ($self->dynamic) { # load the class too
 620             # kill redefined warnings
 621             my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
 622             local $SIG{__WARN__} = sub {
 623                 $warn_handler->(@_)
 624                     unless $_[0] =~ /^Subroutine \S+ redefined/;
 625             };
 626             eval $code;
 627             die $@ if $@;
 628         }
 629
 630         $self->_ext_stmt($class,
 631           qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
 632          .qq|# They are now part of the custom portion of this file\n|
 633          .qq|# for you to hand-edit.  If you do not either delete\n|
 634          .qq|# this section or remove that file from \@INC, this section\n|
 635          .qq|# will be repeated redundantly when you re-create this\n|
 636          .qq|# file again via Loader!  See skip_load_external to disable\n|
 637          .qq|# this feature.\n|
 638         );
 639         chomp $code;
 640         $self->_ext_stmt($class, $code);
 641         $self->_ext_stmt($class,
 642             qq|# End of lines loaded from '$real_inc_path' |
 643         );
 644     }
 645
 646     if ($old_real_inc_path) {
 647         open(my $fh, '<', $old_real_inc_path)
 648             or croak "Failed to open '$old_real_inc_path' for reading: $!";
 649         $self->_ext_stmt($class, <<"EOF");
 650
 651 # These lines were loaded from '$old_real_inc_path',
 652 # based on the Result class name that would have been created by an 0.04006
 653 # version of the Loader. For a static schema, this happens only once during
 654 # upgrade. See skip_load_external to disable this feature.
 655 EOF
 656
 657         my $code = do {
 658             local ($/, @ARGV) = (undef, $old_real_inc_path); <>
 659         };
 660         $code = $self->_rewrite_old_classnames($code);
 661
 662         if ($self->dynamic) {
 663             warn <<"EOF";
 664
 665 Detected external content in '$old_real_inc_path', a class name that would have
 666 been used by an 0.04006 version of the Loader.
 667
 668 * PLEASE RENAME THIS CLASS: from '$old_class' to '$class', as that is the
 669 new name of the Result.
 670 EOF
 671             # kill redefined warnings
 672             my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
 673             local $SIG{__WARN__} = sub {
 674                 $warn_handler->(@_)
 675                     unless $_[0] =~ /^Subroutine \S+ redefined/;
 676             };
 677             eval $code;
 678             die $@ if $@;
 679         }
 680
 681         chomp $code;
 682         $self->_ext_stmt($class, $code);
 683         $self->_ext_stmt($class,
 684             qq|# End of lines loaded from '$old_real_inc_path' |
 685         );
 686     }
 687 }
 688
 689 =head2 load
 690
 691 Does the actual schema-construction work.
 692
 693 =cut
 694
 695 sub load {
 696     my $self = shift;
 697
 698     $self->_load_tables($self->_tables_list);
 699 }
 700
 701 =head2 rescan
 702
 703 Arguments: schema
 704
 705 Rescan the database for newly added tables.  Does
 706 not process drops or changes.  Returns a list of
 707 the newly added table monikers.
 708
 709 The schema argument should be the schema class
 710 or object to be affected.  It should probably
 711 be derived from the original schema_class used
 712 during L</load>.
 713
 714 =cut
 715
 716 sub rescan {
 717     my ($self, $schema) = @_;
 718
 719     $self->{schema} = $schema;
 720     $self->_relbuilder->{schema} = $schema;
 721
 722     my @created;
 723     my @current = $self->_tables_list;
 724     foreach my $table ($self->_tables_list) {
 725         if(!exists $self->{_tables}->{$table}) {
 726             push(@created, $table);
 727         }
 728     }
 729
 730     my $loaded = $self->_load_tables(@created);
 731
 732     return map { $self->monikers->{$_} } @$loaded;
 733 }
 734
 735 sub _relbuilder {
 736     no warnings 'uninitialized';
 737     my ($self) = @_;
 738
 739     return if $self->{skip_relationships};
 740
 741     if ($self->naming->{relationships} eq 'v4') {
 742         require DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_040;
 743         return $self->{relbuilder} ||=
 744             DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_040->new(
 745                 $self->schema, $self->inflect_plural, $self->inflect_singular
 746             );
 747     }
 748
 749     $self->{relbuilder} ||= DBIx::Class::Schema::Loader::RelBuilder->new (
 750          $self->schema,
 751          $self->inflect_plural,
 752          $self->inflect_singular,
 753          $self->relationship_attrs,
 754     );
 755 }
 756
 757 sub _load_tables {
 758     my ($self, @tables) = @_;
 759
 760     # First, use _tables_list with constraint and exclude
 761     #  to get a list of tables to operate on
 762
 763     my $constraint   = $self->constraint;
 764     my $exclude      = $self->exclude;
 765
 766     @tables = grep { /$constraint/ } @tables if $constraint;
 767     @tables = grep { ! /$exclude/ } @tables if $exclude;
 768
 769     # Save the new tables to the tables list
 770     foreach (@tables) {
 771         $self->{_tables}->{$_} = 1;
 772     }
 773
 774     $self->_make_src_class($_) for @tables;
 775     $self->_setup_src_meta($_) for @tables;
 776
 777     if(!$self->skip_relationships) {
 778         # The relationship loader needs a working schema
 779         $self->{quiet} = 1;
 780         local $self->{dump_directory} = $self->{temp_directory};
 781         $self->_reload_classes(\@tables);
 782         $self->_load_relationships($_) for @tables;
 783         $self->{quiet} = 0;
 784
 785         # Remove that temp dir from INC so it doesn't get reloaded
 786         @INC = grep $_ ne $self->dump_directory, @INC;
 787     }
 788
 789     $self->_load_external($_)
 790         for map { $self->classes->{$_} } @tables;
 791
 792     # Reload without unloading first to preserve any symbols from external
 793     # packages.
 794     $self->_reload_classes(\@tables, 0);
 795
 796     # Drop temporary cache
 797     delete $self->{_cache};
 798
 799     return \@tables;
 800 }
 801
 802 sub _reload_classes {
 803     my ($self, $tables, $unload) = @_;
 804
 805     my @tables = @$tables;
 806     $unload = 1 unless defined $unload;
 807
 808     # so that we don't repeat custom sections
 809     @INC = grep $_ ne $self->dump_directory, @INC;
 810
 811     $self->_dump_to_dir(map { $self->classes->{$_} } @tables);
 812
 813     unshift @INC, $self->dump_directory;
 814
 815     my @to_register;
 816     my %have_source = map { $_ => $self->schema->source($_) }
 817         $self->schema->sources;
 818
 819     for my $table (@tables) {
 820         my $moniker = $self->monikers->{$table};
 821         my $class = $self->classes->{$table};
 822
 823         {
 824             no warnings 'redefine';
 825             local *Class::C3::reinitialize = sub {};
 826             use warnings;
 827
 828             Class::Unload->unload($class) if $unload;
 829             my ($source, $resultset_class);
 830             if (
 831                 ($source = $have_source{$moniker})
 832                 && ($resultset_class = $source->resultset_class)
 833                 && ($resultset_class ne 'DBIx::Class::ResultSet')
 834             ) {
 835                 my $has_file = Class::Inspector->loaded_filename($resultset_class);
 836                 Class::Unload->unload($resultset_class) if $unload;
 837                 $self->_reload_class($resultset_class) if $has_file;
 838             }
 839             $self->_reload_class($class);
 840         }
 841         push @to_register, [$moniker, $class];
 842     }
 843
 844     Class::C3->reinitialize;
 845     for (@to_register) {
 846         $self->schema->register_class(@$_);
 847     }
 848 }
 849
 850 # We use this instead of ensure_class_loaded when there are package symbols we
 851 # want to preserve.
 852 sub _reload_class {
 853     my ($self, $class) = @_;
 854
 855     my $class_path = $self->_class_path($class);
 856     delete $INC{ $class_path };
 857
 858 # kill redefined warnings
 859     my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
 860     local $SIG{__WARN__} = sub {
 861         $warn_handler->(@_)
 862             unless $_[0] =~ /^Subroutine \S+ redefined/;
 863     };
 864     eval "require $class;";
 865 }
 866
 867 sub _get_dump_filename {
 868     my ($self, $class) = (@_);
 869
 870     $class =~ s{::}{/}g;
 871     return $self->dump_directory . q{/} . $class . q{.pm};
 872 }
 873
 874 sub _ensure_dump_subdirs {
 875     my ($self, $class) = (@_);
 876
 877     my @name_parts = split(/::/, $class);
 878     pop @name_parts; # we don't care about the very last element,
 879                      # which is a filename
 880
 881     my $dir = $self->dump_directory;
 882     while (1) {
 883         if(!-d $dir) {
 884             mkdir($dir) or croak "mkdir('$dir') failed: $!";
 885         }
 886         last if !@name_parts;
 887         $dir = File::Spec->catdir($dir, shift @name_parts);
 888     }
 889 }
 890
 891 sub _dump_to_dir {
 892     my ($self, @classes) = @_;
 893
 894     my $schema_class = $self->schema_class;
 895     my $schema_base_class = $self->schema_base_class || 'DBIx::Class::Schema';
 896
 897     my $target_dir = $self->dump_directory;
 898     warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
 899         unless $self->{dynamic} or $self->{quiet};
 900
 901     my $schema_text =
 902           qq|package $schema_class;\n\n|
 903         . qq|# Created by DBIx::Class::Schema::Loader\n|
 904         . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
 905         . qq|use strict;\nuse warnings;\n\n|
 906         . qq|use base '$schema_base_class';\n\n|;
 907
 908     if ($self->use_namespaces) {
 909         $schema_text .= qq|__PACKAGE__->load_namespaces|;
 910         my $namespace_options;
 911         for my $attr (qw(result_namespace
 912                          resultset_namespace
 913                          default_resultset_class)) {
 914             if ($self->$attr) {
 915                 $namespace_options .= qq|    $attr => '| . $self->$attr . qq|',\n|
 916             }
 917         }
 918         $schema_text .= qq|(\n$namespace_options)| if $namespace_options;
 919         $schema_text .= qq|;\n|;
 920     }
 921     else {
 922         $schema_text .= qq|__PACKAGE__->load_classes;\n|;
 923     }
 924
 925     {
 926         local $self->{version_to_dump} = $self->schema_version_to_dump;
 927         $self->_write_classfile($schema_class, $schema_text, 1);
 928     }
 929
 930     my $result_base_class = $self->result_base_class || 'DBIx::Class::Core';
 931
 932     foreach my $src_class (@classes) {
 933         my $src_text =
 934               qq|package $src_class;\n\n|
 935             . qq|# Created by DBIx::Class::Schema::Loader\n|
 936             . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
 937             . qq|use strict;\nuse warnings;\n\n|
 938             . qq|use base '$result_base_class';\n\n|;
 939
 940         $self->_write_classfile($src_class, $src_text);
 941     }
 942
 943     # remove Result dir if downgrading from use_namespaces, and there are no
 944     # files left.
 945     if (my $result_ns = $self->_downgrading_to_load_classes) {
 946         my $result_class;
 947
 948         if ($result_ns =~ /^\+(.*)/) {
 949             $result_class = $1;
 950         }
 951         else {
 952             $result_class = "${schema_class}::${result_ns}";
 953         }
 954
 955         (my $result_dir = $result_class) =~ s{::}{/}g;
 956         $result_dir = $self->dump_directory . '/' . $result_dir;
 957
 958         unless (my @files = glob "$result_dir/*") {
 959             rmdir $result_dir;
 960         }
 961     }
 962
 963     warn "Schema dump completed.\n" unless $self->{dynamic} or $self->{quiet};
 964
 965 }
 966
 967 sub _sig_comment {
 968     my ($self, $version, $ts) = @_;
 969     return qq|\n\n# Created by DBIx::Class::Schema::Loader|
 970          . qq| v| . $version
 971          . q| @ | . $ts
 972          . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
 973 }
 974
 975 sub _write_classfile {
 976     my ($self, $class, $text, $is_schema) = @_;
 977
 978     my $filename = $self->_get_dump_filename($class);
 979     $self->_ensure_dump_subdirs($class);
 980
 981     if (-f $filename && $self->really_erase_my_files) {
 982         warn "Deleting existing file '$filename' due to "
 983             . "'really_erase_my_files' setting\n" unless $self->{quiet};
 984         unlink($filename);
 985     }
 986
 987     my ($custom_content, $old_md5, $old_ver, $old_ts) = $self->_get_custom_content($class, $filename);
 988
 989     if (my $old_class = $self->_upgrading_classes->{$class}) {
 990         my $old_filename = $self->_get_dump_filename($old_class);
 991
 992         my ($old_custom_content) = $self->_get_custom_content(
 993             $old_class, $old_filename, 0 # do not add default comment
 994         );
 995
 996         $old_custom_content =~ s/\n\n# You can replace.*\n1;\n//;
 997
 998         if ($old_custom_content) {
 999             $custom_content =
1000                 "\n" . $old_custom_content . "\n" . $custom_content;
1001         }
1002
1003         unlink $old_filename;
1004     }
1005
1006     $custom_content = $self->_rewrite_old_classnames($custom_content);
1007
1008     $text .= qq|$_\n|
1009         for @{$self->{_dump_storage}->{$class} || []};
1010
1011     # Check and see if the dump is infact differnt
1012
1013     my $compare_to;
1014     if ($old_md5) {
1015       $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
1016
1017
1018       if (Digest::MD5::md5_base64($compare_to) eq $old_md5) {
1019         return unless $self->_upgrading_from && $is_schema;
1020       }
1021     }
1022
1023     $text .= $self->_sig_comment(
1024       $self->version_to_dump,
1025       POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
1026     );
1027
1028     open(my $fh, '>', $filename)
1029         or croak "Cannot open '$filename' for writing: $!";
1030
1031     # Write the top half and its MD5 sum
1032     print $fh $text . Digest::MD5::md5_base64($text) . "\n";
1033
1034     # Write out anything loaded via external partial class file in @INC
1035     print $fh qq|$_\n|
1036         for @{$self->{_ext_storage}->{$class} || []};
1037
1038     # Write out any custom content the user has added
1039     print $fh $custom_content;
1040
1041     close($fh)
1042         or croak "Error closing '$filename': $!";
1043 }
1044
1045 sub _default_custom_content {
1046     return qq|\n\n# You can replace this text with custom|
1047          . qq| content, and it will be preserved on regeneration|
1048          . qq|\n1;\n|;
1049 }
1050
1051 sub _get_custom_content {
1052     my ($self, $class, $filename, $add_default) = @_;
1053
1054     $add_default = 1 unless defined $add_default;
1055
1056     return ($self->_default_custom_content) if ! -f $filename;
1057
1058     open(my $fh, '<', $filename)
1059         or croak "Cannot open '$filename' for reading: $!";
1060
1061     my $mark_re =
1062         qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n};
1063
1064     my $buffer = '';
1065     my ($md5, $ts, $ver);
1066     while(<$fh>) {
1067         if(!$md5 && /$mark_re/) {
1068             $md5 = $2;
1069             my $line = $1;
1070
1071             # Pull out the previous version and timestamp
1072             ($ver, $ts) = $buffer =~ m/# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)$/s;
1073
1074             $buffer .= $line;
1075             croak "Checksum mismatch in '$filename', 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"
1076                 if !$self->overwrite_modifications && Digest::MD5::md5_base64($buffer) ne $md5;
1077
1078             $buffer = '';
1079         }
1080         else {
1081             $buffer .= $_;
1082         }
1083     }
1084
1085     croak "Cannot not overwrite '$filename' without 'really_erase_my_files',"
1086         . " it does not appear to have been generated by Loader"
1087             if !$md5;
1088
1089     # Default custom content:
1090     $buffer ||= $self->_default_custom_content if $add_default;
1091
1092     return ($buffer, $md5, $ver, $ts);
1093 }
1094
1095 sub _use {
1096     my $self = shift;
1097     my $target = shift;
1098
1099     foreach (@_) {
1100         warn "$target: use $_;" if $self->debug;
1101         $self->_raw_stmt($target, "use $_;");
1102     }
1103 }
1104
1105 sub _inject {
1106     my $self = shift;
1107     my $target = shift;
1108     my $schema_class = $self->schema_class;
1109
1110     my $blist = join(q{ }, @_);
1111     warn "$target: use base qw/ $blist /;" if $self->debug && @_;
1112     $self->_raw_stmt($target, "use base qw/ $blist /;") if @_;
1113 }
1114
1115 # Create class with applicable bases, setup monikers, etc
1116 sub _make_src_class {
1117     my ($self, $table) = @_;
1118
1119     my $schema       = $self->schema;
1120     my $schema_class = $self->schema_class;
1121
1122     my $table_moniker = $self->_table2moniker($table);
1123     my @result_namespace = ($schema_class);
1124     if ($self->use_namespaces) {
1125         my $result_namespace = $self->result_namespace || 'Result';
1126         if ($result_namespace =~ /^\+(.*)/) {
1127             # Fully qualified namespace
1128             @result_namespace =  ($1)
1129         }
1130         else {
1131             # Relative namespace
1132             push @result_namespace, $result_namespace;
1133         }
1134     }
1135     my $table_class = join(q{::}, @result_namespace, $table_moniker);
1136
1137     if ((my $upgrading_v = $self->_upgrading_from)
1138             || $self->_rewriting) {
1139         local $self->naming->{monikers} = $upgrading_v
1140             if $upgrading_v;
1141
1142         my @result_namespace = @result_namespace;
1143         if ($self->_upgrading_from_load_classes) {
1144             @result_namespace = ($schema_class);
1145         }
1146         elsif (my $ns = $self->_downgrading_to_load_classes) {
1147             if ($ns =~ /^\+(.*)/) {
1148                 # Fully qualified namespace
1149                 @result_namespace = ($1)
1150             }
1151             else {
1152                 # Relative namespace
1153                 @result_namespace = ($schema_class, $ns);
1154             }
1155         }
1156
1157         my $old_class = join(q{::}, @result_namespace,
1158             $self->_table2moniker($table));
1159
1160         $self->_upgrading_classes->{$table_class} = $old_class
1161             unless $table_class eq $old_class;
1162     }
1163
1164     my $table_normalized = lc $table;
1165     $self->classes->{$table} = $table_class;
1166     $self->classes->{$table_normalized} = $table_class;
1167     $self->monikers->{$table} = $table_moniker;
1168     $self->monikers->{$table_normalized} = $table_moniker;
1169
1170     $self->_use   ($table_class, @{$self->additional_classes});
1171     $self->_inject($table_class, @{$self->left_base_classes});
1172
1173     if (my @components = @{ $self->components }) {
1174         $self->_dbic_stmt($table_class, 'load_components', @components);
1175     }
1176
1177     $self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
1178         if @{$self->resultset_components};
1179     $self->_inject($table_class, @{$self->additional_base_classes});
1180 }
1181
1182 # Set up metadata (cols, pks, etc)
1183 sub _setup_src_meta {
1184     my ($self, $table) = @_;
1185
1186     my $schema       = $self->schema;
1187     my $schema_class = $self->schema_class;
1188
1189     my $table_class = $self->classes->{$table};
1190     my $table_moniker = $self->monikers->{$table};
1191
1192     my $table_name = $table;
1193     my $name_sep   = $self->schema->storage->sql_maker->name_sep;
1194
1195     if ($name_sep && $table_name =~ /\Q$name_sep\E/) {
1196         $table_name = \ $self->_quote_table_name($table_name);
1197     }
1198
1199     $self->_dbic_stmt($table_class,'table',$table_name);
1200
1201     my $cols = $self->_table_columns($table);
1202     my $col_info;
1203     eval { $col_info = $self->_columns_info_for($table) };
1204     if($@) {
1205         $self->_dbic_stmt($table_class,'add_columns',@$cols);
1206     }
1207     else {
1208         if ($self->_is_case_sensitive) {
1209             for my $col (keys %$col_info) {
1210                 $col_info->{$col}{accessor} = lc $col
1211                     if $col ne lc($col);
1212             }
1213         } else {
1214             $col_info = { map { lc($_), $col_info->{$_} } keys %$col_info };
1215         }
1216
1217         my $fks = $self->_table_fk_info($table);
1218
1219         for my $fkdef (@$fks) {
1220             for my $col (@{ $fkdef->{local_columns} }) {
1221                 $col_info->{$col}{is_foreign_key} = 1;
1222             }
1223         }
1224         $self->_dbic_stmt(
1225             $table_class,
1226             'add_columns',
1227             map { $_, ($col_info->{$_}||{}) } @$cols
1228         );
1229     }
1230
1231     my %uniq_tag; # used to eliminate duplicate uniqs
1232
1233     my $pks = $self->_table_pk_info($table) || [];
1234     @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
1235           : carp("$table has no primary key");
1236     $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
1237
1238     my $uniqs = $self->_table_uniq_info($table) || [];
1239     for (@$uniqs) {
1240         my ($name, $cols) = @$_;
1241         next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
1242         $self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
1243     }
1244
1245 }
1246
1247 =head2 tables
1248
1249 Returns a sorted list of loaded tables, using the original database table
1250 names.
1251
1252 =cut
1253
1254 sub tables {
1255     my $self = shift;
1256
1257     return keys %{$self->_tables};
1258 }
1259
1260 # Make a moniker from a table
1261 sub _default_table2moniker {
1262     no warnings 'uninitialized';
1263     my ($self, $table) = @_;
1264
1265     if ($self->naming->{monikers} eq 'v4') {
1266         return join '', map ucfirst, split /[\W_]+/, lc $table;
1267     }
1268
1269     return join '', map ucfirst, split /[\W_]+/,
1270         Lingua::EN::Inflect::Number::to_S(lc $table);
1271 }
1272
1273 sub _table2moniker {
1274     my ( $self, $table ) = @_;
1275
1276     my $moniker;
1277
1278     if( ref $self->moniker_map eq 'HASH' ) {
1279         $moniker = $self->moniker_map->{$table};
1280     }
1281     elsif( ref $self->moniker_map eq 'CODE' ) {
1282         $moniker = $self->moniker_map->($table);
1283     }
1284
1285     $moniker ||= $self->_default_table2moniker($table);
1286
1287     return $moniker;
1288 }
1289
1290 sub _load_relationships {
1291     my ($self, $table) = @_;
1292
1293     my $tbl_fk_info = $self->_table_fk_info($table);
1294     foreach my $fkdef (@$tbl_fk_info) {
1295         $fkdef->{remote_source} =
1296             $self->monikers->{delete $fkdef->{remote_table}};
1297     }
1298     my $tbl_uniq_info = $self->_table_uniq_info($table);
1299
1300     my $local_moniker = $self->monikers->{$table};
1301     my $rel_stmts = $self->_relbuilder->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
1302
1303     foreach my $src_class (sort keys %$rel_stmts) {
1304         my $src_stmts = $rel_stmts->{$src_class};
1305         foreach my $stmt (@$src_stmts) {
1306             $self->_dbic_stmt($src_class,$stmt->{method},@{$stmt->{args}});
1307         }
1308     }
1309 }
1310
1311 # Overload these in driver class:
1312
1313 # Returns an arrayref of column names
1314 sub _table_columns { croak "ABSTRACT METHOD" }
1315
1316 # Returns arrayref of pk col names
1317 sub _table_pk_info { croak "ABSTRACT METHOD" }
1318
1319 # Returns an arrayref of uniqs [ [ foo => [ col1, col2 ] ], [ bar => [ ... ] ] ]
1320 sub _table_uniq_info { croak "ABSTRACT METHOD" }
1321
1322 # Returns an arrayref of foreign key constraints, each
1323 #   being a hashref with 3 keys:
1324 #   local_columns (arrayref), remote_columns (arrayref), remote_table
1325 sub _table_fk_info { croak "ABSTRACT METHOD" }
1326
1327 # Returns an array of lower case table names
1328 sub _tables_list { croak "ABSTRACT METHOD" }
1329
1330 # Execute a constructive DBIC class method, with debug/dump_to_dir hooks.
1331 sub _dbic_stmt {
1332     my $self   = shift;
1333     my $class  = shift;
1334     my $method = shift;
1335
1336     # generate the pod for this statement, storing it with $self->_pod
1337     $self->_make_pod( $class, $method, @_ );
1338
1339     my $args = dump(@_);
1340     $args = '(' . $args . ')' if @_ < 2;
1341     my $stmt = $method . $args . q{;};
1342
1343     warn qq|$class\->$stmt\n| if $self->debug;
1344     $self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
1345     return;
1346 }
1347
1348 # generates the accompanying pod for a DBIC class method statement,
1349 # storing it with $self->_pod
1350 sub _make_pod {
1351     my $self   = shift;
1352     my $class  = shift;
1353     my $method = shift;
1354
1355     if ( $method eq 'table' ) {
1356         my ($table) = @_;
1357         $self->_pod( $class, "=head1 NAME" );
1358         my $table_descr = $class;
1359         if ( $self->can('_table_comment') ) {
1360             my $comment = $self->_table_comment($table);
1361             $table_descr .= " - " . $comment if $comment;
1362         }
1363         $self->{_class2table}{ $class } = $table;
1364         $self->_pod( $class, $table_descr );
1365         $self->_pod_cut( $class );
1366     } elsif ( $method eq 'add_columns' ) {
1367         $self->_pod( $class, "=head1 ACCESSORS" );
1368         my $col_counter = 0;
1369         my @cols = @_;
1370         while( my ($name,$attrs) = splice @cols,0,2 ) {
1371             $col_counter++;
1372             $self->_pod( $class, '=head2 ' . $name  );
1373             $self->_pod( $class,
1374                          join "\n", map {
1375                              my $s = $attrs->{$_};
1376                              $s = !defined $s      ? 'undef'          :
1377                                   length($s) == 0  ? '(empty string)' :
1378                                                      $s;
1379
1380                              "  $_: $s"
1381                          } sort keys %$attrs,
1382                        );
1383
1384             if( $self->can('_column_comment')
1385                 and my $comment = $self->_column_comment( $self->{_class2table}{$class}, $col_counter)
1386               ) {
1387                 $self->_pod( $class, $comment );
1388             }
1389         }
1390         $self->_pod_cut( $class );
1391     } elsif ( $method =~ /^(belongs_to|has_many|might_have)$/ ) {
1392         $self->_pod( $class, "=head1 RELATIONS" ) unless $self->{_relations_started} { $class } ;
1393         my ( $accessor, $rel_class ) = @_;
1394         $self->_pod( $class, "=head2 $accessor" );
1395         $self->_pod( $class, 'Type: ' . $method );
1396         $self->_pod( $class, "Related object: L<$rel_class>" );
1397         $self->_pod_cut( $class );
1398         $self->{_relations_started} { $class } = 1;
1399     }
1400 }
1401
1402 # Stores a POD documentation
1403 sub _pod {
1404     my ($self, $class, $stmt) = @_;
1405     $self->_raw_stmt( $class, "\n" . $stmt  );
1406 }
1407
1408 sub _pod_cut {
1409     my ($self, $class ) = @_;
1410     $self->_raw_stmt( $class, "\n=cut\n" );
1411 }
1412
1413
1414 # Store a raw source line for a class (for dumping purposes)
1415 sub _raw_stmt {
1416     my ($self, $class, $stmt) = @_;
1417     push(@{$self->{_dump_storage}->{$class}}, $stmt);
1418 }
1419
1420 # Like above, but separately for the externally loaded stuff
1421 sub _ext_stmt {
1422     my ($self, $class, $stmt) = @_;
1423     push(@{$self->{_ext_storage}->{$class}}, $stmt);
1424 }
1425
1426 sub _quote_table_name {
1427     my ($self, $table) = @_;
1428
1429     my $qt = $self->schema->storage->sql_maker->quote_char;
1430
1431     return $table unless $qt;
1432
1433     if (ref $qt) {
1434         return $qt->[0] . $table . $qt->[1];
1435     }
1436
1437     return $qt . $table . $qt;
1438 }
1439
1440 sub _is_case_sensitive { 0 }
1441
1442 # remove the dump dir from @INC on destruction
1443 sub DESTROY {
1444     my $self = shift;
1445
1446     @INC = grep $_ ne $self->dump_directory, @INC;
1447 }
1448
1449 =head2 monikers
1450
1451 Returns a hashref of loaded table to moniker mappings.  There will
1452 be two entries for each table, the original name and the "normalized"
1453 name, in the case that the two are different (such as databases
1454 that like uppercase table names, or preserve your original mixed-case
1455 definitions, or what-have-you).
1456
1457 =head2 classes
1458
1459 Returns a hashref of table to class mappings.  In some cases it will
1460 contain multiple entries per table for the original and normalized table
1461 names, as above in L</monikers>.
1462
1463 =head1 SEE ALSO
1464
1465 L<DBIx::Class::Schema::Loader>
1466
1467 =head1 AUTHOR
1468
1469 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
1470
1471 =head1 LICENSE
1472
1473 This library is free software; you can redistribute it and/or modify it under
1474 the same terms as Perl itself.
1475
1476 =cut
1477
1478 1;