1 package DBIx::Class::Schema::Loader::Base;
5 use base qw/Class::Accessor::Fast/;
7 use Carp::Clan qw/^DBIx::Class/;
8 use UNIVERSAL::require;
9 use DBIx::Class::Schema::Loader::RelBuilder;
10 use Data::Dump qw/ dump /;
17 our $VERSION = '0.04003';
19 __PACKAGE__->mk_ro_accessors(qw/
26 additional_base_classes
47 DBIx::Class::Schema::Loader::Base - Base DBIx::Class::Schema::Loader Implementation.
51 See L<DBIx::Class::Schema::Loader>
55 This is the base class for the storage-specific C<DBIx::Class::Schema::*>
56 classes, and implements the common functionality between them.
58 =head1 CONSTRUCTOR OPTIONS
60 These constructor options are the base options for
61 L<DBIx::Class::Schema::Loader/loader_opts>. Available constructor options are:
63 =head2 skip_relationships
65 Skip setting up relationships. The default is to attempt the loading
70 If set to true, each constructive L<DBIx::Class> statement the loader
71 decides to execute will be C<warn>-ed before execution.
75 Set the name of the schema to load (schema in the sense that your database
76 vendor means it). Does not currently support loading more than one schema
81 Only load tables matching regex. Best specified as a qr// regex.
85 Exclude tables matching regex. Best specified as a qr// regex.
89 Overrides the default table name to moniker translation. Can be either
90 a hashref of table keys and moniker values, or a coderef for a translator
91 function taking a single scalar table name argument and returning
92 a scalar moniker. If the hash entry does not exist, or the function
93 returns a false value, the code falls back to default behavior
96 The default behavior is: C<join '', map ucfirst, split /[\W_]+/, lc $table>,
97 which is to say: lowercase everything, split up the table name into chunks
98 anywhere a non-alpha-numeric character occurs, change the case of first letter
99 of each chunk to upper case, and put the chunks back together. Examples:
101 Table Name | Moniker Name
102 ---------------------------
104 luser_group | LuserGroup
105 luser-opts | LuserOpts
107 =head2 inflect_plural
109 Just like L</moniker_map> above (can be hash/code-ref, falls back to default
110 if hash key does not exist or coderef returns false), but acts as a map
111 for pluralizing relationship names. The default behavior is to utilize
112 L<Lingua::EN::Inflect::Number/to_PL>.
114 =head2 inflect_singular
116 As L</inflect_plural> above, but for singularizing relationship names.
117 Default behavior is to utilize L<Lingua::EN::Inflect::Number/to_S>.
119 =head2 additional_base_classes
121 List of additional base classes all of your table classes will use.
123 =head2 left_base_classes
125 List of additional base classes all of your table classes will use
126 that need to be leftmost.
128 =head2 additional_classes
130 List of additional classes which all of your table classes will use.
134 List of additional components to be loaded into all of your table
135 classes. A good example would be C<ResultSetManager>.
137 =head2 resultset_components
139 List of additional ResultSet components to be loaded into your table
140 classes. A good example would be C<AlwaysRS>. Component
141 C<ResultSetManager> will be automatically added to the above
142 C<components> list if this option is set.
144 =head2 dump_directory
146 This option is designed to be a tool to help you transition from this
147 loader to a manually-defined schema when you decide it's time to do so.
149 The value of this option is a perl libdir pathname. Within
150 that directory this module will create a baseline manual
151 L<DBIx::Class::Schema> module set, based on what it creates at runtime
154 The created schema class will have the same classname as the one on
155 which you are setting this option (and the ResultSource classes will be
156 based on this name as well).
158 Normally you wouldn't hard-code this setting in your schema class, as it
159 is meant for one-time manual usage.
161 See L<DBIx::Class::Schema::Loader/dump_to_dir> for examples of the
162 recommended way to access this functionality.
164 =head2 dump_overwrite
166 Deprecated. See L</really_erase_my_files> below, which does *not* mean
167 the same thing as the old C<dump_overwrite> setting from previous releases.
169 =head2 really_erase_my_files
171 Default false. If true, Loader will unconditionally delete any existing
172 files before creating the new ones from scratch when dumping a schema to disk.
174 The default behavior is instead to only replace the top portion of the
175 file, up to and including the final stanza which contains
176 C<# DO NOT MODIFY THIS OR ANYTHING ABOVE!>
177 leaving any customizations you placed after that as they were.
179 When C<really_erase_my_files> is not set, if the output file already exists,
180 but the aforementioned final stanza is not found, or the checksum
181 contained there does not match the generated contents, Loader will
182 croak and not touch the file.
184 You should really be using version control on your schema classes (and all
185 of the rest of your code for that matter). Don't blame me if a bug in this
186 code wipes something out when it shouldn't have, you've been warned.
190 None of these methods are intended for direct invocation by regular
191 users of L<DBIx::Class::Schema::Loader>. Anything you can find here
192 can also be found via standard L<DBIx::Class::Schema> methods somehow.
196 # ensure that a peice of object data is a valid arrayref, creating
197 # an empty one or encapsulating whatever's there.
198 sub _ensure_arrayref {
203 $self->{$_} = [ $self->{$_} ]
204 unless ref $self->{$_} eq 'ARRAY';
210 Constructor for L<DBIx::Class::Schema::Loader::Base>, used internally
211 by L<DBIx::Class::Schema::Loader>.
216 my ( $class, %args ) = @_;
218 my $self = { %args };
220 bless $self => $class;
222 $self->_ensure_arrayref(qw/additional_classes
223 additional_base_classes
229 push(@{$self->{components}}, 'ResultSetManager')
230 if @{$self->{resultset_components}};
232 $self->{monikers} = {};
233 $self->{classes} = {};
235 $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
236 $self->{schema} ||= $self->{schema_class};
238 croak "dump_overwrite is deprecated. Please read the"
239 . " DBIx::Class::Schema::Loader::Base documentation"
240 if $self->{dump_overwrite};
242 $self->{relbuilder} = DBIx::Class::Schema::Loader::RelBuilder->new(
243 $self->schema_class, $self->inflect_plural, $self->inflect_singular
244 ) if !$self->{skip_relationships};
249 sub _find_file_in_inc {
250 my ($self, $file) = @_;
252 foreach my $prefix (@INC) {
253 my $fullpath = $prefix . '/' . $file;
254 return $fullpath if -f $fullpath;
261 my ($self, $class) = @_;
263 my $class_path = $class;
264 $class_path =~ s{::}{/}g;
265 $class_path .= '.pm';
267 my $inc_path = $self->_find_file_in_inc($class_path);
269 return if !$inc_path;
271 my $real_dump_path = $self->dump_directory
273 File::Spec->catfile($self->dump_directory, $class_path)
276 my $real_inc_path = Cwd::abs_path($inc_path);
277 return if $real_inc_path eq $real_dump_path;
280 croak "Failed to load external class definition"
281 . " for '$class': $@"
284 # If we make it to here, we loaded an external definition
285 warn qq/# Loaded external class definition for '$class'\n/
288 # The rest is only relevant when dumping
289 return if !$self->dump_directory;
291 croak 'Failed to locate actual external module file for '
294 open(my $fh, '<', $real_inc_path)
295 or croak "Failed to open '$real_inc_path' for reading: $!";
296 $self->_ext_stmt($class,
297 qq|# These lines were loaded from '$real_inc_path' found in \@INC.|
298 .q|# They are now part of the custom portion of this file|
299 .q|# for you to hand-edit. If you do not either delete|
300 .q|# this section or remove that file from @INC, this section|
301 .q|# will be repeated redundantly when you re-create this|
302 .q|# file again via Loader!|
306 $self->_ext_stmt($class, $_);
308 $self->_ext_stmt($class,
309 qq|# End of lines loaded from '$real_inc_path' |
312 or croak "Failed to close $real_inc_path: $!";
317 Does the actual schema-construction work.
324 $self->_load_tables($self->_tables_list);
331 Rescan the database for newly added tables. Does
332 not process drops or changes. Returns a list of
333 the newly added table monikers.
335 The schema argument should be the schema class
336 or object to be affected. It should probably
337 be derived from the original schema_class used
343 my ($self, $schema) = @_;
345 $self->{schema} = $schema;
348 my @current = $self->_tables_list;
349 foreach my $table ($self->_tables_list) {
350 if(!exists $self->{_tables}->{$table}) {
351 push(@created, $table);
355 my $loaded = $self->_load_tables(@created);
357 return map { $self->monikers->{$_} } @$loaded;
361 my ($self, @tables) = @_;
363 # First, use _tables_list with constraint and exclude
364 # to get a list of tables to operate on
366 my $constraint = $self->constraint;
367 my $exclude = $self->exclude;
369 @tables = grep { /$constraint/ } @tables if $constraint;
370 @tables = grep { ! /$exclude/ } @tables if $exclude;
372 # Save the new tables to the tables list
374 $self->{_tables}->{$_} = 1;
377 # Set up classes/monikers
379 no warnings 'redefine';
380 local *Class::C3::reinitialize = sub { };
383 $self->_make_src_class($_) for @tables;
386 Class::C3::reinitialize;
388 $self->_setup_src_meta($_) for @tables;
390 if(!$self->skip_relationships) {
391 $self->_load_relationships($_) for @tables;
394 $self->_load_external($_)
395 for map { $self->classes->{$_} } @tables;
397 $self->_dump_to_dir if $self->dump_directory;
399 # Drop temporary cache
400 delete $self->{_cache};
405 sub _get_dump_filename {
406 my ($self, $class) = (@_);
409 return $self->dump_directory . q{/} . $class . q{.pm};
412 sub _ensure_dump_subdirs {
413 my ($self, $class) = (@_);
415 my @name_parts = split(/::/, $class);
416 pop @name_parts; # we don't care about the very last element,
417 # which is a filename
419 my $dir = $self->dump_directory;
422 mkdir($dir) or croak "mkdir('$dir') failed: $!";
424 last if !@name_parts;
425 $dir = File::Spec->catdir($dir, shift @name_parts);
432 my $target_dir = $self->dump_directory;
434 my $schema_class = $self->schema_class;
436 croak "Must specify target directory for dumping!" if ! $target_dir;
438 warn "Dumping manual schema for $schema_class to directory $target_dir ...\n";
441 qq|package $schema_class;\n\n|
442 . qq|use strict;\nuse warnings;\n\n|
443 . qq|use base 'DBIx::Class::Schema';\n\n|
444 . qq|__PACKAGE__->load_classes;\n|;
446 $self->_write_classfile($schema_class, $schema_text);
448 foreach my $src_class (sort keys %{$self->{_dump_storage}}) {
450 qq|package $src_class;\n\n|
451 . qq|use strict;\nuse warnings;\n\n|
452 . qq|use base 'DBIx::Class';\n\n|;
454 $self->_write_classfile($src_class, $src_text);
457 warn "Schema dump completed.\n";
460 sub _write_classfile {
461 my ($self, $class, $text) = @_;
463 my $filename = $self->_get_dump_filename($class);
464 $self->_ensure_dump_subdirs($class);
466 if (-f $filename && $self->really_erase_my_files) {
467 warn "Deleting existing file '$filename' due to "
468 . "'really_erase_my_files' setting\n";
472 my $custom_content = $self->_get_custom_content($class, $filename);
474 $custom_content ||= qq|\n\n# You can replace this text with custom|
475 . qq| content, and it will be preserved on regeneration|
479 for @{$self->{_dump_storage}->{$class} || []};
481 $text .= qq|\n\n# Created by DBIx::Class::Schema::Loader|
482 . qq| v| . $DBIx::Class::Schema::Loader::VERSION
483 . q| @ | . POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
484 . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
486 open(my $fh, '>', $filename)
487 or croak "Cannot open '$filename' for writing: $!";
489 # Write the top half and its MD5 sum
490 print $fh $text . Digest::MD5::md5_base64($text) . "\n";
492 # Write out anything loaded via external partial class file in @INC
494 for @{$self->{_ext_storage}->{$class} || []};
496 print $fh $custom_content;
499 or croak "Cannot close '$filename': $!";
502 sub _get_custom_content {
503 my ($self, $class, $filename) = @_;
505 return if ! -f $filename;
506 open(my $fh, '<', $filename)
507 or croak "Cannot open '$filename' for reading: $!";
510 qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n};
515 if(!$found && /$mark_re/) {
518 croak "Checksum mismatch in '$filename'"
519 if Digest::MD5::md5_base64($buffer) ne $2;
528 croak "Cannot not overwrite '$filename' without 'really_erase_my_files',"
529 . " it does not appear to have been generated by Loader"
541 warn "$target: use $_;" if $self->debug;
542 $self->_raw_stmt($target, "use $_;");
543 $_->require or croak ($_ . "->require: $@");
544 $evalstr .= "package $target; use $_;";
546 eval $evalstr if $evalstr;
553 my $schema_class = $self->schema_class;
555 my $blist = join(q{ }, @_);
556 warn "$target: use base qw/ $blist /;" if $self->debug && @_;
557 $self->_raw_stmt($target, "use base qw/ $blist /;") if @_;
559 $_->require or croak ($_ . "->require: $@");
560 $schema_class->inject_base($target, $_);
564 # Create class with applicable bases, setup monikers, etc
565 sub _make_src_class {
566 my ($self, $table) = @_;
568 my $schema = $self->schema;
569 my $schema_class = $self->schema_class;
571 my $table_moniker = $self->_table2moniker($table);
572 my $table_class = $schema_class . q{::} . $table_moniker;
574 my $table_normalized = lc $table;
575 $self->classes->{$table} = $table_class;
576 $self->classes->{$table_normalized} = $table_class;
577 $self->monikers->{$table} = $table_moniker;
578 $self->monikers->{$table_normalized} = $table_moniker;
580 { no strict 'refs'; @{"${table_class}::ISA"} = qw/DBIx::Class/ }
582 $self->_use ($table_class, @{$self->additional_classes});
583 $self->_inject($table_class, @{$self->additional_base_classes});
585 $self->_dbic_stmt($table_class, 'load_components', @{$self->components}, 'Core');
587 $self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
588 if @{$self->resultset_components};
589 $self->_inject($table_class, @{$self->left_base_classes});
592 # Set up metadata (cols, pks, etc) and register the class with the schema
593 sub _setup_src_meta {
594 my ($self, $table) = @_;
596 my $schema = $self->schema;
597 my $schema_class = $self->schema_class;
599 my $table_class = $self->classes->{$table};
600 my $table_moniker = $self->monikers->{$table};
602 $self->_dbic_stmt($table_class,'table',$table);
604 my $cols = $self->_table_columns($table);
606 eval { $col_info = $self->_columns_info_for($table) };
608 $self->_dbic_stmt($table_class,'add_columns',@$cols);
611 my %col_info_lc = map { lc($_), $col_info->{$_} } keys %$col_info;
615 map { $_, ($col_info_lc{$_}||{}) } @$cols
619 my $pks = $self->_table_pk_info($table) || [];
620 @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
621 : carp("$table has no primary key");
623 my $uniqs = $self->_table_uniq_info($table) || [];
624 $self->_dbic_stmt($table_class,'add_unique_constraint',@$_) for (@$uniqs);
626 $schema_class->register_class($table_moniker, $table_class);
627 $schema->register_class($table_moniker, $table_class) if $schema ne $schema_class;
632 Returns a sorted list of loaded tables, using the original database table
640 return keys %{$self->_tables};
643 # Make a moniker from a table
645 my ( $self, $table ) = @_;
649 if( ref $self->moniker_map eq 'HASH' ) {
650 $moniker = $self->moniker_map->{$table};
652 elsif( ref $self->moniker_map eq 'CODE' ) {
653 $moniker = $self->moniker_map->($table);
656 $moniker ||= join '', map ucfirst, split /[\W_]+/, lc $table;
661 sub _load_relationships {
662 my ($self, $table) = @_;
664 my $tbl_fk_info = $self->_table_fk_info($table);
665 foreach my $fkdef (@$tbl_fk_info) {
666 $fkdef->{remote_source} =
667 $self->monikers->{delete $fkdef->{remote_table}};
670 my $local_moniker = $self->monikers->{$table};
671 my $rel_stmts = $self->{relbuilder}->generate_code($local_moniker, $tbl_fk_info);
673 foreach my $src_class (sort keys %$rel_stmts) {
674 my $src_stmts = $rel_stmts->{$src_class};
675 foreach my $stmt (@$src_stmts) {
676 $self->_dbic_stmt($src_class,$stmt->{method},@{$stmt->{args}});
681 # Overload these in driver class:
683 # Returns an arrayref of column names
684 sub _table_columns { croak "ABSTRACT METHOD" }
686 # Returns arrayref of pk col names
687 sub _table_pk_info { croak "ABSTRACT METHOD" }
689 # Returns an arrayref of uniqs [ [ foo => [ col1, col2 ] ], [ bar => [ ... ] ] ]
690 sub _table_uniq_info { croak "ABSTRACT METHOD" }
692 # Returns an arrayref of foreign key constraints, each
693 # being a hashref with 3 keys:
694 # local_columns (arrayref), remote_columns (arrayref), remote_table
695 sub _table_fk_info { croak "ABSTRACT METHOD" }
697 # Returns an array of lower case table names
698 sub _tables_list { croak "ABSTRACT METHOD" }
700 # Execute a constructive DBIC class method, with debug/dump_to_dir hooks.
706 if(!$self->debug && !$self->dump_directory) {
712 $args = '(' . $args . ')' if @_ < 2;
713 my $stmt = $method . $args . q{;};
715 warn qq|$class\->$stmt\n| if $self->debug;
717 $self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
720 # Store a raw source line for a class (for dumping purposes)
722 my ($self, $class, $stmt) = @_;
723 push(@{$self->{_dump_storage}->{$class}}, $stmt) if $self->dump_directory;
726 # Like above, but separately for the externally loaded stuff
728 my ($self, $class, $stmt) = @_;
729 push(@{$self->{_ext_storage}->{$class}}, $stmt) if $self->dump_directory;
734 Returns a hashref of loaded table to moniker mappings. There will
735 be two entries for each table, the original name and the "normalized"
736 name, in the case that the two are different (such as databases
737 that like uppercase table names, or preserve your original mixed-case
738 definitions, or what-have-you).
742 Returns a hashref of table to class mappings. In some cases it will
743 contain multiple entries per table for the original and normalized table
744 names, as above in L</monikers>.
748 L<DBIx::Class::Schema::Loader>