1 package DBIx::Class::Schema::Loader::Base;
5 use base qw/Class::Accessor::Grouped 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//;
15 use Lingua::EN::Inflect::Phrase qw//;
18 use Class::Inspector ();
19 use Scalar::Util 'looks_like_number';
20 use File::Slurp 'slurp';
21 use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_without_redefine_warnings/;
22 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
27 our $VERSION = '0.07002';
29 __PACKAGE__->mk_group_ro_accessors('simple', qw/
36 additional_base_classes
51 default_resultset_class
55 overwrite_modifications
74 __PACKAGE__->mk_group_accessors('simple', qw/
76 schema_version_to_dump
78 _upgrading_from_load_classes
79 _downgrading_to_load_classes
80 _rewriting_result_namespace
85 pod_comment_spillover_length
89 datetime_undef_if_invalid
94 DBIx::Class::Schema::Loader::Base - Base DBIx::Class::Schema::Loader Implementation.
98 See L<DBIx::Class::Schema::Loader>
102 This is the base class for the storage-specific C<DBIx::Class::Schema::*>
103 classes, and implements the common functionality between them.
105 =head1 CONSTRUCTOR OPTIONS
107 These constructor options are the base options for
108 L<DBIx::Class::Schema::Loader/loader_options>. Available constructor options are:
110 =head2 skip_relationships
112 Skip setting up relationships. The default is to attempt the loading
115 =head2 skip_load_external
117 Skip loading of other classes in @INC. The default is to merge all other classes
118 with the same name found in @INC into the schema file we are creating.
122 Static schemas (ones dumped to disk) will, by default, use the new-style
123 relationship names and singularized Results, unless you're overwriting an
124 existing dump made by an older version of L<DBIx::Class::Schema::Loader>, in
125 which case the backward compatible RelBuilder will be activated, and the
126 appropriate monikerization used.
132 will disable the backward-compatible RelBuilder and use
133 the new-style relationship names along with singularized Results, even when
134 overwriting a dump made with an earlier version.
136 The option also takes a hashref:
138 naming => { relationships => 'v7', monikers => 'v7' }
146 How to name relationship accessors.
150 How to name Result classes.
152 =item column_accessors
154 How to name column accessors in Result classes.
164 Latest style, whatever that happens to be.
168 Unsingularlized monikers, C<has_many> only relationships with no _id stripping.
172 Monikers singularized as whole words, C<might_have> relationships for FKs on
173 C<UNIQUE> constraints, C<_id> stripping for belongs_to relationships.
175 Some of the C<_id> stripping edge cases in C<0.05003> have been reverted for
180 All monikers and relationships are inflected using
181 L<Lingua::EN::Inflect::Phrase>, and there is more aggressive C<_id> stripping
182 from relationship names.
184 In general, there is very little difference between v5 and v6 schemas.
188 This mode is identical to C<v6> mode, except that monikerization of CamelCase
189 table names is also done correctly.
191 CamelCase column names in case-preserving mode will also be handled correctly
192 for relationship name inflection. See L</preserve_case>.
194 In this mode, CamelCase L</column_accessors> are normalized based on case
195 transition instead of just being lowercased, so C<FooId> becomes C<foo_id>.
197 If you don't have any CamelCase table or column names, you can upgrade without
198 breaking any of your code.
202 Dynamic schemas will always default to the 0.04XXX relationship names and won't
203 singularize Results for backward compatibility, to activate the new RelBuilder
204 and singularization put this in your C<Schema.pm> file:
206 __PACKAGE__->naming('current');
208 Or if you prefer to use 0.07XXX features but insure that nothing breaks in the
209 next major version upgrade:
211 __PACKAGE__->naming('v7');
215 By default POD will be generated for columns and relationships, using database
216 metadata for the text if available and supported.
218 Reading database metadata (e.g. C<COMMENT ON TABLE some_table ...>) is only
219 supported for Postgres right now.
221 Set this to C<0> to turn off all POD generation.
223 =head2 pod_comment_mode
225 Controls where table comments appear in the generated POD. Smaller table
226 comments are appended to the C<NAME> section of the documentation, and larger
227 ones are inserted into C<DESCRIPTION> instead. You can force a C<DESCRIPTION>
228 section to be generated with the comment always, only use C<NAME>, or choose
229 the length threshold at which the comment is forced into the description.
235 Use C<NAME> section only.
239 Force C<DESCRIPTION> always.
243 Use C<DESCRIPTION> if length > L</pod_comment_spillover_length>, this is the
248 =head2 pod_comment_spillover_length
250 When pod_comment_mode is set to C<auto>, this is the length of the comment at
251 which it will be forced into a separate description section.
255 =head2 relationship_attrs
257 Hashref of attributes to pass to each generated relationship, listed
258 by type. Also supports relationship type 'all', containing options to
259 pass to all generated relationships. Attributes set for more specific
260 relationship types override those set in 'all'.
264 relationship_attrs => {
265 belongs_to => { is_deferrable => 0 },
268 use this to turn off DEFERRABLE on your foreign key constraints.
272 If set to true, each constructive L<DBIx::Class> statement the loader
273 decides to execute will be C<warn>-ed before execution.
277 Set the name of the schema to load (schema in the sense that your database
278 vendor means it). Does not currently support loading more than one schema
283 Only load tables matching regex. Best specified as a qr// regex.
287 Exclude tables matching regex. Best specified as a qr// regex.
291 Overrides the default table name to moniker translation. Can be either
292 a hashref of table keys and moniker values, or a coderef for a translator
293 function taking a single scalar table name argument and returning
294 a scalar moniker. If the hash entry does not exist, or the function
295 returns a false value, the code falls back to default behavior
298 The default behavior is to split on case transition and non-alphanumeric
299 boundaries, singularize the resulting phrase, then join the titlecased words
302 Table Name | Moniker Name
303 ---------------------------------
305 luser_group | LuserGroup
306 luser-opts | LuserOpt
307 stations_visited | StationVisited
308 routeChange | RouteChange
310 =head2 column_accessor_map
312 Same as moniker_map, but for column accessor names. If a coderef is
313 passed, the code is called with arguments of
315 the name of the column in the underlying database,
316 default accessor name that DBICSL would ordinarily give this column,
318 table_class => name of the DBIC class we are building,
319 table_moniker => calculated moniker for this table (after moniker_map if present),
320 table_name => name of the database table,
321 full_table_name => schema-qualified name of the database table (RDBMS specific),
322 schema_class => name of the schema class we are building,
323 column_info => hashref of column info (data_type, is_nullable, etc),
326 =head2 inflect_plural
328 Just like L</moniker_map> above (can be hash/code-ref, falls back to default
329 if hash key does not exist or coderef returns false), but acts as a map
330 for pluralizing relationship names. The default behavior is to utilize
331 L<Lingua::EN::Inflect::Phrase/to_PL>.
333 =head2 inflect_singular
335 As L</inflect_plural> above, but for singularizing relationship names.
336 Default behavior is to utilize L<Lingua::EN::Inflect::Phrase/to_S>.
338 =head2 schema_base_class
340 Base class for your schema classes. Defaults to 'DBIx::Class::Schema'.
342 =head2 result_base_class
344 Base class for your table classes (aka result classes). Defaults to
347 =head2 additional_base_classes
349 List of additional base classes all of your table classes will use.
351 =head2 left_base_classes
353 List of additional base classes all of your table classes will use
354 that need to be leftmost.
356 =head2 additional_classes
358 List of additional classes which all of your table classes will use.
362 List of additional components to be loaded into all of your table
363 classes. A good example would be
364 L<InflateColumn::DateTime|DBIx::Class::InflateColumn::DateTime>
366 =head2 use_namespaces
368 This is now the default, to go back to L<DBIx::Class::Schema/load_classes> pass
371 Generate result class names suitable for
372 L<DBIx::Class::Schema/load_namespaces> and call that instead of
373 L<DBIx::Class::Schema/load_classes>. When using this option you can also
374 specify any of the options for C<load_namespaces> (i.e. C<result_namespace>,
375 C<resultset_namespace>, C<default_resultset_class>), and they will be added
376 to the call (and the generated result class names adjusted appropriately).
378 =head2 dump_directory
380 The value of this option is a perl libdir pathname. Within
381 that directory this module will create a baseline manual
382 L<DBIx::Class::Schema> module set, based on what it creates at runtime.
384 The created schema class will have the same classname as the one on
385 which you are setting this option (and the ResultSource classes will be
386 based on this name as well).
388 Normally you wouldn't hard-code this setting in your schema class, as it
389 is meant for one-time manual usage.
391 See L<DBIx::Class::Schema::Loader/dump_to_dir> for examples of the
392 recommended way to access this functionality.
394 =head2 dump_overwrite
396 Deprecated. See L</really_erase_my_files> below, which does *not* mean
397 the same thing as the old C<dump_overwrite> setting from previous releases.
399 =head2 really_erase_my_files
401 Default false. If true, Loader will unconditionally delete any existing
402 files before creating the new ones from scratch when dumping a schema to disk.
404 The default behavior is instead to only replace the top portion of the
405 file, up to and including the final stanza which contains
406 C<# DO NOT MODIFY THE FIRST PART OF THIS FILE>
407 leaving any customizations you placed after that as they were.
409 When C<really_erase_my_files> is not set, if the output file already exists,
410 but the aforementioned final stanza is not found, or the checksum
411 contained there does not match the generated contents, Loader will
412 croak and not touch the file.
414 You should really be using version control on your schema classes (and all
415 of the rest of your code for that matter). Don't blame me if a bug in this
416 code wipes something out when it shouldn't have, you've been warned.
418 =head2 overwrite_modifications
420 Default false. If false, when updating existing files, Loader will
421 refuse to modify any Loader-generated code that has been modified
422 since its last run (as determined by the checksum Loader put in its
425 If true, Loader will discard any manual modifications that have been
426 made to Loader-generated code.
428 Again, you should be using version control on your schema classes. Be
429 careful with this option.
431 =head2 custom_column_info
433 Hook for adding extra attributes to the
434 L<column_info|DBIx::Class::ResultSource/column_info> for a column.
436 Must be a coderef that returns a hashref with the extra attributes.
438 Receives the table name, column name and column_info.
442 custom_column_info => sub {
443 my ($table_name, $column_name, $column_info) = @_;
445 if ($column_name eq 'dog' && $column_info->{default_value} eq 'snoopy') {
446 return { is_snoopy => 1 };
450 This attribute can also be used to set C<inflate_datetime> on a non-datetime
451 column so it also receives the L</datetime_timezone> and/or L</datetime_locale>.
453 =head2 datetime_timezone
455 Sets the timezone attribute for L<DBIx::Class::InflateColumn::DateTime> for all
456 columns with the DATE/DATETIME/TIMESTAMP data_types.
458 =head2 datetime_locale
460 Sets the locale attribute for L<DBIx::Class::InflateColumn::DateTime> for all
461 columns with the DATE/DATETIME/TIMESTAMP data_types.
463 =head2 datetime_undef_if_invalid
465 Pass a C<0> for this option when using MySQL if you B<DON'T> want C<<
466 datetime_undef_if_invalid => 1 >> in your column info for DATE, DATETIME and
469 The default is recommended to deal with data such as C<00/00/00> which
470 sometimes ends up in such columns in MySQL.
474 File in Perl format, which should return a HASH reference, from which to read
479 Usually column names are lowercased, to make them easier to work with in
480 L<DBIx::Class>. This option lets you turn this behavior off, if the driver
483 Drivers for case sensitive databases like Sybase ASE or MSSQL with a
484 case-sensitive collation will turn this option on unconditionally.
486 Currently the drivers for SQLite, mysql, MSSQL and Firebird/InterBase support
489 =head2 qualify_objects
491 Set to true to prepend the L</db_schema> to table names for C<<
492 __PACKAGE__->table >> calls, and to some other things like Oracle sequences.
496 Creates Schema and Result classes that use L<Moose>, L<MooseX::NonMoose> and
497 L<namespace::autoclean>. The default content after the md5 sum also makes the
500 It is safe to upgrade your existing Schema to this option.
502 =head2 col_collision_map
504 This option controls how accessors for column names which collide with perl
505 methods are named. See L</COLUMN ACCESSOR COLLISIONS> for more information.
507 This option takes either a single L<sprintf|perlfunc/sprintf> format or a hashref of
508 strings which are compiled to regular expressions that map to
509 L<sprintf|perlfunc/sprintf> formats.
513 col_collision_map => 'column_%s'
515 col_collision_map => { '(.*)' => 'column_%s' }
517 col_collision_map => { '(foo).*(bar)' => 'column_%s_%s' }
521 None of these methods are intended for direct invocation by regular
522 users of L<DBIx::Class::Schema::Loader>. Some are proxied via
523 L<DBIx::Class::Schema::Loader>.
527 my $CURRENT_V = 'v7';
530 schema_base_class result_base_class additional_base_classes
531 left_base_classes additional_classes components
534 # ensure that a peice of object data is a valid arrayref, creating
535 # an empty one or encapsulating whatever's there.
536 sub _ensure_arrayref {
541 $self->{$_} = [ $self->{$_} ]
542 unless ref $self->{$_} eq 'ARRAY';
548 Constructor for L<DBIx::Class::Schema::Loader::Base>, used internally
549 by L<DBIx::Class::Schema::Loader>.
554 my ( $class, %args ) = @_;
556 my $self = { %args };
558 # don't lose undef options
559 for (values %$self) {
560 $_ = 0 unless defined $_;
563 bless $self => $class;
565 if (my $config_file = $self->config_file) {
566 my $config_opts = do $config_file;
568 croak "Error reading config from $config_file: $@" if $@;
570 croak "Config file $config_file must be a hashref" unless ref($config_opts) eq 'HASH';
572 while (my ($k, $v) = each %$config_opts) {
573 $self->{$k} = $v unless exists $self->{$k};
577 $self->_ensure_arrayref(qw/additional_classes
578 additional_base_classes
583 $self->_validate_class_args;
585 if ($self->use_moose) {
586 if (not DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose')) {
587 die sprintf "You must install the following CPAN modules to enable the use_moose option: %s.\n",
588 DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('use_moose');
592 $self->{monikers} = {};
593 $self->{classes} = {};
594 $self->{_upgrading_classes} = {};
596 $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
597 $self->{schema} ||= $self->{schema_class};
599 croak "dump_overwrite is deprecated. Please read the"
600 . " DBIx::Class::Schema::Loader::Base documentation"
601 if $self->{dump_overwrite};
603 $self->{dynamic} = ! $self->{dump_directory};
604 $self->{temp_directory} ||= File::Temp::tempdir( 'dbicXXXX',
609 $self->{dump_directory} ||= $self->{temp_directory};
611 $self->real_dump_directory($self->{dump_directory});
613 $self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
614 $self->schema_version_to_dump($DBIx::Class::Schema::Loader::VERSION);
616 if ((not ref $self->naming) && defined $self->naming) {
617 my $naming_ver = $self->naming;
619 relationships => $naming_ver,
620 monikers => $naming_ver,
621 column_accessors => $naming_ver,
626 for (values %{ $self->naming }) {
627 $_ = $CURRENT_V if $_ eq 'current';
630 $self->{naming} ||= {};
632 if ($self->custom_column_info && ref $self->custom_column_info ne 'CODE') {
633 croak 'custom_column_info must be a CODE ref';
636 $self->_check_back_compat;
638 $self->use_namespaces(1) unless defined $self->use_namespaces;
639 $self->generate_pod(1) unless defined $self->generate_pod;
640 $self->pod_comment_mode('auto') unless defined $self->pod_comment_mode;
641 $self->pod_comment_spillover_length(60) unless defined $self->pod_comment_spillover_length;
643 if (my $col_collision_map = $self->col_collision_map) {
644 if (my $reftype = ref $col_collision_map) {
645 if ($reftype ne 'HASH') {
646 croak "Invalid type $reftype for option 'col_collision_map'";
650 $self->col_collision_map({ '(.*)' => $col_collision_map });
657 sub _check_back_compat {
660 # dynamic schemas will always be in 0.04006 mode, unless overridden
661 if ($self->dynamic) {
662 # just in case, though no one is likely to dump a dynamic schema
663 $self->schema_version_to_dump('0.04006');
665 if (not %{ $self->naming }) {
666 warn <<EOF unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
668 Dynamic schema detected, will run in 0.04006 mode.
670 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
671 to disable this warning.
673 Also consider setting 'use_namespaces => 1' if/when upgrading.
675 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
680 $self->_upgrading_from('v4');
683 $self->naming->{relationships} ||= 'v4';
684 $self->naming->{monikers} ||= 'v4';
686 if ($self->use_namespaces) {
687 $self->_upgrading_from_load_classes(1);
690 $self->use_namespaces(0);
696 # otherwise check if we need backcompat mode for a static schema
697 my $filename = $self->_get_dump_filename($self->schema_class);
698 return unless -e $filename;
700 my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom) =
701 $self->_parse_generated_file($filename);
703 return unless $old_ver;
705 # determine if the existing schema was dumped with use_moose => 1
706 if (! defined $self->use_moose) {
707 $self->{use_moose} = 1 if $old_gen =~ /^ (?!\s*\#) use \s+ Moose/xm;
710 my $load_classes = ($old_gen =~ /^__PACKAGE__->load_classes;/m) ? 1 : 0;
711 my $result_namespace = do { ($old_gen =~ /result_namespace => '([^']+)'/) ? $1 : '' };
713 if ($load_classes && (not defined $self->use_namespaces)) {
714 warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
716 'load_classes;' static schema detected, turning off 'use_namespaces'.
718 Set the 'use_namespaces' attribute or the SCHEMA_LOADER_BACKCOMPAT environment
719 variable to disable this warning.
721 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
724 $self->use_namespaces(0);
726 elsif ($load_classes && $self->use_namespaces) {
727 $self->_upgrading_from_load_classes(1);
729 elsif ((not $load_classes) && defined $self->use_namespaces && ! $self->use_namespaces) {
730 $self->_downgrading_to_load_classes(
731 $result_namespace || 'Result'
734 elsif ((not defined $self->use_namespaces) || $self->use_namespaces) {
735 if (not $self->result_namespace) {
736 $self->result_namespace($result_namespace || 'Result');
738 elsif ($result_namespace ne $self->result_namespace) {
739 $self->_rewriting_result_namespace(
740 $result_namespace || 'Result'
745 # XXX when we go past .0 this will need fixing
746 my ($v) = $old_ver =~ /([1-9])/;
749 return if ($v eq $CURRENT_V || $old_ver =~ /^0\.\d\d999/);
751 if (not %{ $self->naming }) {
752 warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
754 Version $old_ver static schema detected, turning on backcompat mode.
756 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
757 to disable this warning.
759 See: 'naming' in perldoc DBIx::Class::Schema::Loader::Base .
761 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 if upgrading
762 from version 0.04006.
765 $self->naming->{relationships} ||= $v;
766 $self->naming->{monikers} ||= $v;
767 $self->naming->{column_accessors} ||= $v;
769 $self->schema_version_to_dump($old_ver);
772 $self->_upgrading_from($v);
776 sub _validate_class_args {
780 foreach my $k (@CLASS_ARGS) {
781 next unless $self->$k;
783 my @classes = ref $self->$k eq 'ARRAY' ? @{ $self->$k } : $self->$k;
784 foreach my $c (@classes) {
785 # components default to being under the DBIx::Class namespace unless they
786 # are preceeded with a '+'
787 if ( $k =~ m/components$/ && $c !~ s/^\+// ) {
788 $c = 'DBIx::Class::' . $c;
791 # 1 == installed, 0 == not installed, undef == invalid classname
792 my $installed = Class::Inspector->installed($c);
793 if ( defined($installed) ) {
794 if ( $installed == 0 ) {
795 croak qq/$c, as specified in the loader option "$k", is not installed/;
798 croak qq/$c, as specified in the loader option "$k", is an invalid class name/;
804 sub _find_file_in_inc {
805 my ($self, $file) = @_;
807 foreach my $prefix (@INC) {
808 my $fullpath = File::Spec->catfile($prefix, $file);
809 return $fullpath if -f $fullpath
810 # abs_path throws on Windows for nonexistant files
811 and (try { Cwd::abs_path($fullpath) }) ne
812 ((try { Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) }) || '');
819 my ($self, $class) = @_;
821 my $class_path = $class;
822 $class_path =~ s{::}{/}g;
823 $class_path .= '.pm';
828 sub _find_class_in_inc {
829 my ($self, $class) = @_;
831 return $self->_find_file_in_inc($self->_class_path($class));
837 return $self->_upgrading_from
838 || $self->_upgrading_from_load_classes
839 || $self->_downgrading_to_load_classes
840 || $self->_rewriting_result_namespace
844 sub _rewrite_old_classnames {
845 my ($self, $code) = @_;
847 return $code unless $self->_rewriting;
849 my %old_classes = reverse %{ $self->_upgrading_classes };
851 my $re = join '|', keys %old_classes;
854 $code =~ s/$re/$old_classes{$1} || $1/eg;
860 my ($self, $class) = @_;
862 return if $self->{skip_load_external};
864 # so that we don't load our own classes, under any circumstances
865 local *INC = [ grep $_ ne $self->dump_directory, @INC ];
867 my $real_inc_path = $self->_find_class_in_inc($class);
869 my $old_class = $self->_upgrading_classes->{$class}
870 if $self->_rewriting;
872 my $old_real_inc_path = $self->_find_class_in_inc($old_class)
873 if $old_class && $old_class ne $class;
875 return unless $real_inc_path || $old_real_inc_path;
877 if ($real_inc_path) {
878 # If we make it to here, we loaded an external definition
879 warn qq/# Loaded external class definition for '$class'\n/
882 my $code = $self->_rewrite_old_classnames(scalar slurp $real_inc_path);
884 if ($self->dynamic) { # load the class too
885 eval_without_redefine_warnings($code);
888 $self->_ext_stmt($class,
889 qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
890 .qq|# They are now part of the custom portion of this file\n|
891 .qq|# for you to hand-edit. If you do not either delete\n|
892 .qq|# this section or remove that file from \@INC, this section\n|
893 .qq|# will be repeated redundantly when you re-create this\n|
894 .qq|# file again via Loader! See skip_load_external to disable\n|
895 .qq|# this feature.\n|
898 $self->_ext_stmt($class, $code);
899 $self->_ext_stmt($class,
900 qq|# End of lines loaded from '$real_inc_path' |
904 if ($old_real_inc_path) {
905 my $code = slurp $old_real_inc_path;
907 $self->_ext_stmt($class, <<"EOF");
909 # These lines were loaded from '$old_real_inc_path',
910 # based on the Result class name that would have been created by an older
911 # version of the Loader. For a static schema, this happens only once during
912 # upgrade. See skip_load_external to disable this feature.
915 $code = $self->_rewrite_old_classnames($code);
917 if ($self->dynamic) {
920 Detected external content in '$old_real_inc_path', a class name that would have
921 been used by an older version of the Loader.
923 * PLEASE RENAME THIS CLASS: from '$old_class' to '$class', as that is the
924 new name of the Result.
926 eval_without_redefine_warnings($code);
930 $self->_ext_stmt($class, $code);
931 $self->_ext_stmt($class,
932 qq|# End of lines loaded from '$old_real_inc_path' |
939 Does the actual schema-construction work.
947 $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude })
955 Rescan the database for changes. Returns a list of the newly added table
958 The schema argument should be the schema class or object to be affected. It
959 should probably be derived from the original schema_class used during L</load>.
964 my ($self, $schema) = @_;
966 $self->{schema} = $schema;
967 $self->_relbuilder->{schema} = $schema;
970 my @current = $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude });
972 foreach my $table (@current) {
973 if(!exists $self->{_tables}->{$table}) {
974 push(@created, $table);
979 @current{@current} = ();
980 foreach my $table (keys %{ $self->{_tables} }) {
981 if (not exists $current{$table}) {
982 $self->_unregister_source_for_table($table);
986 delete $self->{_dump_storage};
987 delete $self->{_relations_started};
989 my $loaded = $self->_load_tables(@current);
991 return map { $self->monikers->{$_} } @created;
997 return if $self->{skip_relationships};
999 return $self->{relbuilder} ||= do {
1001 no warnings 'uninitialized';
1002 my $relbuilder_suff =
1008 ->{ $self->naming->{relationships}};
1010 my $relbuilder_class = 'DBIx::Class::Schema::Loader::RelBuilder'.$relbuilder_suff;
1011 eval "require $relbuilder_class"; die $@ if $@;
1012 $relbuilder_class->new( $self );
1018 my ($self, @tables) = @_;
1020 # Save the new tables to the tables list
1022 $self->{_tables}->{$_} = 1;
1025 $self->_make_src_class($_) for @tables;
1027 # sanity-check for moniker clashes
1028 my $inverse_moniker_idx;
1029 for (keys %{$self->monikers}) {
1030 push @{$inverse_moniker_idx->{$self->monikers->{$_}}}, $_;
1034 for (keys %$inverse_moniker_idx) {
1035 my $tables = $inverse_moniker_idx->{$_};
1037 push @clashes, sprintf ("tables %s reduced to the same source moniker '%s'",
1038 join (', ', map { "'$_'" } @$tables),
1045 die 'Unable to load schema - chosen moniker/class naming style results in moniker clashes. '
1046 . 'Either change the naming style, or supply an explicit moniker_map: '
1047 . join ('; ', @clashes)
1053 $self->_setup_src_meta($_) for @tables;
1055 if(!$self->skip_relationships) {
1056 # The relationship loader needs a working schema
1058 local $self->{dump_directory} = $self->{temp_directory};
1059 $self->_reload_classes(\@tables);
1060 $self->_load_relationships($_) for @tables;
1061 $self->_relbuilder->cleanup;
1064 # Remove that temp dir from INC so it doesn't get reloaded
1065 @INC = grep $_ ne $self->dump_directory, @INC;
1068 $self->_load_external($_)
1069 for map { $self->classes->{$_} } @tables;
1071 # Reload without unloading first to preserve any symbols from external
1073 $self->_reload_classes(\@tables, { unload => 0 });
1075 # Drop temporary cache
1076 delete $self->{_cache};
1081 sub _reload_classes {
1082 my ($self, $tables, $opts) = @_;
1084 my @tables = @$tables;
1086 my $unload = $opts->{unload};
1087 $unload = 1 unless defined $unload;
1089 # so that we don't repeat custom sections
1090 @INC = grep $_ ne $self->dump_directory, @INC;
1092 $self->_dump_to_dir(map { $self->classes->{$_} } @tables);
1094 unshift @INC, $self->dump_directory;
1097 my %have_source = map { $_ => $self->schema->source($_) }
1098 $self->schema->sources;
1100 for my $table (@tables) {
1101 my $moniker = $self->monikers->{$table};
1102 my $class = $self->classes->{$table};
1105 no warnings 'redefine';
1106 local *Class::C3::reinitialize = sub {}; # to speed things up, reinitialized below
1109 if (my $mc = $self->_moose_metaclass($class)) {
1112 Class::Unload->unload($class) if $unload;
1113 my ($source, $resultset_class);
1115 ($source = $have_source{$moniker})
1116 && ($resultset_class = $source->resultset_class)
1117 && ($resultset_class ne 'DBIx::Class::ResultSet')
1119 my $has_file = Class::Inspector->loaded_filename($resultset_class);
1120 if (my $mc = $self->_moose_metaclass($resultset_class)) {
1123 Class::Unload->unload($resultset_class) if $unload;
1124 $self->_reload_class($resultset_class) if $has_file;
1126 $self->_reload_class($class);
1128 push @to_register, [$moniker, $class];
1131 Class::C3->reinitialize;
1132 for (@to_register) {
1133 $self->schema->register_class(@$_);
1137 sub _moose_metaclass {
1138 return undef unless $INC{'Class/MOP.pm'}; # if CMOP is not loaded the class could not have loaded in the 1st place
1142 my $mc = try { Class::MOP::class_of($class) }
1145 return $mc->isa('Moose::Meta::Class') ? $mc : undef;
1148 # We use this instead of ensure_class_loaded when there are package symbols we
1151 my ($self, $class) = @_;
1153 my $class_path = $self->_class_path($class);
1154 delete $INC{ $class_path };
1156 # kill redefined warnings
1158 eval_without_redefine_warnings ("require $class");
1161 my $source = slurp $self->_get_dump_filename($class);
1162 die "Failed to reload class $class: $_.\n\nCLASS SOURCE:\n\n$source";
1166 sub _get_dump_filename {
1167 my ($self, $class) = (@_);
1169 $class =~ s{::}{/}g;
1170 return $self->dump_directory . q{/} . $class . q{.pm};
1173 =head2 get_dump_filename
1177 Returns the full path to the file for a class that the class has been or will
1178 be dumped to. This is a file in a temp dir for a dynamic schema.
1182 sub get_dump_filename {
1183 my ($self, $class) = (@_);
1185 local $self->{dump_directory} = $self->real_dump_directory;
1187 return $self->_get_dump_filename($class);
1190 sub _ensure_dump_subdirs {
1191 my ($self, $class) = (@_);
1193 my @name_parts = split(/::/, $class);
1194 pop @name_parts; # we don't care about the very last element,
1195 # which is a filename
1197 my $dir = $self->dump_directory;
1200 mkdir($dir) or croak "mkdir('$dir') failed: $!";
1202 last if !@name_parts;
1203 $dir = File::Spec->catdir($dir, shift @name_parts);
1208 my ($self, @classes) = @_;
1210 my $schema_class = $self->schema_class;
1211 my $schema_base_class = $self->schema_base_class || 'DBIx::Class::Schema';
1213 my $target_dir = $self->dump_directory;
1214 warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
1215 unless $self->{dynamic} or $self->{quiet};
1218 qq|package $schema_class;\n\n|
1219 . qq|# Created by DBIx::Class::Schema::Loader\n|
1220 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
1222 if ($self->use_moose) {
1223 $schema_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends '$schema_base_class';\n\n|;
1226 $schema_text .= qq|use strict;\nuse warnings;\n\nuse base '$schema_base_class';\n\n|;
1229 if ($self->use_namespaces) {
1230 $schema_text .= qq|__PACKAGE__->load_namespaces|;
1231 my $namespace_options;
1233 my @attr = qw/resultset_namespace default_resultset_class/;
1235 unshift @attr, 'result_namespace' unless (not $self->result_namespace) || $self->result_namespace eq 'Result';
1237 for my $attr (@attr) {
1239 $namespace_options .= qq| $attr => '| . $self->$attr . qq|',\n|
1242 $schema_text .= qq|(\n$namespace_options)| if $namespace_options;
1243 $schema_text .= qq|;\n|;
1246 $schema_text .= qq|__PACKAGE__->load_classes;\n|;
1250 local $self->{version_to_dump} = $self->schema_version_to_dump;
1251 $self->_write_classfile($schema_class, $schema_text, 1);
1254 my $result_base_class = $self->result_base_class || 'DBIx::Class::Core';
1256 foreach my $src_class (@classes) {
1258 qq|package $src_class;\n\n|
1259 . qq|# Created by DBIx::Class::Schema::Loader\n|
1260 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
1261 . qq|use strict;\nuse warnings;\n\n|;
1262 if ($self->use_moose) {
1263 $src_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;|;
1265 # these options 'use base' which is compile time
1266 if (@{ $self->left_base_classes } || @{ $self->additional_base_classes }) {
1267 $src_text .= qq|\nBEGIN { extends '$result_base_class' }\n\n|;
1270 $src_text .= qq|\nextends '$result_base_class';\n\n|;
1274 $src_text .= qq|use base '$result_base_class';\n\n|;
1276 $self->_write_classfile($src_class, $src_text);
1279 # remove Result dir if downgrading from use_namespaces, and there are no
1281 if (my $result_ns = $self->_downgrading_to_load_classes
1282 || $self->_rewriting_result_namespace) {
1283 my $result_namespace = $self->_result_namespace(
1288 (my $result_dir = $result_namespace) =~ s{::}{/}g;
1289 $result_dir = $self->dump_directory . '/' . $result_dir;
1291 unless (my @files = glob "$result_dir/*") {
1296 warn "Schema dump completed.\n" unless $self->{dynamic} or $self->{quiet};
1301 my ($self, $version, $ts) = @_;
1302 return qq|\n\n# Created by DBIx::Class::Schema::Loader|
1305 . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
1308 sub _write_classfile {
1309 my ($self, $class, $text, $is_schema) = @_;
1311 my $filename = $self->_get_dump_filename($class);
1312 $self->_ensure_dump_subdirs($class);
1314 if (-f $filename && $self->really_erase_my_files) {
1315 warn "Deleting existing file '$filename' due to "
1316 . "'really_erase_my_files' setting\n" unless $self->{quiet};
1320 my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom)
1321 = $self->_parse_generated_file($filename);
1323 if (! $old_gen && -f $filename) {
1324 croak "Cannot overwrite '$filename' without 'really_erase_my_files',"
1325 . " it does not appear to have been generated by Loader"
1328 my $custom_content = $old_custom || '';
1330 # prepend extra custom content from a *renamed* class (singularization effect)
1331 if (my $renamed_class = $self->_upgrading_classes->{$class}) {
1332 my $old_filename = $self->_get_dump_filename($renamed_class);
1334 if (-f $old_filename) {
1335 my $extra_custom = ($self->_parse_generated_file ($old_filename))[4];
1337 $extra_custom =~ s/\n\n# You can replace.*\n1;\n//;
1339 $custom_content = join ("\n", '', $extra_custom, $custom_content)
1342 unlink $old_filename;
1346 $custom_content ||= $self->_default_custom_content;
1348 # If upgrading to use_moose=1 replace default custom content with default Moose custom content.
1349 # If there is already custom content, which does not have the Moose content, add it.
1350 if ($self->use_moose) {
1352 my $non_moose_custom_content = do {
1353 local $self->{use_moose} = 0;
1354 $self->_default_custom_content;
1357 if ($custom_content eq $non_moose_custom_content) {
1358 $custom_content = $self->_default_custom_content;
1360 elsif ($custom_content !~ /\Q@{[$self->_default_moose_custom_content]}\E/) {
1361 $custom_content .= $self->_default_custom_content;
1364 elsif (defined $self->use_moose && $old_gen) {
1365 croak 'It is not possible to "downgrade" a schema that was loaded with use_moose => 1 to use_moose => 0, due to differing custom content'
1366 if $old_gen =~ /use \s+ MooseX?\b/x;
1369 $custom_content = $self->_rewrite_old_classnames($custom_content);
1372 for @{$self->{_dump_storage}->{$class} || []};
1374 # Check and see if the dump is infact differnt
1378 $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
1379 if (Digest::MD5::md5_base64($compare_to) eq $old_md5) {
1380 return unless $self->_upgrading_from && $is_schema;
1384 $text .= $self->_sig_comment(
1385 $self->version_to_dump,
1386 POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
1389 open(my $fh, '>', $filename)
1390 or croak "Cannot open '$filename' for writing: $!";
1392 # Write the top half and its MD5 sum
1393 print $fh $text . Digest::MD5::md5_base64($text) . "\n";
1395 # Write out anything loaded via external partial class file in @INC
1397 for @{$self->{_ext_storage}->{$class} || []};
1399 # Write out any custom content the user has added
1400 print $fh $custom_content;
1403 or croak "Error closing '$filename': $!";
1406 sub _default_moose_custom_content {
1407 return qq|\n__PACKAGE__->meta->make_immutable;|;
1410 sub _default_custom_content {
1412 my $default = qq|\n\n# You can replace this text with custom|
1413 . qq| code or comments, and it will be preserved on regeneration|;
1414 if ($self->use_moose) {
1415 $default .= $self->_default_moose_custom_content;
1417 $default .= qq|\n1;\n|;
1421 sub _parse_generated_file {
1422 my ($self, $fn) = @_;
1424 return unless -f $fn;
1426 open(my $fh, '<', $fn)
1427 or croak "Cannot open '$fn' for reading: $!";
1430 qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n};
1432 my ($md5, $ts, $ver, $gen);
1438 # Pull out the version and timestamp from the line above
1439 ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)\Z/m;
1442 croak "Checksum mismatch in '$fn', the auto-generated part of the file has been modified outside of this loader. Aborting.\nIf you want to overwrite these modifications, set the 'overwrite_modifications' loader option.\n"
1443 if !$self->overwrite_modifications && Digest::MD5::md5_base64($gen) ne $md5;
1452 my $custom = do { local $/; <$fh> }
1457 return ($gen, $md5, $ver, $ts, $custom);
1465 warn "$target: use $_;" if $self->debug;
1466 $self->_raw_stmt($target, "use $_;");
1474 my $blist = join(q{ }, @_);
1476 return unless $blist;
1478 warn "$target: use base qw/$blist/;" if $self->debug;
1479 $self->_raw_stmt($target, "use base qw/$blist/;");
1482 sub _result_namespace {
1483 my ($self, $schema_class, $ns) = @_;
1484 my @result_namespace;
1486 if ($ns =~ /^\+(.*)/) {
1487 # Fully qualified namespace
1488 @result_namespace = ($1)
1491 # Relative namespace
1492 @result_namespace = ($schema_class, $ns);
1495 return wantarray ? @result_namespace : join '::', @result_namespace;
1498 # Create class with applicable bases, setup monikers, etc
1499 sub _make_src_class {
1500 my ($self, $table) = @_;
1502 my $schema = $self->schema;
1503 my $schema_class = $self->schema_class;
1505 my $table_moniker = $self->_table2moniker($table);
1506 my @result_namespace = ($schema_class);
1507 if ($self->use_namespaces) {
1508 my $result_namespace = $self->result_namespace || 'Result';
1509 @result_namespace = $self->_result_namespace(
1514 my $table_class = join(q{::}, @result_namespace, $table_moniker);
1516 if ((my $upgrading_v = $self->_upgrading_from)
1517 || $self->_rewriting) {
1518 local $self->naming->{monikers} = $upgrading_v
1521 my @result_namespace = @result_namespace;
1522 if ($self->_upgrading_from_load_classes) {
1523 @result_namespace = ($schema_class);
1525 elsif (my $ns = $self->_downgrading_to_load_classes) {
1526 @result_namespace = $self->_result_namespace(
1531 elsif ($ns = $self->_rewriting_result_namespace) {
1532 @result_namespace = $self->_result_namespace(
1538 my $old_class = join(q{::}, @result_namespace,
1539 $self->_table2moniker($table));
1541 $self->_upgrading_classes->{$table_class} = $old_class
1542 unless $table_class eq $old_class;
1545 # this was a bad idea, should be ok now without it
1546 # my $table_normalized = lc $table;
1547 # $self->classes->{$table_normalized} = $table_class;
1548 # $self->monikers->{$table_normalized} = $table_moniker;
1550 $self->classes->{$table} = $table_class;
1551 $self->monikers->{$table} = $table_moniker;
1553 $self->_use ($table_class, @{$self->additional_classes});
1554 $self->_inject($table_class, @{$self->left_base_classes});
1556 if (my @components = @{ $self->components }) {
1557 $self->_dbic_stmt($table_class, 'load_components', @components);
1560 $self->_inject($table_class, @{$self->additional_base_classes});
1563 sub _resolve_col_accessor_collisions {
1564 my ($self, $table, $col_info) = @_;
1566 my $base = $self->result_base_class || 'DBIx::Class::Core';
1567 my @components = map "DBIx::Class::$_", @{ $self->components || [] };
1569 my $table_name = ref $table ? $$table : $table;
1573 for my $class ($base, @components, $self->use_moose ? 'Moose::Object' : ()) {
1574 eval "require ${class};";
1577 push @methods, @{ Class::Inspector->methods($class) || [] };
1580 push @methods, @{ Class::Inspector->methods('UNIVERSAL') };
1583 @methods{@methods} = ();
1586 $methods{meta} = undef;
1588 while (my ($col, $info) = each %$col_info) {
1589 my $accessor = $info->{accessor} || $col;
1591 next if $accessor eq 'id'; # special case (very common column)
1593 if (exists $methods{$accessor}) {
1596 if (my $map = $self->col_collision_map) {
1597 for my $re (keys %$map) {
1598 if (my @matches = $col =~ /$re/) {
1599 $info->{accessor} = sprintf $map->{$re}, @matches;
1607 Column $col in table $table_name collides with an inherited method.
1608 See "COLUMN ACCESSOR COLLISIONS" in perldoc DBIx::Class::Schema::Loader::Base .
1610 $info->{accessor} = undef;
1616 # use the same logic to run moniker_map, column_accessor_map, and
1617 # relationship_name_map
1619 my ( $self, $map, $default_code, $ident, @extra ) = @_;
1621 my $default_ident = $default_code->( $ident, @extra );
1623 if( $map && ref $map eq 'HASH' ) {
1624 $new_ident = $map->{ $ident };
1626 elsif( $map && ref $map eq 'CODE' ) {
1627 $new_ident = $map->( $ident, $default_ident, @extra );
1630 $new_ident ||= $default_ident;
1635 sub _default_column_accessor_name {
1636 my ( $self, $column_name ) = @_;
1638 my $accessor_name = $column_name;
1639 $accessor_name =~ s/\W+/_/g;
1641 if ((($self->naming->{column_accessors}||'') =~ /(\d+)/ && $1 < 7) || (not $self->preserve_case)) {
1642 # older naming just lc'd the col accessor and that's all.
1643 return lc $accessor_name;
1646 return join '_', map lc, split_name $column_name;
1650 sub _make_column_accessor_name {
1651 my ($self, $column_name, $column_context_info ) = @_;
1653 my $accessor = $self->_run_user_map(
1654 $self->column_accessor_map,
1655 sub { $self->_default_column_accessor_name( shift ) },
1657 $column_context_info,
1663 # Set up metadata (cols, pks, etc)
1664 sub _setup_src_meta {
1665 my ($self, $table) = @_;
1667 my $schema = $self->schema;
1668 my $schema_class = $self->schema_class;
1670 my $table_class = $self->classes->{$table};
1671 my $table_moniker = $self->monikers->{$table};
1673 my $table_name = $table;
1674 my $name_sep = $self->schema->storage->sql_maker->name_sep;
1676 if ($name_sep && $table_name =~ /\Q$name_sep\E/) {
1677 $table_name = \ $self->_quote_table_name($table_name);
1680 my $full_table_name = ($self->qualify_objects ? ($self->db_schema . '.') : '') . (ref $table_name ? $$table_name : $table_name);
1682 # be careful to not create refs Data::Dump can "optimize"
1683 $full_table_name = \do {"".$full_table_name} if ref $table_name;
1685 $self->_dbic_stmt($table_class, 'table', $full_table_name);
1687 my $cols = $self->_table_columns($table);
1688 my $col_info = $self->__columns_info_for($table);
1690 ### generate all the column accessor names
1691 while (my ($col, $info) = each %$col_info) {
1692 # hashref of other info that could be used by
1693 # user-defined accessor map functions
1695 table_class => $table_class,
1696 table_moniker => $table_moniker,
1697 table_name => $table_name,
1698 full_table_name => $full_table_name,
1699 schema_class => $schema_class,
1700 column_info => $info,
1703 $info->{accessor} = $self->_make_column_accessor_name( $col, $context );
1706 $self->_resolve_col_accessor_collisions($full_table_name, $col_info);
1708 # prune any redundant accessor names
1709 while (my ($col, $info) = each %$col_info) {
1710 no warnings 'uninitialized';
1711 delete $info->{accessor} if $info->{accessor} eq $col;
1714 my $fks = $self->_table_fk_info($table);
1716 foreach my $fkdef (@$fks) {
1717 for my $col (@{ $fkdef->{local_columns} }) {
1718 $col_info->{$col}{is_foreign_key} = 1;
1722 my $pks = $self->_table_pk_info($table) || [];
1724 foreach my $pkcol (@$pks) {
1725 $col_info->{$pkcol}{is_nullable} = 0;
1731 map { $_, ($col_info->{$_}||{}) } @$cols
1734 my %uniq_tag; # used to eliminate duplicate uniqs
1736 @$pks ? $self->_dbic_stmt($table_class,'set_primary_key',@$pks)
1737 : carp("$table has no primary key");
1738 $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
1740 my $uniqs = $self->_table_uniq_info($table) || [];
1742 my ($name, $cols) = @$_;
1743 next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
1744 $self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
1749 sub __columns_info_for {
1750 my ($self, $table) = @_;
1752 my $result = $self->_columns_info_for($table);
1754 while (my ($col, $info) = each %$result) {
1755 $info = { %$info, %{ $self->_custom_column_info ($table, $col, $info) } };
1756 $info = { %$info, %{ $self->_datetime_column_info($table, $col, $info) } };
1758 $result->{$col} = $info;
1766 Returns a sorted list of loaded tables, using the original database table
1774 return keys %{$self->_tables};
1777 # Make a moniker from a table
1778 sub _default_table2moniker {
1779 no warnings 'uninitialized';
1780 my ($self, $table) = @_;
1782 if ($self->naming->{monikers} eq 'v4') {
1783 return join '', map ucfirst, split /[\W_]+/, lc $table;
1785 elsif ($self->naming->{monikers} eq 'v5') {
1786 return join '', map ucfirst, split /[\W_]+/,
1787 Lingua::EN::Inflect::Number::to_S(lc $table);
1789 elsif ($self->naming->{monikers} eq 'v6') {
1790 (my $as_phrase = lc $table) =~ s/_+/ /g;
1791 my $inflected = Lingua::EN::Inflect::Phrase::to_S($as_phrase);
1793 return join '', map ucfirst, split /\W+/, $inflected;
1796 my @words = map lc, split_name $table;
1797 my $as_phrase = join ' ', @words;
1799 my $inflected = Lingua::EN::Inflect::Phrase::to_S($as_phrase);
1801 return join '', map ucfirst, split /\W+/, $inflected;
1804 sub _table2moniker {
1805 my ( $self, $table ) = @_;
1807 $self->_run_user_map(
1809 sub { $self->_default_table2moniker( shift ) },
1814 sub _load_relationships {
1815 my ($self, $table) = @_;
1817 my $tbl_fk_info = $self->_table_fk_info($table);
1818 foreach my $fkdef (@$tbl_fk_info) {
1819 $fkdef->{remote_source} =
1820 $self->monikers->{delete $fkdef->{remote_table}};
1822 my $tbl_uniq_info = $self->_table_uniq_info($table);
1824 my $local_moniker = $self->monikers->{$table};
1825 my $rel_stmts = $self->_relbuilder->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
1827 foreach my $src_class (sort keys %$rel_stmts) {
1828 my $src_stmts = $rel_stmts->{$src_class};
1829 foreach my $stmt (@$src_stmts) {
1830 $self->_dbic_stmt($src_class,$stmt->{method},@{$stmt->{args}});
1835 # Overload these in driver class:
1837 # Returns an arrayref of column names
1838 sub _table_columns { croak "ABSTRACT METHOD" }
1840 # Returns arrayref of pk col names
1841 sub _table_pk_info { croak "ABSTRACT METHOD" }
1843 # Returns an arrayref of uniqs [ [ foo => [ col1, col2 ] ], [ bar => [ ... ] ] ]
1844 sub _table_uniq_info { croak "ABSTRACT METHOD" }
1846 # Returns an arrayref of foreign key constraints, each
1847 # being a hashref with 3 keys:
1848 # local_columns (arrayref), remote_columns (arrayref), remote_table
1849 sub _table_fk_info { croak "ABSTRACT METHOD" }
1851 # Returns an array of lower case table names
1852 sub _tables_list { croak "ABSTRACT METHOD" }
1854 # Execute a constructive DBIC class method, with debug/dump_to_dir hooks.
1860 # generate the pod for this statement, storing it with $self->_pod
1861 $self->_make_pod( $class, $method, @_ ) if $self->generate_pod;
1863 my $args = dump(@_);
1864 $args = '(' . $args . ')' if @_ < 2;
1865 my $stmt = $method . $args . q{;};
1867 warn qq|$class\->$stmt\n| if $self->debug;
1868 $self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
1872 # generates the accompanying pod for a DBIC class method statement,
1873 # storing it with $self->_pod
1879 if ( $method eq 'table' ) {
1881 my $pcm = $self->pod_comment_mode;
1882 my ($comment, $comment_overflows, $comment_in_name, $comment_in_desc);
1883 $comment = $self->__table_comment($table);
1884 $comment_overflows = ($comment and length $comment > $self->pod_comment_spillover_length);
1885 $comment_in_name = ($pcm eq 'name' or ($pcm eq 'auto' and !$comment_overflows));
1886 $comment_in_desc = ($pcm eq 'description' or ($pcm eq 'auto' and $comment_overflows));
1887 $self->_pod( $class, "=head1 NAME" );
1888 my $table_descr = $class;
1889 $table_descr .= " - " . $comment if $comment and $comment_in_name;
1890 $self->{_class2table}{ $class } = $table;
1891 $self->_pod( $class, $table_descr );
1892 if ($comment and $comment_in_desc) {
1893 $self->_pod( $class, "=head1 DESCRIPTION" );
1894 $self->_pod( $class, $comment );
1896 $self->_pod_cut( $class );
1897 } elsif ( $method eq 'add_columns' ) {
1898 $self->_pod( $class, "=head1 ACCESSORS" );
1899 my $col_counter = 0;
1901 while( my ($name,$attrs) = splice @cols,0,2 ) {
1903 $self->_pod( $class, '=head2 ' . $name );
1904 $self->_pod( $class,
1906 my $s = $attrs->{$_};
1907 $s = !defined $s ? 'undef' :
1908 length($s) == 0 ? '(empty string)' :
1909 ref($s) eq 'SCALAR' ? $$s :
1910 ref($s) ? dumper_squashed $s :
1911 looks_like_number($s) ? $s : qq{'$s'};
1914 } sort keys %$attrs,
1916 if (my $comment = $self->__column_comment($self->{_class2table}{$class}, $col_counter, $name)) {
1917 $self->_pod( $class, $comment );
1920 $self->_pod_cut( $class );
1921 } elsif ( $method =~ /^(belongs_to|has_many|might_have)$/ ) {
1922 $self->_pod( $class, "=head1 RELATIONS" ) unless $self->{_relations_started} { $class } ;
1923 my ( $accessor, $rel_class ) = @_;
1924 $self->_pod( $class, "=head2 $accessor" );
1925 $self->_pod( $class, 'Type: ' . $method );
1926 $self->_pod( $class, "Related object: L<$rel_class>" );
1927 $self->_pod_cut( $class );
1928 $self->{_relations_started} { $class } = 1;
1932 sub _filter_comment {
1933 my ($self, $txt) = @_;
1935 $txt = '' if not defined $txt;
1937 $txt =~ s/(?:\015?\012|\015\012?)/\n/g;
1942 sub __table_comment {
1945 if (my $code = $self->can('_table_comment')) {
1946 return $self->_filter_comment($self->$code(@_));
1952 sub __column_comment {
1955 if (my $code = $self->can('_column_comment')) {
1956 return $self->_filter_comment($self->$code(@_));
1962 # Stores a POD documentation
1964 my ($self, $class, $stmt) = @_;
1965 $self->_raw_stmt( $class, "\n" . $stmt );
1969 my ($self, $class ) = @_;
1970 $self->_raw_stmt( $class, "\n=cut\n" );
1973 # Store a raw source line for a class (for dumping purposes)
1975 my ($self, $class, $stmt) = @_;
1976 push(@{$self->{_dump_storage}->{$class}}, $stmt);
1979 # Like above, but separately for the externally loaded stuff
1981 my ($self, $class, $stmt) = @_;
1982 push(@{$self->{_ext_storage}->{$class}}, $stmt);
1985 sub _quote_table_name {
1986 my ($self, $table) = @_;
1988 my $qt = $self->schema->storage->sql_maker->quote_char;
1990 return $table unless $qt;
1993 return $qt->[0] . $table . $qt->[1];
1996 return $qt . $table . $qt;
1999 sub _custom_column_info {
2000 my ( $self, $table_name, $column_name, $column_info ) = @_;
2002 if (my $code = $self->custom_column_info) {
2003 return $code->($table_name, $column_name, $column_info) || {};
2008 sub _datetime_column_info {
2009 my ( $self, $table_name, $column_name, $column_info ) = @_;
2011 my $type = $column_info->{data_type} || '';
2012 if ((grep $_, @{ $column_info }{map "inflate_$_", qw/date datetime timestamp/})
2013 or ($type =~ /date|timestamp/i)) {
2014 $result->{timezone} = $self->datetime_timezone if $self->datetime_timezone;
2015 $result->{locale} = $self->datetime_locale if $self->datetime_locale;
2021 my ($self, $name) = @_;
2023 return $self->preserve_case ? $name : lc($name);
2027 my ($self, $name) = @_;
2029 return $self->preserve_case ? $name : uc($name);
2032 sub _unregister_source_for_table {
2033 my ($self, $table) = @_;
2037 my $schema = $self->schema;
2038 # in older DBIC it's a private method
2039 my $unregister = $schema->can('unregister_source') || $schema->can('_unregister_source');
2040 $schema->$unregister($self->_table2moniker($table));
2041 delete $self->monikers->{$table};
2042 delete $self->classes->{$table};
2043 delete $self->_upgrading_classes->{$table};
2044 delete $self->{_tables}{$table};
2048 # remove the dump dir from @INC on destruction
2052 @INC = grep $_ ne $self->dump_directory, @INC;
2057 Returns a hashref of loaded table to moniker mappings. There will
2058 be two entries for each table, the original name and the "normalized"
2059 name, in the case that the two are different (such as databases
2060 that like uppercase table names, or preserve your original mixed-case
2061 definitions, or what-have-you).
2065 Returns a hashref of table to class mappings. In some cases it will
2066 contain multiple entries per table for the original and normalized table
2067 names, as above in L</monikers>.
2069 =head1 COLUMN ACCESSOR COLLISIONS
2071 Occasionally you may have a column name that collides with a perl method, such
2072 as C<can>. In such cases, the default action is to set the C<accessor> of the
2073 column spec to C<undef>.
2075 You can then name the accessor yourself by placing code such as the following
2078 __PACKAGE__->add_column('+can' => { accessor => 'my_can' });
2080 Another option is to use the L</col_collision_map> option.
2084 L<DBIx::Class::Schema::Loader>
2088 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
2092 This library is free software; you can redistribute it and/or modify it under
2093 the same terms as Perl itself.
2098 # vim:et sts=4 sw=4 tw=0: