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_10';
21 __PACKAGE__->mk_ro_accessors(qw/
28 additional_base_classes
43 default_resultset_class
55 DBIx::Class::Schema::Loader::Base - Base DBIx::Class::Schema::Loader Implementation.
59 See L<DBIx::Class::Schema::Loader>
63 This is the base class for the storage-specific C<DBIx::Class::Schema::*>
64 classes, and implements the common functionality between them.
66 =head1 CONSTRUCTOR OPTIONS
68 These constructor options are the base options for
69 L<DBIx::Class::Schema::Loader/loader_options>. Available constructor options are:
71 =head2 skip_relationships
73 Skip setting up relationships. The default is to attempt the loading
78 If set to true, each constructive L<DBIx::Class> statement the loader
79 decides to execute will be C<warn>-ed before execution.
83 Set the name of the schema to load (schema in the sense that your database
84 vendor means it). Does not currently support loading more than one schema
89 Only load tables matching regex. Best specified as a qr// regex.
93 Exclude tables matching regex. Best specified as a qr// regex.
97 Overrides the default table name to moniker translation. Can be either
98 a hashref of table keys and moniker values, or a coderef for a translator
99 function taking a single scalar table name argument and returning
100 a scalar moniker. If the hash entry does not exist, or the function
101 returns a false value, the code falls back to default behavior
104 The default behavior is: C<join '', map ucfirst, split /[\W_]+/, lc $table>,
105 which is to say: lowercase everything, split up the table name into chunks
106 anywhere a non-alpha-numeric character occurs, change the case of first letter
107 of each chunk to upper case, and put the chunks back together. Examples:
109 Table Name | Moniker Name
110 ---------------------------
112 luser_group | LuserGroup
113 luser-opts | LuserOpts
115 =head2 inflect_plural
117 Just like L</moniker_map> above (can be hash/code-ref, falls back to default
118 if hash key does not exist or coderef returns false), but acts as a map
119 for pluralizing relationship names. The default behavior is to utilize
120 L<Lingua::EN::Inflect::Number/to_PL>.
122 =head2 inflect_singular
124 As L</inflect_plural> above, but for singularizing relationship names.
125 Default behavior is to utilize L<Lingua::EN::Inflect::Number/to_S>.
127 =head2 schema_base_class
129 Base class for your schema classes. Defaults to 'DBIx::Class::Schema'.
131 =head2 result_base_class
133 Base class for your table classes (aka result classes). Defaults to 'DBIx::Class'.
135 =head2 additional_base_classes
137 List of additional base classes all of your table classes will use.
139 =head2 left_base_classes
141 List of additional base classes all of your table classes will use
142 that need to be leftmost.
144 =head2 additional_classes
146 List of additional classes which all of your table classes will use.
150 List of additional components to be loaded into all of your table
151 classes. A good example would be C<ResultSetManager>.
153 =head2 resultset_components
155 List of additional ResultSet components to be loaded into your table
156 classes. A good example would be C<AlwaysRS>. Component
157 C<ResultSetManager> will be automatically added to the above
158 C<components> list if this option is set.
160 =head2 use_namespaces
162 Generate result class names suitable for
163 L<DBIx::Class::Schema/load_namespaces> and call that instead of
164 L<DBIx::Class::Schema/load_classes>. When using this option you can also
165 specify any of the options for C<load_namespaces> (i.e. C<result_namespace>,
166 C<resultset_namespace>, C<default_resultset_class>), and they will be added
167 to the call (and the generated result class names adjusted appropriately).
169 =head2 dump_directory
171 This option is designed to be a tool to help you transition from this
172 loader to a manually-defined schema when you decide it's time to do so.
174 The value of this option is a perl libdir pathname. Within
175 that directory this module will create a baseline manual
176 L<DBIx::Class::Schema> module set, based on what it creates at runtime
179 The created schema class will have the same classname as the one on
180 which you are setting this option (and the ResultSource classes will be
181 based on this name as well).
183 Normally you wouldn't hard-code this setting in your schema class, as it
184 is meant for one-time manual usage.
186 See L<DBIx::Class::Schema::Loader/dump_to_dir> for examples of the
187 recommended way to access this functionality.
189 =head2 dump_overwrite
191 Deprecated. See L</really_erase_my_files> below, which does *not* mean
192 the same thing as the old C<dump_overwrite> setting from previous releases.
194 =head2 really_erase_my_files
196 Default false. If true, Loader will unconditionally delete any existing
197 files before creating the new ones from scratch when dumping a schema to disk.
199 The default behavior is instead to only replace the top portion of the
200 file, up to and including the final stanza which contains
201 C<# DO NOT MODIFY THIS OR ANYTHING ABOVE!>
202 leaving any customizations you placed after that as they were.
204 When C<really_erase_my_files> is not set, if the output file already exists,
205 but the aforementioned final stanza is not found, or the checksum
206 contained there does not match the generated contents, Loader will
207 croak and not touch the file.
209 You should really be using version control on your schema classes (and all
210 of the rest of your code for that matter). Don't blame me if a bug in this
211 code wipes something out when it shouldn't have, you've been warned.
215 None of these methods are intended for direct invocation by regular
216 users of L<DBIx::Class::Schema::Loader>. Anything you can find here
217 can also be found via standard L<DBIx::Class::Schema> methods somehow.
221 # ensure that a peice of object data is a valid arrayref, creating
222 # an empty one or encapsulating whatever's there.
223 sub _ensure_arrayref {
228 $self->{$_} = [ $self->{$_} ]
229 unless ref $self->{$_} eq 'ARRAY';
235 Constructor for L<DBIx::Class::Schema::Loader::Base>, used internally
236 by L<DBIx::Class::Schema::Loader>.
241 my ( $class, %args ) = @_;
243 my $self = { %args };
245 bless $self => $class;
247 $self->_ensure_arrayref(qw/additional_classes
248 additional_base_classes
254 push(@{$self->{components}}, 'ResultSetManager')
255 if @{$self->{resultset_components}};
257 $self->{monikers} = {};
258 $self->{classes} = {};
260 $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
261 $self->{schema} ||= $self->{schema_class};
263 croak "dump_overwrite is deprecated. Please read the"
264 . " DBIx::Class::Schema::Loader::Base documentation"
265 if $self->{dump_overwrite};
267 $self->{dynamic} = ! $self->{dump_directory};
268 $self->{temp_directory} ||= File::Temp::tempdir( 'dbicXXXX',
273 $self->{dump_directory} ||= $self->{temp_directory};
275 $self->_check_back_compat;
280 sub _check_back_compat {
283 my $filename = $self->_get_dump_filename($self->schema_class);
284 return unless -e $filename;
286 open(my $fh, '<', $filename)
287 or croak "Cannot open '$filename' for reading: $!";
290 if (/^# Created by DBIx::Class::Schema::Loader (v\d+)\.(\d+)/) {
291 my $ver = "${1}_${2}";
293 my $compat_class = "DBIx::Class::Schema::Loader::Compat::${ver}";
294 if ($self->load_optional_class($compat_class)) {
296 my $class = ref $self || $self;
297 unshift @{"${class}::ISA"}, $compat_class;
300 $ver =~ s/\d\z// or last;
308 sub _find_file_in_inc {
309 my ($self, $file) = @_;
311 foreach my $prefix (@INC) {
312 my $fullpath = File::Spec->catfile($prefix, $file);
313 return $fullpath if -f $fullpath
314 and Cwd::abs_path($fullpath) ne
315 Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) || '';
322 my ($self, $class) = @_;
324 my $class_path = $class;
325 $class_path =~ s{::}{/}g;
326 $class_path .= '.pm';
328 my $real_inc_path = $self->_find_file_in_inc($class_path);
330 return if !$real_inc_path;
332 # If we make it to here, we loaded an external definition
333 warn qq/# Loaded external class definition for '$class'\n/
336 croak 'Failed to locate actual external module file for '
339 open(my $fh, '<', $real_inc_path)
340 or croak "Failed to open '$real_inc_path' for reading: $!";
341 $self->_ext_stmt($class,
342 qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
343 .qq|# They are now part of the custom portion of this file\n|
344 .qq|# for you to hand-edit. If you do not either delete\n|
345 .qq|# this section or remove that file from \@INC, this section\n|
346 .qq|# will be repeated redundantly when you re-create this\n|
347 .qq|# file again via Loader!\n|
351 $self->_ext_stmt($class, $_);
353 $self->_ext_stmt($class,
354 qq|# End of lines loaded from '$real_inc_path' |
357 or croak "Failed to close $real_inc_path: $!";
362 Does the actual schema-construction work.
369 $self->_load_tables($self->_tables_list);
376 Rescan the database for newly added tables. Does
377 not process drops or changes. Returns a list of
378 the newly added table monikers.
380 The schema argument should be the schema class
381 or object to be affected. It should probably
382 be derived from the original schema_class used
388 my ($self, $schema) = @_;
390 $self->{schema} = $schema;
391 $self->_relbuilder->{schema} = $schema;
394 my @current = $self->_tables_list;
395 foreach my $table ($self->_tables_list) {
396 if(!exists $self->{_tables}->{$table}) {
397 push(@created, $table);
401 my $loaded = $self->_load_tables(@created);
403 return map { $self->monikers->{$_} } @$loaded;
409 return if $self->{skip_relationships};
411 $self->{relbuilder} ||= DBIx::Class::Schema::Loader::RelBuilder->new(
412 $self->schema, $self->inflect_plural, $self->inflect_singular
417 my ($self, @tables) = @_;
419 # First, use _tables_list with constraint and exclude
420 # to get a list of tables to operate on
422 my $constraint = $self->constraint;
423 my $exclude = $self->exclude;
425 @tables = grep { /$constraint/ } @tables if $constraint;
426 @tables = grep { ! /$exclude/ } @tables if $exclude;
428 # Save the new tables to the tables list
430 $self->{_tables}->{$_} = 1;
433 $self->_make_src_class($_) for @tables;
434 $self->_setup_src_meta($_) for @tables;
436 if(!$self->skip_relationships) {
437 # The relationship loader needs a working schema
439 local $self->{dump_directory} = $self->{temp_directory};
440 $self->_reload_classes(@tables);
441 $self->_load_relationships($_) for @tables;
444 # Remove that temp dir from INC so it doesn't get reloaded
445 @INC = grep { $_ ne $self->{dump_directory} } @INC;
448 $self->_load_external($_)
449 for map { $self->classes->{$_} } @tables;
451 $self->_reload_classes(@tables);
453 # Drop temporary cache
454 delete $self->{_cache};
459 sub _reload_classes {
460 my ($self, @tables) = @_;
462 $self->_dump_to_dir(map { $self->classes->{$_} } @tables);
464 unshift @INC, $self->dump_directory;
467 my %have_source = map { $_ => $self->schema->source($_) }
468 $self->schema->sources;
470 for my $table (@tables) {
471 my $moniker = $self->monikers->{$table};
472 my $class = $self->classes->{$table};
475 no warnings 'redefine';
476 local *Class::C3::reinitialize = sub {};
479 Class::Unload->unload($class);
480 my ($source, $resultset_class);
482 ($source = $have_source{$moniker})
483 && ($resultset_class = $source->resultset_class)
484 && ($resultset_class ne 'DBIx::Class::ResultSet')
486 my $has_file = Class::Inspector->loaded_filename($resultset_class);
487 Class::Unload->unload($resultset_class);
488 $self->ensure_class_loaded($resultset_class) if $has_file;
490 $self->ensure_class_loaded($class);
492 push @to_register, [$moniker, $class];
495 Class::C3->reinitialize;
497 $self->schema->register_class(@$_);
501 sub _get_dump_filename {
502 my ($self, $class) = (@_);
505 return $self->dump_directory . q{/} . $class . q{.pm};
508 sub _ensure_dump_subdirs {
509 my ($self, $class) = (@_);
511 my @name_parts = split(/::/, $class);
512 pop @name_parts; # we don't care about the very last element,
513 # which is a filename
515 my $dir = $self->dump_directory;
518 mkdir($dir) or croak "mkdir('$dir') failed: $!";
520 last if !@name_parts;
521 $dir = File::Spec->catdir($dir, shift @name_parts);
526 my ($self, @classes) = @_;
528 my $schema_class = $self->schema_class;
529 my $schema_base_class = $self->schema_base_class || 'DBIx::Class::Schema';
531 my $target_dir = $self->dump_directory;
532 warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
533 unless $self->{dynamic} or $self->{quiet};
536 qq|package $schema_class;\n\n|
537 . qq|# Created by DBIx::Class::Schema::Loader\n|
538 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
539 . qq|use strict;\nuse warnings;\n\n|
540 . qq|use base '$schema_base_class';\n\n|;
542 if ($self->use_namespaces) {
543 $schema_text .= qq|__PACKAGE__->load_namespaces|;
544 my $namespace_options;
545 for my $attr (qw(result_namespace
547 default_resultset_class)) {
549 $namespace_options .= qq| $attr => '| . $self->$attr . qq|',\n|
552 $schema_text .= qq|(\n$namespace_options)| if $namespace_options;
553 $schema_text .= qq|;\n|;
556 $schema_text .= qq|__PACKAGE__->load_classes;\n|;
559 $self->_write_classfile($schema_class, $schema_text);
561 my $result_base_class = $self->result_base_class || 'DBIx::Class';
563 foreach my $src_class (@classes) {
565 qq|package $src_class;\n\n|
566 . qq|# Created by DBIx::Class::Schema::Loader\n|
567 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
568 . qq|use strict;\nuse warnings;\n\n|
569 . qq|use base '$result_base_class';\n\n|;
571 $self->_write_classfile($src_class, $src_text);
574 warn "Schema dump completed.\n" unless $self->{dynamic} or $self->{quiet};
579 my ($self, $version, $ts) = @_;
580 return qq|\n\n# Created by DBIx::Class::Schema::Loader|
583 . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
586 sub _write_classfile {
587 my ($self, $class, $text) = @_;
589 my $filename = $self->_get_dump_filename($class);
590 $self->_ensure_dump_subdirs($class);
592 if (-f $filename && $self->really_erase_my_files) {
593 warn "Deleting existing file '$filename' due to "
594 . "'really_erase_my_files' setting\n" unless $self->{quiet};
598 my ($custom_content, $old_md5, $old_ver, $old_ts) = $self->_get_custom_content($class, $filename);
601 for @{$self->{_dump_storage}->{$class} || []};
603 # Check and see if the dump is infact differnt
607 $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
610 if (Digest::MD5::md5_base64($compare_to) eq $old_md5) {
615 $text .= $self->_sig_comment(
616 $DBIx::Class::Schema::Loader::VERSION,
617 POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
620 open(my $fh, '>', $filename)
621 or croak "Cannot open '$filename' for writing: $!";
623 # Write the top half and its MD5 sum
624 print $fh $text . Digest::MD5::md5_base64($text) . "\n";
626 # Write out anything loaded via external partial class file in @INC
628 for @{$self->{_ext_storage}->{$class} || []};
630 # Write out any custom content the user has added
631 print $fh $custom_content;
634 or croak "Error closing '$filename': $!";
637 sub _default_custom_content {
638 return qq|\n\n# You can replace this text with custom|
639 . qq| content, and it will be preserved on regeneration|
643 sub _get_custom_content {
644 my ($self, $class, $filename) = @_;
646 return ($self->_default_custom_content) if ! -f $filename;
648 open(my $fh, '<', $filename)
649 or croak "Cannot open '$filename' for reading: $!";
652 qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n};
655 my ($md5, $ts, $ver);
657 if(!$md5 && /$mark_re/) {
661 # Pull out the previous version and timestamp
662 ($ver, $ts) = $buffer =~ m/# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)$/s;
665 croak "Checksum mismatch in '$filename'"
666 if Digest::MD5::md5_base64($buffer) ne $md5;
675 croak "Cannot not overwrite '$filename' without 'really_erase_my_files',"
676 . " it does not appear to have been generated by Loader"
679 # Default custom content:
680 $buffer ||= $self->_default_custom_content;
682 return ($buffer, $md5, $ver, $ts);
690 warn "$target: use $_;" if $self->debug;
691 $self->_raw_stmt($target, "use $_;");
698 my $schema_class = $self->schema_class;
700 my $blist = join(q{ }, @_);
701 warn "$target: use base qw/ $blist /;" if $self->debug && @_;
702 $self->_raw_stmt($target, "use base qw/ $blist /;") if @_;
705 # Create class with applicable bases, setup monikers, etc
706 sub _make_src_class {
707 my ($self, $table) = @_;
709 my $schema = $self->schema;
710 my $schema_class = $self->schema_class;
712 my $table_moniker = $self->_table2moniker($table);
713 my @result_namespace = ($schema_class);
714 if ($self->use_namespaces) {
715 my $result_namespace = $self->result_namespace || 'Result';
716 if ($result_namespace =~ /^\+(.*)/) {
717 # Fully qualified namespace
718 @result_namespace = ($1)
722 push @result_namespace, $result_namespace;
725 my $table_class = join(q{::}, @result_namespace, $table_moniker);
727 my $table_normalized = lc $table;
728 $self->classes->{$table} = $table_class;
729 $self->classes->{$table_normalized} = $table_class;
730 $self->monikers->{$table} = $table_moniker;
731 $self->monikers->{$table_normalized} = $table_moniker;
733 $self->_use ($table_class, @{$self->additional_classes});
734 $self->_inject($table_class, @{$self->left_base_classes});
736 $self->_dbic_stmt($table_class, 'load_components', @{$self->components}, 'Core');
738 $self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
739 if @{$self->resultset_components};
740 $self->_inject($table_class, @{$self->additional_base_classes});
743 # Set up metadata (cols, pks, etc)
744 sub _setup_src_meta {
745 my ($self, $table) = @_;
747 my $schema = $self->schema;
748 my $schema_class = $self->schema_class;
750 my $table_class = $self->classes->{$table};
751 my $table_moniker = $self->monikers->{$table};
753 my $table_name = $table;
754 my $name_sep = $self->schema->storage->sql_maker->name_sep;
756 if ($name_sep && $table_name =~ /\Q$name_sep\E/) {
757 $table_name = \ $self->_quote_table_name($table_name);
760 $self->_dbic_stmt($table_class,'table',$table_name);
762 my $cols = $self->_table_columns($table);
764 eval { $col_info = $self->_columns_info_for($table) };
766 $self->_dbic_stmt($table_class,'add_columns',@$cols);
769 if ($self->_is_case_sensitive) {
770 for my $col (keys %$col_info) {
771 $col_info->{$col}{accessor} = lc $col
775 $col_info = { map { lc($_), $col_info->{$_} } keys %$col_info };
778 my $fks = $self->_table_fk_info($table);
780 for my $fkdef (@$fks) {
781 for my $col (@{ $fkdef->{local_columns} }) {
782 $col_info->{$col}{is_foreign_key} = 1;
788 map { $_, ($col_info->{$_}||{}) } @$cols
792 my %uniq_tag; # used to eliminate duplicate uniqs
794 my $pks = $self->_table_pk_info($table) || [];
795 @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
796 : carp("$table has no primary key");
797 $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
799 my $uniqs = $self->_table_uniq_info($table) || [];
801 my ($name, $cols) = @$_;
802 next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
803 $self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
810 Returns a sorted list of loaded tables, using the original database table
818 return keys %{$self->_tables};
821 # Make a moniker from a table
822 sub _default_table2moniker {
823 my ($self, $table) = @_;
825 return join '', map ucfirst, split /[\W_]+/,
826 Lingua::EN::Inflect::Number::to_S(lc $table);
830 my ( $self, $table ) = @_;
834 if( ref $self->moniker_map eq 'HASH' ) {
835 $moniker = $self->moniker_map->{$table};
837 elsif( ref $self->moniker_map eq 'CODE' ) {
838 $moniker = $self->moniker_map->($table);
841 $moniker ||= $self->_default_table2moniker($table);
846 sub _load_relationships {
847 my ($self, $table) = @_;
849 my $tbl_fk_info = $self->_table_fk_info($table);
850 foreach my $fkdef (@$tbl_fk_info) {
851 $fkdef->{remote_source} =
852 $self->monikers->{delete $fkdef->{remote_table}};
854 my $tbl_uniq_info = $self->_table_uniq_info($table);
856 my $local_moniker = $self->monikers->{$table};
857 my $rel_stmts = $self->_relbuilder->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
859 foreach my $src_class (sort keys %$rel_stmts) {
860 my $src_stmts = $rel_stmts->{$src_class};
861 foreach my $stmt (@$src_stmts) {
862 $self->_dbic_stmt($src_class,$stmt->{method},@{$stmt->{args}});
867 # Overload these in driver class:
869 # Returns an arrayref of column names
870 sub _table_columns { croak "ABSTRACT METHOD" }
872 # Returns arrayref of pk col names
873 sub _table_pk_info { croak "ABSTRACT METHOD" }
875 # Returns an arrayref of uniqs [ [ foo => [ col1, col2 ] ], [ bar => [ ... ] ] ]
876 sub _table_uniq_info { croak "ABSTRACT METHOD" }
878 # Returns an arrayref of foreign key constraints, each
879 # being a hashref with 3 keys:
880 # local_columns (arrayref), remote_columns (arrayref), remote_table
881 sub _table_fk_info { croak "ABSTRACT METHOD" }
883 # Returns an array of lower case table names
884 sub _tables_list { croak "ABSTRACT METHOD" }
886 # Execute a constructive DBIC class method, with debug/dump_to_dir hooks.
893 $args = '(' . $args . ')' if @_ < 2;
894 my $stmt = $method . $args . q{;};
896 warn qq|$class\->$stmt\n| if $self->debug;
897 $self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
900 # Store a raw source line for a class (for dumping purposes)
902 my ($self, $class, $stmt) = @_;
903 push(@{$self->{_dump_storage}->{$class}}, $stmt);
906 # Like above, but separately for the externally loaded stuff
908 my ($self, $class, $stmt) = @_;
909 push(@{$self->{_ext_storage}->{$class}}, $stmt);
912 sub _quote_table_name {
913 my ($self, $table) = @_;
915 my $qt = $self->schema->storage->sql_maker->quote_char;
917 return $table unless $qt;
920 return $qt->[0] . $table . $qt->[1];
923 return $qt . $table . $qt;
926 sub _is_case_sensitive { 0 }
930 Returns a hashref of loaded table to moniker mappings. There will
931 be two entries for each table, the original name and the "normalized"
932 name, in the case that the two are different (such as databases
933 that like uppercase table names, or preserve your original mixed-case
934 definitions, or what-have-you).
938 Returns a hashref of table to class mappings. In some cases it will
939 contain multiple entries per table for the original and normalized table
940 names, as above in L</monikers>.
944 L<DBIx::Class::Schema::Loader>