1 package DBIx::Class::Schema::Loader::Base;
5 use base qw/Class::Accessor::Fast Class::C3::Componentised/;
7 use Carp::Clan qw/^DBIx::Class/;
8 use DBIx::Class::Schema::Loader::RelBuilder;
9 use Data::Dump qw/ dump /;
14 use Lingua::EN::Inflect::Number qw//;
19 our $VERSION = '0.04999_12';
21 __PACKAGE__->mk_ro_accessors(qw/
28 additional_base_classes
43 default_resultset_class
56 __PACKAGE__->mk_accessors(qw/
58 schema_version_to_dump
63 DBIx::Class::Schema::Loader::Base - Base DBIx::Class::Schema::Loader Implementation.
67 See L<DBIx::Class::Schema::Loader>
71 This is the base class for the storage-specific C<DBIx::Class::Schema::*>
72 classes, and implements the common functionality between them.
74 =head1 CONSTRUCTOR OPTIONS
76 These constructor options are the base options for
77 L<DBIx::Class::Schema::Loader/loader_options>. Available constructor options are:
79 =head2 skip_relationships
81 Skip setting up relationships. The default is to attempt the loading
86 Static schemas (ones dumped to disk) will, by default, use the new-style 0.05XXX
87 relationship names and singularized Results, unless you're overwriting an
88 existing dump made by a 0.04XXX version of L<DBIx::Class::Schema::Loader>, in
89 which case the backward compatible RelBuilder will be activated, and
90 singularization will be turned off.
96 will disable the backward-compatible RelBuilder and use
97 the new-style relationship names along with singularized Results, even when
98 overwriting a dump made with an earlier version.
100 The option also takes a hashref:
102 naming => { relationships => 'v5', monikers => 'v4' }
110 How to name relationship accessors.
114 How to name Result classes.
124 Latest default style, whatever that happens to be.
128 Version 0.05XXX style.
132 Version 0.04XXX style.
136 Dynamic schemas will always default to the 0.04XXX relationship names and won't
137 singularize Results for backward compatibility, to activate the new RelBuilder
138 and singularization put this in your C<Schema.pm> file:
140 __PACKAGE__->naming('current');
142 Or if you prefer to use 0.05XXX features but insure that nothing breaks in the
143 next major version upgrade:
145 __PACKAGE__->naming('v5');
149 If set to true, each constructive L<DBIx::Class> statement the loader
150 decides to execute will be C<warn>-ed before execution.
154 Set the name of the schema to load (schema in the sense that your database
155 vendor means it). Does not currently support loading more than one schema
160 Only load tables matching regex. Best specified as a qr// regex.
164 Exclude tables matching regex. Best specified as a qr// regex.
168 Overrides the default table name to moniker translation. Can be either
169 a hashref of table keys and moniker values, or a coderef for a translator
170 function taking a single scalar table name argument and returning
171 a scalar moniker. If the hash entry does not exist, or the function
172 returns a false value, the code falls back to default behavior
175 The default behavior is to singularize the table name, and: C<join '', map
176 ucfirst, split /[\W_]+/, lc $table>, which is to say: lowercase everything,
177 split up the table name into chunks anywhere a non-alpha-numeric character
178 occurs, change the case of first letter of each chunk to upper case, and put
179 the chunks back together. Examples:
181 Table Name | Moniker Name
182 ---------------------------
184 luser_group | LuserGroup
185 luser-opts | LuserOpts
187 =head2 inflect_plural
189 Just like L</moniker_map> above (can be hash/code-ref, falls back to default
190 if hash key does not exist or coderef returns false), but acts as a map
191 for pluralizing relationship names. The default behavior is to utilize
192 L<Lingua::EN::Inflect::Number/to_PL>.
194 =head2 inflect_singular
196 As L</inflect_plural> above, but for singularizing relationship names.
197 Default behavior is to utilize L<Lingua::EN::Inflect::Number/to_S>.
199 =head2 schema_base_class
201 Base class for your schema classes. Defaults to 'DBIx::Class::Schema'.
203 =head2 result_base_class
205 Base class for your table classes (aka result classes). Defaults to
208 =head2 additional_base_classes
210 List of additional base classes all of your table classes will use.
212 =head2 left_base_classes
214 List of additional base classes all of your table classes will use
215 that need to be leftmost.
217 =head2 additional_classes
219 List of additional classes which all of your table classes will use.
223 List of additional components to be loaded into all of your table
224 classes. A good example would be C<ResultSetManager>.
226 =head2 resultset_components
228 List of additional ResultSet components to be loaded into your table
229 classes. A good example would be C<AlwaysRS>. Component
230 C<ResultSetManager> will be automatically added to the above
231 C<components> list if this option is set.
233 =head2 use_namespaces
235 Generate result class names suitable for
236 L<DBIx::Class::Schema/load_namespaces> and call that instead of
237 L<DBIx::Class::Schema/load_classes>. When using this option you can also
238 specify any of the options for C<load_namespaces> (i.e. C<result_namespace>,
239 C<resultset_namespace>, C<default_resultset_class>), and they will be added
240 to the call (and the generated result class names adjusted appropriately).
242 =head2 dump_directory
244 This option is designed to be a tool to help you transition from this
245 loader to a manually-defined schema when you decide it's time to do so.
247 The value of this option is a perl libdir pathname. Within
248 that directory this module will create a baseline manual
249 L<DBIx::Class::Schema> module set, based on what it creates at runtime
252 The created schema class will have the same classname as the one on
253 which you are setting this option (and the ResultSource classes will be
254 based on this name as well).
256 Normally you wouldn't hard-code this setting in your schema class, as it
257 is meant for one-time manual usage.
259 See L<DBIx::Class::Schema::Loader/dump_to_dir> for examples of the
260 recommended way to access this functionality.
262 =head2 dump_overwrite
264 Deprecated. See L</really_erase_my_files> below, which does *not* mean
265 the same thing as the old C<dump_overwrite> setting from previous releases.
267 =head2 really_erase_my_files
269 Default false. If true, Loader will unconditionally delete any existing
270 files before creating the new ones from scratch when dumping a schema to disk.
272 The default behavior is instead to only replace the top portion of the
273 file, up to and including the final stanza which contains
274 C<# DO NOT MODIFY THIS OR ANYTHING ABOVE!>
275 leaving any customizations you placed after that as they were.
277 When C<really_erase_my_files> is not set, if the output file already exists,
278 but the aforementioned final stanza is not found, or the checksum
279 contained there does not match the generated contents, Loader will
280 croak and not touch the file.
282 You should really be using version control on your schema classes (and all
283 of the rest of your code for that matter). Don't blame me if a bug in this
284 code wipes something out when it shouldn't have, you've been warned.
288 None of these methods are intended for direct invocation by regular
289 users of L<DBIx::Class::Schema::Loader>. Anything you can find here
290 can also be found via standard L<DBIx::Class::Schema> methods somehow.
294 use constant CURRENT_V => 'v5';
296 # ensure that a peice of object data is a valid arrayref, creating
297 # an empty one or encapsulating whatever's there.
298 sub _ensure_arrayref {
303 $self->{$_} = [ $self->{$_} ]
304 unless ref $self->{$_} eq 'ARRAY';
310 Constructor for L<DBIx::Class::Schema::Loader::Base>, used internally
311 by L<DBIx::Class::Schema::Loader>.
316 my ( $class, %args ) = @_;
318 my $self = { %args };
320 bless $self => $class;
322 $self->_ensure_arrayref(qw/additional_classes
323 additional_base_classes
329 push(@{$self->{components}}, 'ResultSetManager')
330 if @{$self->{resultset_components}};
332 $self->{monikers} = {};
333 $self->{classes} = {};
335 $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
336 $self->{schema} ||= $self->{schema_class};
338 croak "dump_overwrite is deprecated. Please read the"
339 . " DBIx::Class::Schema::Loader::Base documentation"
340 if $self->{dump_overwrite};
342 $self->{dynamic} = ! $self->{dump_directory};
343 $self->{temp_directory} ||= File::Temp::tempdir( 'dbicXXXX',
348 $self->{dump_directory} ||= $self->{temp_directory};
350 $self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
351 $self->schema_version_to_dump($DBIx::Class::Schema::Loader::VERSION);
353 if ((not ref $self->naming) && defined $self->naming) {
354 my $naming_ver = $self->naming;
356 relationships => $naming_ver,
357 monikers => $naming_ver,
362 for (values %{ $self->naming }) {
363 $_ = CURRENT_V if $_ eq 'current';
366 $self->{naming} ||= {};
368 $self->_check_back_compat;
373 sub _check_back_compat {
376 # dynamic schemas will always be in 0.04006 mode, unless overridden
377 if ($self->dynamic) {
378 # just in case, though no one is likely to dump a dynamic schema
379 $self->schema_version_to_dump('0.04006');
381 if (not %{ $self->naming }) {
382 warn <<EOF unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
384 Dynamic schema detected, will run in 0.04006 mode.
386 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
387 to disable this warning.
391 $self->naming->{relationships} ||= 'v4';
392 $self->naming->{monikers} ||= 'v4';
397 # otherwise check if we need backcompat mode for a static schema
398 my $filename = $self->_get_dump_filename($self->schema_class);
399 return unless -e $filename;
401 open(my $fh, '<', $filename)
402 or croak "Cannot open '$filename' for reading: $!";
405 if (/^# Created by DBIx::Class::Schema::Loader v((\d+)\.(\d+))/) {
408 $self->schema_version_to_dump($real_ver);
410 # XXX when we go past .0 this will need fixing
411 my ($v) = $real_ver =~ /([1-9])/;
414 $self->naming->{relationships} ||= $v;
415 $self->naming->{monikers} ||= $v;
423 sub _find_file_in_inc {
424 my ($self, $file) = @_;
426 foreach my $prefix (@INC) {
427 my $fullpath = File::Spec->catfile($prefix, $file);
428 return $fullpath if -f $fullpath
429 and Cwd::abs_path($fullpath) ne
430 Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) || '';
437 my ($self, $class) = @_;
439 my $class_path = $class;
440 $class_path =~ s{::}{/}g;
441 $class_path .= '.pm';
446 sub _find_class_in_inc {
447 my ($self, $class) = @_;
449 return $self->_find_file_in_inc($self->_class_path($class));
453 my ($self, $class) = @_;
455 my $real_inc_path = $self->_find_class_in_inc($class);
457 return if !$real_inc_path;
459 # If we make it to here, we loaded an external definition
460 warn qq/# Loaded external class definition for '$class'\n/
463 open(my $fh, '<', $real_inc_path)
464 or croak "Failed to open '$real_inc_path' for reading: $!";
465 $self->_ext_stmt($class,
466 qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
467 .qq|# They are now part of the custom portion of this file\n|
468 .qq|# for you to hand-edit. If you do not either delete\n|
469 .qq|# this section or remove that file from \@INC, this section\n|
470 .qq|# will be repeated redundantly when you re-create this\n|
471 .qq|# file again via Loader!\n|
475 $self->_ext_stmt($class, $_);
477 $self->_ext_stmt($class,
478 qq|# End of lines loaded from '$real_inc_path' |
481 or croak "Failed to close $real_inc_path: $!";
483 if ($self->dynamic) { # load the class too
484 # turn off redefined warnings
485 local $SIG{__WARN__} = sub {};
493 Does the actual schema-construction work.
500 $self->_load_tables($self->_tables_list);
507 Rescan the database for newly added tables. Does
508 not process drops or changes. Returns a list of
509 the newly added table monikers.
511 The schema argument should be the schema class
512 or object to be affected. It should probably
513 be derived from the original schema_class used
519 my ($self, $schema) = @_;
521 $self->{schema} = $schema;
522 $self->_relbuilder->{schema} = $schema;
525 my @current = $self->_tables_list;
526 foreach my $table ($self->_tables_list) {
527 if(!exists $self->{_tables}->{$table}) {
528 push(@created, $table);
532 my $loaded = $self->_load_tables(@created);
534 return map { $self->monikers->{$_} } @$loaded;
538 no warnings 'uninitialized';
541 return if $self->{skip_relationships};
543 if ($self->naming->{relationships} eq 'v4') {
544 require DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_040;
545 return $self->{relbuilder} ||=
546 DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_040->new(
547 $self->schema, $self->inflect_plural, $self->inflect_singular
551 $self->{relbuilder} ||= DBIx::Class::Schema::Loader::RelBuilder->new(
552 $self->schema, $self->inflect_plural, $self->inflect_singular
557 my ($self, @tables) = @_;
559 # First, use _tables_list with constraint and exclude
560 # to get a list of tables to operate on
562 my $constraint = $self->constraint;
563 my $exclude = $self->exclude;
565 @tables = grep { /$constraint/ } @tables if $constraint;
566 @tables = grep { ! /$exclude/ } @tables if $exclude;
568 # Save the new tables to the tables list
570 $self->{_tables}->{$_} = 1;
573 $self->_make_src_class($_) for @tables;
574 $self->_setup_src_meta($_) for @tables;
576 if(!$self->skip_relationships) {
577 # The relationship loader needs a working schema
579 local $self->{dump_directory} = $self->{temp_directory};
580 $self->_reload_classes(\@tables);
581 $self->_load_relationships($_) for @tables;
584 # Remove that temp dir from INC so it doesn't get reloaded
585 @INC = grep { $_ ne $self->{dump_directory} } @INC;
588 $self->_load_external($_)
589 for map { $self->classes->{$_} } @tables;
591 # Reload without unloading first to preserve any symbols from external
593 $self->_reload_classes(\@tables, 0);
595 # Drop temporary cache
596 delete $self->{_cache};
601 sub _reload_classes {
602 my ($self, $tables, $unload) = @_;
604 my @tables = @$tables;
605 $unload = 1 unless defined $unload;
607 # so that we don't repeat custom sections
608 @INC = grep $_ ne $self->dump_directory, @INC;
610 $self->_dump_to_dir(map { $self->classes->{$_} } @tables);
612 unshift @INC, $self->dump_directory;
615 my %have_source = map { $_ => $self->schema->source($_) }
616 $self->schema->sources;
618 for my $table (@tables) {
619 my $moniker = $self->monikers->{$table};
620 my $class = $self->classes->{$table};
623 no warnings 'redefine';
624 local *Class::C3::reinitialize = sub {};
627 Class::Unload->unload($class) if $unload;
628 my ($source, $resultset_class);
630 ($source = $have_source{$moniker})
631 && ($resultset_class = $source->resultset_class)
632 && ($resultset_class ne 'DBIx::Class::ResultSet')
634 my $has_file = Class::Inspector->loaded_filename($resultset_class);
635 Class::Unload->unload($resultset_class) if $unload;
636 $self->_reload_class($resultset_class) if $has_file;
638 $self->_reload_class($class);
640 push @to_register, [$moniker, $class];
643 Class::C3->reinitialize;
645 $self->schema->register_class(@$_);
649 # We use this instead of ensure_class_loaded when there are package symbols we
652 my ($self, $class) = @_;
654 my $class_path = $self->_class_path($class);
655 delete $INC{ $class_path };
656 eval "require $class;";
659 sub _get_dump_filename {
660 my ($self, $class) = (@_);
663 return $self->dump_directory . q{/} . $class . q{.pm};
666 sub _ensure_dump_subdirs {
667 my ($self, $class) = (@_);
669 my @name_parts = split(/::/, $class);
670 pop @name_parts; # we don't care about the very last element,
671 # which is a filename
673 my $dir = $self->dump_directory;
676 mkdir($dir) or croak "mkdir('$dir') failed: $!";
678 last if !@name_parts;
679 $dir = File::Spec->catdir($dir, shift @name_parts);
684 my ($self, @classes) = @_;
686 my $schema_class = $self->schema_class;
687 my $schema_base_class = $self->schema_base_class || 'DBIx::Class::Schema';
689 my $target_dir = $self->dump_directory;
690 warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
691 unless $self->{dynamic} or $self->{quiet};
694 qq|package $schema_class;\n\n|
695 . qq|# Created by DBIx::Class::Schema::Loader\n|
696 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
697 . qq|use strict;\nuse warnings;\n\n|
698 . qq|use base '$schema_base_class';\n\n|;
700 if ($self->use_namespaces) {
701 $schema_text .= qq|__PACKAGE__->load_namespaces|;
702 my $namespace_options;
703 for my $attr (qw(result_namespace
705 default_resultset_class)) {
707 $namespace_options .= qq| $attr => '| . $self->$attr . qq|',\n|
710 $schema_text .= qq|(\n$namespace_options)| if $namespace_options;
711 $schema_text .= qq|;\n|;
714 $schema_text .= qq|__PACKAGE__->load_classes;\n|;
718 local $self->{version_to_dump} = $self->schema_version_to_dump;
719 $self->_write_classfile($schema_class, $schema_text);
722 my $result_base_class = $self->result_base_class || 'DBIx::Class::Core';
724 foreach my $src_class (@classes) {
726 qq|package $src_class;\n\n|
727 . qq|# Created by DBIx::Class::Schema::Loader\n|
728 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
729 . qq|use strict;\nuse warnings;\n\n|
730 . qq|use base '$result_base_class';\n\n|;
732 $self->_write_classfile($src_class, $src_text);
735 warn "Schema dump completed.\n" unless $self->{dynamic} or $self->{quiet};
740 my ($self, $version, $ts) = @_;
741 return qq|\n\n# Created by DBIx::Class::Schema::Loader|
744 . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
747 sub _write_classfile {
748 my ($self, $class, $text) = @_;
750 my $filename = $self->_get_dump_filename($class);
751 $self->_ensure_dump_subdirs($class);
753 if (-f $filename && $self->really_erase_my_files) {
754 warn "Deleting existing file '$filename' due to "
755 . "'really_erase_my_files' setting\n" unless $self->{quiet};
759 my ($custom_content, $old_md5, $old_ver, $old_ts) = $self->_get_custom_content($class, $filename);
762 for @{$self->{_dump_storage}->{$class} || []};
764 # Check and see if the dump is infact differnt
768 $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
771 if (Digest::MD5::md5_base64($compare_to) eq $old_md5) {
776 $text .= $self->_sig_comment(
777 $self->version_to_dump,
778 POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
781 open(my $fh, '>', $filename)
782 or croak "Cannot open '$filename' for writing: $!";
784 # Write the top half and its MD5 sum
785 print $fh $text . Digest::MD5::md5_base64($text) . "\n";
787 # Write out anything loaded via external partial class file in @INC
789 for @{$self->{_ext_storage}->{$class} || []};
791 # Write out any custom content the user has added
792 print $fh $custom_content;
795 or croak "Error closing '$filename': $!";
798 sub _default_custom_content {
799 return qq|\n\n# You can replace this text with custom|
800 . qq| content, and it will be preserved on regeneration|
804 sub _get_custom_content {
805 my ($self, $class, $filename) = @_;
807 return ($self->_default_custom_content) if ! -f $filename;
809 open(my $fh, '<', $filename)
810 or croak "Cannot open '$filename' for reading: $!";
813 qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n};
816 my ($md5, $ts, $ver);
818 if(!$md5 && /$mark_re/) {
822 # Pull out the previous version and timestamp
823 ($ver, $ts) = $buffer =~ m/# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)$/s;
826 croak "Checksum mismatch in '$filename'"
827 if Digest::MD5::md5_base64($buffer) ne $md5;
836 croak "Cannot not overwrite '$filename' without 'really_erase_my_files',"
837 . " it does not appear to have been generated by Loader"
840 # Default custom content:
841 $buffer ||= $self->_default_custom_content;
843 return ($buffer, $md5, $ver, $ts);
851 warn "$target: use $_;" if $self->debug;
852 $self->_raw_stmt($target, "use $_;");
859 my $schema_class = $self->schema_class;
861 my $blist = join(q{ }, @_);
862 warn "$target: use base qw/ $blist /;" if $self->debug && @_;
863 $self->_raw_stmt($target, "use base qw/ $blist /;") if @_;
866 # Create class with applicable bases, setup monikers, etc
867 sub _make_src_class {
868 my ($self, $table) = @_;
870 my $schema = $self->schema;
871 my $schema_class = $self->schema_class;
873 my $table_moniker = $self->_table2moniker($table);
874 my @result_namespace = ($schema_class);
875 if ($self->use_namespaces) {
876 my $result_namespace = $self->result_namespace || 'Result';
877 if ($result_namespace =~ /^\+(.*)/) {
878 # Fully qualified namespace
879 @result_namespace = ($1)
883 push @result_namespace, $result_namespace;
886 my $table_class = join(q{::}, @result_namespace, $table_moniker);
888 my $table_normalized = lc $table;
889 $self->classes->{$table} = $table_class;
890 $self->classes->{$table_normalized} = $table_class;
891 $self->monikers->{$table} = $table_moniker;
892 $self->monikers->{$table_normalized} = $table_moniker;
894 $self->_use ($table_class, @{$self->additional_classes});
895 $self->_inject($table_class, @{$self->left_base_classes});
897 if (my @components = @{ $self->components }) {
898 $self->_dbic_stmt($table_class, 'load_components', @components);
901 $self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
902 if @{$self->resultset_components};
903 $self->_inject($table_class, @{$self->additional_base_classes});
906 # Set up metadata (cols, pks, etc)
907 sub _setup_src_meta {
908 my ($self, $table) = @_;
910 my $schema = $self->schema;
911 my $schema_class = $self->schema_class;
913 my $table_class = $self->classes->{$table};
914 my $table_moniker = $self->monikers->{$table};
916 my $table_name = $table;
917 my $name_sep = $self->schema->storage->sql_maker->name_sep;
919 if ($name_sep && $table_name =~ /\Q$name_sep\E/) {
920 $table_name = \ $self->_quote_table_name($table_name);
923 $self->_dbic_stmt($table_class,'table',$table_name);
925 my $cols = $self->_table_columns($table);
927 eval { $col_info = $self->_columns_info_for($table) };
929 $self->_dbic_stmt($table_class,'add_columns',@$cols);
932 if ($self->_is_case_sensitive) {
933 for my $col (keys %$col_info) {
934 $col_info->{$col}{accessor} = lc $col
938 $col_info = { map { lc($_), $col_info->{$_} } keys %$col_info };
941 my $fks = $self->_table_fk_info($table);
943 for my $fkdef (@$fks) {
944 for my $col (@{ $fkdef->{local_columns} }) {
945 $col_info->{$col}{is_foreign_key} = 1;
951 map { $_, ($col_info->{$_}||{}) } @$cols
955 my %uniq_tag; # used to eliminate duplicate uniqs
957 my $pks = $self->_table_pk_info($table) || [];
958 @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
959 : carp("$table has no primary key");
960 $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
962 my $uniqs = $self->_table_uniq_info($table) || [];
964 my ($name, $cols) = @$_;
965 next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
966 $self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
973 Returns a sorted list of loaded tables, using the original database table
981 return keys %{$self->_tables};
984 # Make a moniker from a table
985 sub _default_table2moniker {
986 no warnings 'uninitialized';
987 my ($self, $table) = @_;
989 if ($self->naming->{monikers} eq 'v4') {
990 return join '', map ucfirst, split /[\W_]+/, lc $table;
993 return join '', map ucfirst, split /[\W_]+/,
994 Lingua::EN::Inflect::Number::to_S(lc $table);
998 my ( $self, $table ) = @_;
1002 if( ref $self->moniker_map eq 'HASH' ) {
1003 $moniker = $self->moniker_map->{$table};
1005 elsif( ref $self->moniker_map eq 'CODE' ) {
1006 $moniker = $self->moniker_map->($table);
1009 $moniker ||= $self->_default_table2moniker($table);
1014 sub _load_relationships {
1015 my ($self, $table) = @_;
1017 my $tbl_fk_info = $self->_table_fk_info($table);
1018 foreach my $fkdef (@$tbl_fk_info) {
1019 $fkdef->{remote_source} =
1020 $self->monikers->{delete $fkdef->{remote_table}};
1022 my $tbl_uniq_info = $self->_table_uniq_info($table);
1024 my $local_moniker = $self->monikers->{$table};
1025 my $rel_stmts = $self->_relbuilder->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
1027 foreach my $src_class (sort keys %$rel_stmts) {
1028 my $src_stmts = $rel_stmts->{$src_class};
1029 foreach my $stmt (@$src_stmts) {
1030 $self->_dbic_stmt($src_class,$stmt->{method},@{$stmt->{args}});
1035 # Overload these in driver class:
1037 # Returns an arrayref of column names
1038 sub _table_columns { croak "ABSTRACT METHOD" }
1040 # Returns arrayref of pk col names
1041 sub _table_pk_info { croak "ABSTRACT METHOD" }
1043 # Returns an arrayref of uniqs [ [ foo => [ col1, col2 ] ], [ bar => [ ... ] ] ]
1044 sub _table_uniq_info { croak "ABSTRACT METHOD" }
1046 # Returns an arrayref of foreign key constraints, each
1047 # being a hashref with 3 keys:
1048 # local_columns (arrayref), remote_columns (arrayref), remote_table
1049 sub _table_fk_info { croak "ABSTRACT METHOD" }
1051 # Returns an array of lower case table names
1052 sub _tables_list { croak "ABSTRACT METHOD" }
1054 # Execute a constructive DBIC class method, with debug/dump_to_dir hooks.
1059 if ( $method eq 'table' ) {
1061 $self->_pod( $class, "=head1 NAME" );
1062 my $table_descr = $class;
1063 if ( $self->can('_table_comment') ) {
1064 my $comment = $self->_table_comment($table);
1065 $table_descr .= " - " . $comment if $comment;
1067 $self->{_class2table}{ $class } = $table;
1068 $self->_pod( $class, $table_descr );
1069 $self->_pod_cut( $class );
1070 } elsif ( $method eq 'add_columns' ) {
1071 $self->_pod( $class, "=head1 ACCESSORS" );
1076 $self->_pod( $class, '=head2 ' . $_ );
1078 $comment = $self->_column_comment( $self->{_class2table}{$class}, ($i - 1) / 2 + 1 ) if $self->can('_column_comment');
1079 $self->_pod( $class, $comment ) if $comment;
1081 $self->_pod_cut( $class );
1082 } elsif ( $method =~ /^(belongs_to|has_many|might_have)$/ ) {
1083 $self->_pod( $class, "=head1 RELATIONS" ) unless $self->{_relations_started} { $class } ;
1084 my ( $accessor, $rel_class ) = @_;
1085 $self->_pod( $class, "=head2 $accessor" );
1086 $self->_pod( $class, 'Type: ' . $method );
1087 $self->_pod( $class, "Related object: L<$rel_class>" );
1088 $self->_pod_cut( $class );
1089 $self->{_relations_started} { $class } = 1;
1091 my $args = dump(@_);
1092 $args = '(' . $args . ')' if @_ < 2;
1093 my $stmt = $method . $args . q{;};
1095 warn qq|$class\->$stmt\n| if $self->debug;
1096 $self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
1100 # Stores a POD documentation
1102 my ($self, $class, $stmt) = @_;
1103 $self->_raw_stmt( $class, "\n" . $stmt );
1107 my ($self, $class ) = @_;
1108 $self->_raw_stmt( $class, "\n=cut\n" );
1112 # Store a raw source line for a class (for dumping purposes)
1114 my ($self, $class, $stmt) = @_;
1115 push(@{$self->{_dump_storage}->{$class}}, $stmt);
1118 # Like above, but separately for the externally loaded stuff
1120 my ($self, $class, $stmt) = @_;
1121 push(@{$self->{_ext_storage}->{$class}}, $stmt);
1124 sub _quote_table_name {
1125 my ($self, $table) = @_;
1127 my $qt = $self->schema->storage->sql_maker->quote_char;
1129 return $table unless $qt;
1132 return $qt->[0] . $table . $qt->[1];
1135 return $qt . $table . $qt;
1138 sub _is_case_sensitive { 0 }
1142 Returns a hashref of loaded table to moniker mappings. There will
1143 be two entries for each table, the original name and the "normalized"
1144 name, in the case that the two are different (such as databases
1145 that like uppercase table names, or preserve your original mixed-case
1146 definitions, or what-have-you).
1150 Returns a hashref of table to class mappings. In some cases it will
1151 contain multiple entries per table for the original and normalized table
1152 names, as above in L</monikers>.
1156 L<DBIx::Class::Schema::Loader>
1160 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
1164 This library is free software; you can redistribute it and/or modify it under
1165 the same terms as Perl itself.