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 # ensure that a peice of object data is a valid arrayref, creating
295 # an empty one or encapsulating whatever's there.
296 sub _ensure_arrayref {
301 $self->{$_} = [ $self->{$_} ]
302 unless ref $self->{$_} eq 'ARRAY';
308 Constructor for L<DBIx::Class::Schema::Loader::Base>, used internally
309 by L<DBIx::Class::Schema::Loader>.
314 my ( $class, %args ) = @_;
316 my $self = { %args };
318 bless $self => $class;
320 $self->_ensure_arrayref(qw/additional_classes
321 additional_base_classes
327 push(@{$self->{components}}, 'ResultSetManager')
328 if @{$self->{resultset_components}};
330 $self->{monikers} = {};
331 $self->{classes} = {};
333 $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
334 $self->{schema} ||= $self->{schema_class};
336 croak "dump_overwrite is deprecated. Please read the"
337 . " DBIx::Class::Schema::Loader::Base documentation"
338 if $self->{dump_overwrite};
340 $self->{dynamic} = ! $self->{dump_directory};
341 $self->{temp_directory} ||= File::Temp::tempdir( 'dbicXXXX',
346 $self->{dump_directory} ||= $self->{temp_directory};
348 $self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
349 $self->schema_version_to_dump($DBIx::Class::Schema::Loader::VERSION);
351 if (not ref $self->naming && defined $self->naming) {
352 my $naming_ver = $self->naming;
354 relationships => $naming_ver,
355 monikers => $naming_ver,
359 $self->_check_back_compat;
364 sub _check_back_compat {
367 # dynamic schemas will always be in 0.04006 mode, unless overridden
368 if ($self->dynamic) {
369 # just in case, though no one is likely to dump a dynamic schema
370 $self->schema_version_to_dump('0.04006');
372 $self->naming->{relationships} ||= 'v4';
373 $self->naming->{monikers} ||= 'v4';
378 # otherwise check if we need backcompat mode for a static schema
379 my $filename = $self->_get_dump_filename($self->schema_class);
380 return unless -e $filename;
382 open(my $fh, '<', $filename)
383 or croak "Cannot open '$filename' for reading: $!";
386 if (/^# Created by DBIx::Class::Schema::Loader v((\d+)\.(\d+))/) {
389 $self->schema_version_to_dump($real_ver);
391 # XXX when we go past .0 this will need fixing
392 my ($v) = $real_ver =~ /([1-9])/;
395 $self->naming->{relationships} ||= $v;
396 $self->naming->{monikers} ||= $v;
404 sub _find_file_in_inc {
405 my ($self, $file) = @_;
407 foreach my $prefix (@INC) {
408 my $fullpath = File::Spec->catfile($prefix, $file);
409 return $fullpath if -f $fullpath
410 and Cwd::abs_path($fullpath) ne
411 Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) || '';
418 my ($self, $class) = @_;
420 my $class_path = $class;
421 $class_path =~ s{::}{/}g;
422 $class_path .= '.pm';
427 sub _find_class_in_inc {
428 my ($self, $class) = @_;
430 return $self->_find_file_in_inc($self->_class_path($class));
434 my ($self, $class) = @_;
436 my $real_inc_path = $self->_find_class_in_inc($class);
438 return if !$real_inc_path;
440 # If we make it to here, we loaded an external definition
441 warn qq/# Loaded external class definition for '$class'\n/
444 open(my $fh, '<', $real_inc_path)
445 or croak "Failed to open '$real_inc_path' for reading: $!";
446 $self->_ext_stmt($class,
447 qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
448 .qq|# They are now part of the custom portion of this file\n|
449 .qq|# for you to hand-edit. If you do not either delete\n|
450 .qq|# this section or remove that file from \@INC, this section\n|
451 .qq|# will be repeated redundantly when you re-create this\n|
452 .qq|# file again via Loader!\n|
456 $self->_ext_stmt($class, $_);
458 $self->_ext_stmt($class,
459 qq|# End of lines loaded from '$real_inc_path' |
462 or croak "Failed to close $real_inc_path: $!";
464 if ($self->dynamic) { # load the class too
465 # turn off redefined warnings
466 local $SIG{__WARN__} = sub {};
474 Does the actual schema-construction work.
481 $self->_load_tables($self->_tables_list);
488 Rescan the database for newly added tables. Does
489 not process drops or changes. Returns a list of
490 the newly added table monikers.
492 The schema argument should be the schema class
493 or object to be affected. It should probably
494 be derived from the original schema_class used
500 my ($self, $schema) = @_;
502 $self->{schema} = $schema;
503 $self->_relbuilder->{schema} = $schema;
506 my @current = $self->_tables_list;
507 foreach my $table ($self->_tables_list) {
508 if(!exists $self->{_tables}->{$table}) {
509 push(@created, $table);
513 my $loaded = $self->_load_tables(@created);
515 return map { $self->monikers->{$_} } @$loaded;
521 return if $self->{skip_relationships};
523 if ($self->naming->{relationships} eq 'v4') {
524 require DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_040;
525 return $self->{relbuilder} ||=
526 DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_040->new(
527 $self->schema, $self->inflect_plural, $self->inflect_singular
531 $self->{relbuilder} ||= DBIx::Class::Schema::Loader::RelBuilder->new(
532 $self->schema, $self->inflect_plural, $self->inflect_singular
537 my ($self, @tables) = @_;
539 # First, use _tables_list with constraint and exclude
540 # to get a list of tables to operate on
542 my $constraint = $self->constraint;
543 my $exclude = $self->exclude;
545 @tables = grep { /$constraint/ } @tables if $constraint;
546 @tables = grep { ! /$exclude/ } @tables if $exclude;
548 # Save the new tables to the tables list
550 $self->{_tables}->{$_} = 1;
553 $self->_make_src_class($_) for @tables;
554 $self->_setup_src_meta($_) for @tables;
556 if(!$self->skip_relationships) {
557 # The relationship loader needs a working schema
559 local $self->{dump_directory} = $self->{temp_directory};
560 $self->_reload_classes(\@tables);
561 $self->_load_relationships($_) for @tables;
564 # Remove that temp dir from INC so it doesn't get reloaded
565 @INC = grep { $_ ne $self->{dump_directory} } @INC;
568 $self->_load_external($_)
569 for map { $self->classes->{$_} } @tables;
571 # Reload without unloading first to preserve any symbols from external
573 $self->_reload_classes(\@tables, 0);
575 # Drop temporary cache
576 delete $self->{_cache};
581 sub _reload_classes {
582 my ($self, $tables, $unload) = @_;
584 my @tables = @$tables;
585 $unload = 1 unless defined $unload;
587 # so that we don't repeat custom sections
588 @INC = grep $_ ne $self->dump_directory, @INC;
590 $self->_dump_to_dir(map { $self->classes->{$_} } @tables);
592 unshift @INC, $self->dump_directory;
595 my %have_source = map { $_ => $self->schema->source($_) }
596 $self->schema->sources;
598 for my $table (@tables) {
599 my $moniker = $self->monikers->{$table};
600 my $class = $self->classes->{$table};
603 no warnings 'redefine';
604 local *Class::C3::reinitialize = sub {};
607 Class::Unload->unload($class) if $unload;
608 my ($source, $resultset_class);
610 ($source = $have_source{$moniker})
611 && ($resultset_class = $source->resultset_class)
612 && ($resultset_class ne 'DBIx::Class::ResultSet')
614 my $has_file = Class::Inspector->loaded_filename($resultset_class);
615 Class::Unload->unload($resultset_class) if $unload;
616 $self->_reload_class($resultset_class) if $has_file;
618 $self->_reload_class($class);
620 push @to_register, [$moniker, $class];
623 Class::C3->reinitialize;
625 $self->schema->register_class(@$_);
629 # We use this instead of ensure_class_loaded when there are package symbols we
632 my ($self, $class) = @_;
634 my $class_path = $self->_class_path($class);
635 delete $INC{ $class_path };
636 eval "require $class;";
639 sub _get_dump_filename {
640 my ($self, $class) = (@_);
643 return $self->dump_directory . q{/} . $class . q{.pm};
646 sub _ensure_dump_subdirs {
647 my ($self, $class) = (@_);
649 my @name_parts = split(/::/, $class);
650 pop @name_parts; # we don't care about the very last element,
651 # which is a filename
653 my $dir = $self->dump_directory;
656 mkdir($dir) or croak "mkdir('$dir') failed: $!";
658 last if !@name_parts;
659 $dir = File::Spec->catdir($dir, shift @name_parts);
664 my ($self, @classes) = @_;
666 my $schema_class = $self->schema_class;
667 my $schema_base_class = $self->schema_base_class || 'DBIx::Class::Schema';
669 my $target_dir = $self->dump_directory;
670 warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
671 unless $self->{dynamic} or $self->{quiet};
674 qq|package $schema_class;\n\n|
675 . qq|# Created by DBIx::Class::Schema::Loader\n|
676 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
677 . qq|use strict;\nuse warnings;\n\n|
678 . qq|use base '$schema_base_class';\n\n|;
680 if ($self->use_namespaces) {
681 $schema_text .= qq|__PACKAGE__->load_namespaces|;
682 my $namespace_options;
683 for my $attr (qw(result_namespace
685 default_resultset_class)) {
687 $namespace_options .= qq| $attr => '| . $self->$attr . qq|',\n|
690 $schema_text .= qq|(\n$namespace_options)| if $namespace_options;
691 $schema_text .= qq|;\n|;
694 $schema_text .= qq|__PACKAGE__->load_classes;\n|;
698 local $self->{version_to_dump} = $self->schema_version_to_dump;
699 $self->_write_classfile($schema_class, $schema_text);
702 my $result_base_class = $self->result_base_class || 'DBIx::Class::Core';
704 foreach my $src_class (@classes) {
706 qq|package $src_class;\n\n|
707 . qq|# Created by DBIx::Class::Schema::Loader\n|
708 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
709 . qq|use strict;\nuse warnings;\n\n|
710 . qq|use base '$result_base_class';\n\n|;
712 $self->_write_classfile($src_class, $src_text);
715 warn "Schema dump completed.\n" unless $self->{dynamic} or $self->{quiet};
720 my ($self, $version, $ts) = @_;
721 return qq|\n\n# Created by DBIx::Class::Schema::Loader|
724 . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
727 sub _write_classfile {
728 my ($self, $class, $text) = @_;
730 my $filename = $self->_get_dump_filename($class);
731 $self->_ensure_dump_subdirs($class);
733 if (-f $filename && $self->really_erase_my_files) {
734 warn "Deleting existing file '$filename' due to "
735 . "'really_erase_my_files' setting\n" unless $self->{quiet};
739 my ($custom_content, $old_md5, $old_ver, $old_ts) = $self->_get_custom_content($class, $filename);
742 for @{$self->{_dump_storage}->{$class} || []};
744 # Check and see if the dump is infact differnt
748 $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
751 if (Digest::MD5::md5_base64($compare_to) eq $old_md5) {
756 $text .= $self->_sig_comment(
757 $self->version_to_dump,
758 POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
761 open(my $fh, '>', $filename)
762 or croak "Cannot open '$filename' for writing: $!";
764 # Write the top half and its MD5 sum
765 print $fh $text . Digest::MD5::md5_base64($text) . "\n";
767 # Write out anything loaded via external partial class file in @INC
769 for @{$self->{_ext_storage}->{$class} || []};
771 # Write out any custom content the user has added
772 print $fh $custom_content;
775 or croak "Error closing '$filename': $!";
778 sub _default_custom_content {
779 return qq|\n\n# You can replace this text with custom|
780 . qq| content, and it will be preserved on regeneration|
784 sub _get_custom_content {
785 my ($self, $class, $filename) = @_;
787 return ($self->_default_custom_content) if ! -f $filename;
789 open(my $fh, '<', $filename)
790 or croak "Cannot open '$filename' for reading: $!";
793 qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n};
796 my ($md5, $ts, $ver);
798 if(!$md5 && /$mark_re/) {
802 # Pull out the previous version and timestamp
803 ($ver, $ts) = $buffer =~ m/# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)$/s;
806 croak "Checksum mismatch in '$filename'"
807 if Digest::MD5::md5_base64($buffer) ne $md5;
816 croak "Cannot not overwrite '$filename' without 'really_erase_my_files',"
817 . " it does not appear to have been generated by Loader"
820 # Default custom content:
821 $buffer ||= $self->_default_custom_content;
823 return ($buffer, $md5, $ver, $ts);
831 warn "$target: use $_;" if $self->debug;
832 $self->_raw_stmt($target, "use $_;");
839 my $schema_class = $self->schema_class;
841 my $blist = join(q{ }, @_);
842 warn "$target: use base qw/ $blist /;" if $self->debug && @_;
843 $self->_raw_stmt($target, "use base qw/ $blist /;") if @_;
846 # Create class with applicable bases, setup monikers, etc
847 sub _make_src_class {
848 my ($self, $table) = @_;
850 my $schema = $self->schema;
851 my $schema_class = $self->schema_class;
853 my $table_moniker = $self->_table2moniker($table);
854 my @result_namespace = ($schema_class);
855 if ($self->use_namespaces) {
856 my $result_namespace = $self->result_namespace || 'Result';
857 if ($result_namespace =~ /^\+(.*)/) {
858 # Fully qualified namespace
859 @result_namespace = ($1)
863 push @result_namespace, $result_namespace;
866 my $table_class = join(q{::}, @result_namespace, $table_moniker);
868 my $table_normalized = lc $table;
869 $self->classes->{$table} = $table_class;
870 $self->classes->{$table_normalized} = $table_class;
871 $self->monikers->{$table} = $table_moniker;
872 $self->monikers->{$table_normalized} = $table_moniker;
874 $self->_use ($table_class, @{$self->additional_classes});
875 $self->_inject($table_class, @{$self->left_base_classes});
877 if (my @components = @{ $self->components }) {
878 $self->_dbic_stmt($table_class, 'load_components', @components);
881 $self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
882 if @{$self->resultset_components};
883 $self->_inject($table_class, @{$self->additional_base_classes});
886 # Set up metadata (cols, pks, etc)
887 sub _setup_src_meta {
888 my ($self, $table) = @_;
890 my $schema = $self->schema;
891 my $schema_class = $self->schema_class;
893 my $table_class = $self->classes->{$table};
894 my $table_moniker = $self->monikers->{$table};
896 my $table_name = $table;
897 my $name_sep = $self->schema->storage->sql_maker->name_sep;
899 if ($name_sep && $table_name =~ /\Q$name_sep\E/) {
900 $table_name = \ $self->_quote_table_name($table_name);
903 $self->_dbic_stmt($table_class,'table',$table_name);
905 my $cols = $self->_table_columns($table);
907 eval { $col_info = $self->_columns_info_for($table) };
909 $self->_dbic_stmt($table_class,'add_columns',@$cols);
912 if ($self->_is_case_sensitive) {
913 for my $col (keys %$col_info) {
914 $col_info->{$col}{accessor} = lc $col
918 $col_info = { map { lc($_), $col_info->{$_} } keys %$col_info };
921 my $fks = $self->_table_fk_info($table);
923 for my $fkdef (@$fks) {
924 for my $col (@{ $fkdef->{local_columns} }) {
925 $col_info->{$col}{is_foreign_key} = 1;
931 map { $_, ($col_info->{$_}||{}) } @$cols
935 my %uniq_tag; # used to eliminate duplicate uniqs
937 my $pks = $self->_table_pk_info($table) || [];
938 @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
939 : carp("$table has no primary key");
940 $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
942 my $uniqs = $self->_table_uniq_info($table) || [];
944 my ($name, $cols) = @$_;
945 next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
946 $self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
953 Returns a sorted list of loaded tables, using the original database table
961 return keys %{$self->_tables};
964 # Make a moniker from a table
965 sub _default_table2moniker {
966 my ($self, $table) = @_;
968 if ($self->naming->{monikers} eq 'v4') {
969 return join '', map ucfirst, split /[\W_]+/, lc $table;
972 return join '', map ucfirst, split /[\W_]+/,
973 Lingua::EN::Inflect::Number::to_S(lc $table);
977 my ( $self, $table ) = @_;
981 if( ref $self->moniker_map eq 'HASH' ) {
982 $moniker = $self->moniker_map->{$table};
984 elsif( ref $self->moniker_map eq 'CODE' ) {
985 $moniker = $self->moniker_map->($table);
988 $moniker ||= $self->_default_table2moniker($table);
993 sub _load_relationships {
994 my ($self, $table) = @_;
996 my $tbl_fk_info = $self->_table_fk_info($table);
997 foreach my $fkdef (@$tbl_fk_info) {
998 $fkdef->{remote_source} =
999 $self->monikers->{delete $fkdef->{remote_table}};
1001 my $tbl_uniq_info = $self->_table_uniq_info($table);
1003 my $local_moniker = $self->monikers->{$table};
1004 my $rel_stmts = $self->_relbuilder->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
1006 foreach my $src_class (sort keys %$rel_stmts) {
1007 my $src_stmts = $rel_stmts->{$src_class};
1008 foreach my $stmt (@$src_stmts) {
1009 $self->_dbic_stmt($src_class,$stmt->{method},@{$stmt->{args}});
1014 # Overload these in driver class:
1016 # Returns an arrayref of column names
1017 sub _table_columns { croak "ABSTRACT METHOD" }
1019 # Returns arrayref of pk col names
1020 sub _table_pk_info { croak "ABSTRACT METHOD" }
1022 # Returns an arrayref of uniqs [ [ foo => [ col1, col2 ] ], [ bar => [ ... ] ] ]
1023 sub _table_uniq_info { croak "ABSTRACT METHOD" }
1025 # Returns an arrayref of foreign key constraints, each
1026 # being a hashref with 3 keys:
1027 # local_columns (arrayref), remote_columns (arrayref), remote_table
1028 sub _table_fk_info { croak "ABSTRACT METHOD" }
1030 # Returns an array of lower case table names
1031 sub _tables_list { croak "ABSTRACT METHOD" }
1033 # Execute a constructive DBIC class method, with debug/dump_to_dir hooks.
1038 if ( $method eq 'table' ) {
1040 $self->_pod( $class, "=head1 NAME" );
1041 my $table_descr = $class;
1042 if ( $self->can('_table_comment') ) {
1043 my $comment = $self->_table_comment($table);
1044 $table_descr .= " - " . $comment if $comment;
1046 $self->{_class2table}{ $class } = $table;
1047 $self->_pod( $class, $table_descr );
1048 $self->_pod_cut( $class );
1049 } elsif ( $method eq 'add_columns' ) {
1050 $self->_pod( $class, "=head1 ACCESSORS" );
1055 $self->_pod( $class, '=head2 ' . $_ );
1057 $comment = $self->_column_comment( $self->{_class2table}{$class}, ($i - 1) / 2 + 1 ) if $self->can('_column_comment');
1058 $self->_pod( $class, $comment ) if $comment;
1060 $self->_pod_cut( $class );
1061 } elsif ( $method =~ /^(belongs_to|has_many|might_have)$/ ) {
1062 $self->_pod( $class, "=head1 RELATIONS" ) unless $self->{_relations_started} { $class } ;
1063 my ( $accessor, $rel_class ) = @_;
1064 $self->_pod( $class, "=head2 $accessor" );
1065 $self->_pod( $class, 'Type: ' . $method );
1066 $self->_pod( $class, "Related object: L<$rel_class>" );
1067 $self->_pod_cut( $class );
1068 $self->{_relations_started} { $class } = 1;
1070 my $args = dump(@_);
1071 $args = '(' . $args . ')' if @_ < 2;
1072 my $stmt = $method . $args . q{;};
1074 warn qq|$class\->$stmt\n| if $self->debug;
1075 $self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
1079 # Stores a POD documentation
1081 my ($self, $class, $stmt) = @_;
1082 $self->_raw_stmt( $class, "\n" . $stmt );
1086 my ($self, $class ) = @_;
1087 $self->_raw_stmt( $class, "\n=cut\n" );
1091 # Store a raw source line for a class (for dumping purposes)
1093 my ($self, $class, $stmt) = @_;
1094 push(@{$self->{_dump_storage}->{$class}}, $stmt);
1097 # Like above, but separately for the externally loaded stuff
1099 my ($self, $class, $stmt) = @_;
1100 push(@{$self->{_ext_storage}->{$class}}, $stmt);
1103 sub _quote_table_name {
1104 my ($self, $table) = @_;
1106 my $qt = $self->schema->storage->sql_maker->quote_char;
1108 return $table unless $qt;
1111 return $qt->[0] . $table . $qt->[1];
1114 return $qt . $table . $qt;
1117 sub _is_case_sensitive { 0 }
1121 Returns a hashref of loaded table to moniker mappings. There will
1122 be two entries for each table, the original name and the "normalized"
1123 name, in the case that the two are different (such as databases
1124 that like uppercase table names, or preserve your original mixed-case
1125 definitions, or what-have-you).
1129 Returns a hashref of table to class mappings. In some cases it will
1130 contain multiple entries per table for the original and normalized table
1131 names, as above in L</monikers>.
1135 L<DBIx::Class::Schema::Loader>
1139 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
1143 This library is free software; you can redistribute it and/or modify it under
1144 the same terms as Perl itself.