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 ();
14 use Lingua::EN::Inflect::Number ();
15 use Lingua::EN::Inflect::Phrase ();
16 use String::ToIdentifier::EN ();
17 use String::ToIdentifier::EN::Unicode ();
20 use Class::Inspector ();
21 use Scalar::Util 'looks_like_number';
22 use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path slurp_file/;
23 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
26 use Encode qw/encode decode/;
27 use List::MoreUtils qw/all firstidx/;
32 our $VERSION = '0.07010';
34 __PACKAGE__->mk_group_ro_accessors('simple', qw/
41 additional_base_classes
57 default_resultset_class
62 overwrite_modifications
85 __PACKAGE__->mk_group_accessors('simple', qw/
87 schema_version_to_dump
89 _upgrading_from_load_classes
90 _downgrading_to_load_classes
91 _rewriting_result_namespace
96 pod_comment_spillover_length
102 result_components_map
104 datetime_undef_if_invalid
105 _result_class_methods
107 filter_generated_code
113 my $CURRENT_V = 'v7';
116 schema_components schema_base_class result_base_class
117 additional_base_classes left_base_classes additional_classes components
123 my $CRLF = "\x0d\x0a";
127 DBIx::Class::Schema::Loader::Base - Base DBIx::Class::Schema::Loader Implementation.
131 See L<DBIx::Class::Schema::Loader>.
135 This is the base class for the storage-specific C<DBIx::Class::Schema::*>
136 classes, and implements the common functionality between them.
138 =head1 CONSTRUCTOR OPTIONS
140 These constructor options are the base options for
141 L<DBIx::Class::Schema::Loader/loader_options>. Available constructor options are:
143 =head2 skip_relationships
145 Skip setting up relationships. The default is to attempt the loading
148 =head2 skip_load_external
150 Skip loading of other classes in @INC. The default is to merge all other classes
151 with the same name found in @INC into the schema file we are creating.
155 Static schemas (ones dumped to disk) will, by default, use the new-style
156 relationship names and singularized Results, unless you're overwriting an
157 existing dump made by an older version of L<DBIx::Class::Schema::Loader>, in
158 which case the backward compatible RelBuilder will be activated, and the
159 appropriate monikerization used.
165 will disable the backward-compatible RelBuilder and use
166 the new-style relationship names along with singularized Results, even when
167 overwriting a dump made with an earlier version.
169 The option also takes a hashref:
171 naming => { relationships => 'v8', monikers => 'v8' }
179 How to name relationship accessors.
183 How to name Result classes.
185 =item column_accessors
187 How to name column accessors in Result classes.
191 For L</v8> mode and later, uses L<String::ToIdentifier::EN> instead of
192 L<String::ToIdentifier::EM::Unicode> to force monikers and other identifiers to
203 Latest style, whatever that happens to be.
207 Unsingularlized monikers, C<has_many> only relationships with no _id stripping.
211 Monikers singularized as whole words, C<might_have> relationships for FKs on
212 C<UNIQUE> constraints, C<_id> stripping for belongs_to relationships.
214 Some of the C<_id> stripping edge cases in C<0.05003> have been reverted for
219 All monikers and relationships are inflected using
220 L<Lingua::EN::Inflect::Phrase>, and there is more aggressive C<_id> stripping
221 from relationship names.
223 In general, there is very little difference between v5 and v6 schemas.
227 This mode is identical to C<v6> mode, except that monikerization of CamelCase
228 table names is also done correctly.
230 CamelCase column names in case-preserving mode will also be handled correctly
231 for relationship name inflection. See L</preserve_case>.
233 In this mode, CamelCase L</column_accessors> are normalized based on case
234 transition instead of just being lowercased, so C<FooId> becomes C<foo_id>.
236 If you don't have any CamelCase table or column names, you can upgrade without
237 breaking any of your code.
243 The default mode is L</v7>, to get L</v8> mode, you have to specify it in
244 L</naming> explictly until C<0.08> comes out.
246 L</monikers> and L</column_accessors> are created using
247 L<String::ToIdentifier::EN::Unicode> or L<String::ToIdentifier::EN> if
248 L</force_ascii> is set; this is only significant for names with non-C<\w>
249 characters such as C<.>.
251 For relationships, belongs_to accessors are made from column names by stripping
252 postfixes other than C<_id> as well, just C<id>, C<_?ref>, C<_?cd>, C<_?code>
257 For L</monikers>, this option does not inflect the table names but makes
258 monikers based on the actual name. For L</column_accessors> this option does
259 not normalize CamelCase column names to lowercase column accessors, but makes
260 accessors that are the same names as the columns (with any non-\w chars
261 replaced with underscores.)
265 For L</monikers>, singularizes the names using the most current inflector. This
266 is the same as setting the option to L</current>.
270 For L</monikers>, pluralizes the names, using the most current inflector.
274 Dynamic schemas will always default to the 0.04XXX relationship names and won't
275 singularize Results for backward compatibility, to activate the new RelBuilder
276 and singularization put this in your C<Schema.pm> file:
278 __PACKAGE__->naming('current');
280 Or if you prefer to use 0.07XXX features but insure that nothing breaks in the
281 next major version upgrade:
283 __PACKAGE__->naming('v7');
287 If true, will not print the usual C<Dumping manual schema ... Schema dump
288 completed.> messages. Does not affect warnings (except for warnings related to
289 L</really_erase_my_files>.)
293 By default POD will be generated for columns and relationships, using database
294 metadata for the text if available and supported.
296 Comment metadata can be stored in two ways.
298 The first is that you can create two tables named C<table_comments> and
299 C<column_comments> respectively. These tables must exist in the same database
300 and schema as the tables they describe. They both need to have columns named
301 C<table_name> and C<comment_text>. The second one needs to have a column named
302 C<column_name>. Then data stored in these tables will be used as a source of
303 metadata about tables and comments.
305 (If you wish you can change the name of these tables with the parameters
306 L</table_comments_table> and L</column_comments_table>.)
308 As a fallback you can use built-in commenting mechanisms. Currently this is
309 only supported for PostgreSQL, Oracle and MySQL. To create comments in
310 PostgreSQL you add statements of the form C<COMMENT ON TABLE some_table IS
311 '...'>, the same syntax is used in Oracle. To create comments in MySQL you add
312 C<COMMENT '...'> to the end of the column or table definition. Note that MySQL
313 restricts the length of comments, and also does not handle complex Unicode
316 Set this to C<0> to turn off all POD generation.
318 =head2 pod_comment_mode
320 Controls where table comments appear in the generated POD. Smaller table
321 comments are appended to the C<NAME> section of the documentation, and larger
322 ones are inserted into C<DESCRIPTION> instead. You can force a C<DESCRIPTION>
323 section to be generated with the comment always, only use C<NAME>, or choose
324 the length threshold at which the comment is forced into the description.
330 Use C<NAME> section only.
334 Force C<DESCRIPTION> always.
338 Use C<DESCRIPTION> if length > L</pod_comment_spillover_length>, this is the
343 =head2 pod_comment_spillover_length
345 When pod_comment_mode is set to C<auto>, this is the length of the comment at
346 which it will be forced into a separate description section.
350 =head2 table_comments_table
352 The table to look for comments about tables in. By default C<table_comments>.
353 See L</generate_pod> for details.
355 This must not be a fully qualified name, the table will be looked for in the
356 same database and schema as the table whose comment is being retrieved.
358 =head2 column_comments_table
360 The table to look for comments about columns in. By default C<column_comments>.
361 See L</generate_pod> for details.
363 This must not be a fully qualified name, the table will be looked for in the
364 same database and schema as the table/column whose comment is being retrieved.
366 =head2 relationship_attrs
368 Hashref of attributes to pass to each generated relationship, listed
369 by type. Also supports relationship type 'all', containing options to
370 pass to all generated relationships. Attributes set for more specific
371 relationship types override those set in 'all'.
375 relationship_attrs => {
376 belongs_to => { is_deferrable => 0 },
379 use this to turn off DEFERRABLE on your foreign key constraints.
383 If set to true, each constructive L<DBIx::Class> statement the loader
384 decides to execute will be C<warn>-ed before execution.
388 Set the name of the schema to load (schema in the sense that your database
391 Can be set to an arrayref of schema names for multiple schemas, or the special
392 value C<%> for all schemas.
394 For MSSQL, Sybase ASE, and Informix can be set to a hashref of databases as
395 keys and arrays of owners as values, set to the value:
399 for all owners in all databases.
401 You may need to control naming of monikers with L</moniker_parts> if you have
402 name clashes for tables in different schemas/databases.
406 The database table names are represented by the
407 L<DBIx::Class::Schema::Loader::Table> class in the loader, the
408 L<DBIx::Class::Schema::Loader::Table::Sybase> class for Sybase ASE and
409 L<DBIx::Class::Schema::Loader::Table::Informix> for Informix.
411 Monikers are created normally based on just the
412 L<name|DBIx::Class::Schema::Loader::DBObject/name> property, corresponding to
413 the table name, but can consist of other parts of the fully qualified name of
416 The L</moniker_parts> option is an arrayref of methods on the table class
417 corresponding to parts of the fully qualified table name, defaulting to
418 C<['name']>, in the order those parts are used to create the moniker name.
420 The C<'name'> entry B<must> be present.
422 Below is a table of supported databases and possible L</moniker_parts>.
426 =item * DB2, Firebird, mysql, Oracle, Pg, SQLAnywhere, SQLite, MS Access
430 =item * Informix, MSSQL, Sybase ASE
432 C<database>, C<schema>, C<name>
438 Only load tables matching regex. Best specified as a qr// regex.
442 Exclude tables matching regex. Best specified as a qr// regex.
446 Overrides the default table name to moniker translation. Can be either
447 a hashref of table keys and moniker values, or a coderef for a translator
448 function taking a single scalar table name argument and returning
449 a scalar moniker. If the hash entry does not exist, or the function
450 returns a false value, the code falls back to default behavior
453 The default behavior is to split on case transition and non-alphanumeric
454 boundaries, singularize the resulting phrase, then join the titlecased words
457 Table Name | Moniker Name
458 ---------------------------------
460 luser_group | LuserGroup
461 luser-opts | LuserOpt
462 stations_visited | StationVisited
463 routeChange | RouteChange
465 =head2 col_accessor_map
467 Same as moniker_map, but for column accessor names. If a coderef is
468 passed, the code is called with arguments of
470 the name of the column in the underlying database,
471 default accessor name that DBICSL would ordinarily give this column,
473 table_class => name of the DBIC class we are building,
474 table_moniker => calculated moniker for this table (after moniker_map if present),
475 table_name => name of the database table,
476 full_table_name => schema-qualified name of the database table (RDBMS specific),
477 schema_class => name of the schema class we are building,
478 column_info => hashref of column info (data_type, is_nullable, etc),
483 Similar in idea to moniker_map, but different in the details. It can be
484 a hashref or a code ref.
486 If it is a hashref, keys can be either the default relationship name, or the
487 moniker. The keys that are the default relationship name should map to the
488 name you want to change the relationship to. Keys that are monikers should map
489 to hashes mapping relationship names to their translation. You can do both at
490 once, and the more specific moniker version will be picked up first. So, for
491 instance, you could have
500 and relationships that would have been named C<bar> will now be named C<baz>
501 except that in the table whose moniker is C<Foo> it will be named C<blat>.
503 If it is a coderef, the argument passed will be a hashref of this form:
506 name => default relationship name,
507 type => the relationship type eg: C<has_many>,
508 local_class => name of the DBIC class we are building,
509 local_moniker => moniker of the DBIC class we are building,
510 local_columns => columns in this table in the relationship,
511 remote_class => name of the DBIC class we are related to,
512 remote_moniker => moniker of the DBIC class we are related to,
513 remote_columns => columns in the other table in the relationship,
516 DBICSL will try to use the value returned as the relationship name.
518 =head2 inflect_plural
520 Just like L</moniker_map> above (can be hash/code-ref, falls back to default
521 if hash key does not exist or coderef returns false), but acts as a map
522 for pluralizing relationship names. The default behavior is to utilize
523 L<Lingua::EN::Inflect::Phrase/to_PL>.
525 =head2 inflect_singular
527 As L</inflect_plural> above, but for singularizing relationship names.
528 Default behavior is to utilize L<Lingua::EN::Inflect::Phrase/to_S>.
530 =head2 schema_base_class
532 Base class for your schema classes. Defaults to 'DBIx::Class::Schema'.
534 =head2 result_base_class
536 Base class for your table classes (aka result classes). Defaults to
539 =head2 additional_base_classes
541 List of additional base classes all of your table classes will use.
543 =head2 left_base_classes
545 List of additional base classes all of your table classes will use
546 that need to be leftmost.
548 =head2 additional_classes
550 List of additional classes which all of your table classes will use.
552 =head2 schema_components
554 List of components to load into the Schema class.
558 List of additional components to be loaded into all of your Result
559 classes. A good example would be
560 L<InflateColumn::DateTime|DBIx::Class::InflateColumn::DateTime>
562 =head2 result_components_map
564 A hashref of moniker keys and component values. Unlike L</components>, which
565 loads the given components into every Result class, this option allows you to
566 load certain components for specified Result classes. For example:
568 result_components_map => {
569 StationVisited => '+YourApp::Schema::Component::StationVisited',
571 '+YourApp::Schema::Component::RouteChange',
572 'InflateColumn::DateTime',
576 You may use this in conjunction with L</components>.
580 List of L<Moose> roles to be applied to all of your Result classes.
582 =head2 result_roles_map
584 A hashref of moniker keys and role values. Unlike L</result_roles>, which
585 applies the given roles to every Result class, this option allows you to apply
586 certain roles for specified Result classes. For example:
588 result_roles_map => {
590 'YourApp::Role::Building',
591 'YourApp::Role::Destination',
593 RouteChange => 'YourApp::Role::TripEvent',
596 You may use this in conjunction with L</result_roles>.
598 =head2 use_namespaces
600 This is now the default, to go back to L<DBIx::Class::Schema/load_classes> pass
603 Generate result class names suitable for
604 L<DBIx::Class::Schema/load_namespaces> and call that instead of
605 L<DBIx::Class::Schema/load_classes>. When using this option you can also
606 specify any of the options for C<load_namespaces> (i.e. C<result_namespace>,
607 C<resultset_namespace>, C<default_resultset_class>), and they will be added
608 to the call (and the generated result class names adjusted appropriately).
610 =head2 dump_directory
612 The value of this option is a perl libdir pathname. Within
613 that directory this module will create a baseline manual
614 L<DBIx::Class::Schema> module set, based on what it creates at runtime.
616 The created schema class will have the same classname as the one on
617 which you are setting this option (and the ResultSource classes will be
618 based on this name as well).
620 Normally you wouldn't hard-code this setting in your schema class, as it
621 is meant for one-time manual usage.
623 See L<DBIx::Class::Schema::Loader/dump_to_dir> for examples of the
624 recommended way to access this functionality.
626 =head2 dump_overwrite
628 Deprecated. See L</really_erase_my_files> below, which does *not* mean
629 the same thing as the old C<dump_overwrite> setting from previous releases.
631 =head2 really_erase_my_files
633 Default false. If true, Loader will unconditionally delete any existing
634 files before creating the new ones from scratch when dumping a schema to disk.
636 The default behavior is instead to only replace the top portion of the
637 file, up to and including the final stanza which contains
638 C<# DO NOT MODIFY THE FIRST PART OF THIS FILE>
639 leaving any customizations you placed after that as they were.
641 When C<really_erase_my_files> is not set, if the output file already exists,
642 but the aforementioned final stanza is not found, or the checksum
643 contained there does not match the generated contents, Loader will
644 croak and not touch the file.
646 You should really be using version control on your schema classes (and all
647 of the rest of your code for that matter). Don't blame me if a bug in this
648 code wipes something out when it shouldn't have, you've been warned.
650 =head2 overwrite_modifications
652 Default false. If false, when updating existing files, Loader will
653 refuse to modify any Loader-generated code that has been modified
654 since its last run (as determined by the checksum Loader put in its
657 If true, Loader will discard any manual modifications that have been
658 made to Loader-generated code.
660 Again, you should be using version control on your schema classes. Be
661 careful with this option.
663 =head2 custom_column_info
665 Hook for adding extra attributes to the
666 L<column_info|DBIx::Class::ResultSource/column_info> for a column.
668 Must be a coderef that returns a hashref with the extra attributes.
670 Receives the table name, column name and column_info.
674 custom_column_info => sub {
675 my ($table_name, $column_name, $column_info) = @_;
677 if ($column_name eq 'dog' && $column_info->{default_value} eq 'snoopy') {
678 return { is_snoopy => 1 };
682 This attribute can also be used to set C<inflate_datetime> on a non-datetime
683 column so it also receives the L</datetime_timezone> and/or L</datetime_locale>.
685 =head2 datetime_timezone
687 Sets the timezone attribute for L<DBIx::Class::InflateColumn::DateTime> for all
688 columns with the DATE/DATETIME/TIMESTAMP data_types.
690 =head2 datetime_locale
692 Sets the locale attribute for L<DBIx::Class::InflateColumn::DateTime> for all
693 columns with the DATE/DATETIME/TIMESTAMP data_types.
695 =head2 datetime_undef_if_invalid
697 Pass a C<0> for this option when using MySQL if you B<DON'T> want C<<
698 datetime_undef_if_invalid => 1 >> in your column info for DATE, DATETIME and
701 The default is recommended to deal with data such as C<00/00/00> which
702 sometimes ends up in such columns in MySQL.
706 File in Perl format, which should return a HASH reference, from which to read
711 Usually column names are lowercased, to make them easier to work with in
712 L<DBIx::Class>. This option lets you turn this behavior off, if the driver
715 Drivers for case sensitive databases like Sybase ASE or MSSQL with a
716 case-sensitive collation will turn this option on unconditionally.
718 Currently the drivers for SQLite, mysql, MSSQL and Firebird/InterBase support
721 =head2 qualify_objects
723 Set to true to prepend the L</db_schema> to table names for C<<
724 __PACKAGE__->table >> calls, and to some other things like Oracle sequences.
728 Creates Schema and Result classes that use L<Moose>, L<MooseX::NonMoose> and
729 L<namespace::autoclean>. The default content after the md5 sum also makes the
732 It is safe to upgrade your existing Schema to this option.
734 =head2 col_collision_map
736 This option controls how accessors for column names which collide with perl
737 methods are named. See L</COLUMN ACCESSOR COLLISIONS> for more information.
739 This option takes either a single L<sprintf|perlfunc/sprintf> format or a hashref of
740 strings which are compiled to regular expressions that map to
741 L<sprintf|perlfunc/sprintf> formats.
745 col_collision_map => 'column_%s'
747 col_collision_map => { '(.*)' => 'column_%s' }
749 col_collision_map => { '(foo).*(bar)' => 'column_%s_%s' }
751 =head2 rel_collision_map
753 Works just like L</col_collision_map>, but for relationship names/accessors
754 rather than column names/accessors.
756 The default is to just append C<_rel> to the relationship name, see
757 L</RELATIONSHIP NAME COLLISIONS>.
759 =head2 uniq_to_primary
761 Automatically promotes the largest unique constraints with non-nullable columns
762 on tables to primary keys, assuming there is only one largest unique
765 =head2 filter_generated_code
767 An optional hook that lets you filter the generated text for various classes
768 through a function that change it in any way that you want. The function will
769 receive the type of file, C<schema> or C<result>, class and code; and returns
770 the new code to use instead. For instance you could add custom comments, or do
771 anything else that you want.
773 The option can also be set to a string, which is then used as a filter program,
776 If this exists but fails to return text matching C</\bpackage\b/>, no file will
779 filter_generated_code => sub {
780 my ($type, $class, $text) = @_;
787 None of these methods are intended for direct invocation by regular
788 users of L<DBIx::Class::Schema::Loader>. Some are proxied via
789 L<DBIx::Class::Schema::Loader>.
793 # ensure that a peice of object data is a valid arrayref, creating
794 # an empty one or encapsulating whatever's there.
795 sub _ensure_arrayref {
800 $self->{$_} = [ $self->{$_} ]
801 unless ref $self->{$_} eq 'ARRAY';
807 Constructor for L<DBIx::Class::Schema::Loader::Base>, used internally
808 by L<DBIx::Class::Schema::Loader>.
813 my ( $class, %args ) = @_;
815 if (exists $args{column_accessor_map}) {
816 $args{col_accessor_map} = delete $args{column_accessor_map};
819 my $self = { %args };
821 # don't lose undef options
822 for (values %$self) {
823 $_ = 0 unless defined $_;
826 bless $self => $class;
828 if (my $config_file = $self->config_file) {
829 my $config_opts = do $config_file;
831 croak "Error reading config from $config_file: $@" if $@;
833 croak "Config file $config_file must be a hashref" unless ref($config_opts) eq 'HASH';
835 while (my ($k, $v) = each %$config_opts) {
836 $self->{$k} = $v unless exists $self->{$k};
840 if (defined $self->{result_component_map}) {
841 if (defined $self->result_components_map) {
842 croak "Specify only one of result_components_map or result_component_map";
844 $self->result_components_map($self->{result_component_map})
847 if (defined $self->{result_role_map}) {
848 if (defined $self->result_roles_map) {
849 croak "Specify only one of result_roles_map or result_role_map";
851 $self->result_roles_map($self->{result_role_map})
854 croak "the result_roles and result_roles_map options may only be used in conjunction with use_moose=1"
855 if ((not defined $self->use_moose) || (not $self->use_moose))
856 && ((defined $self->result_roles) || (defined $self->result_roles_map));
858 $self->_ensure_arrayref(qw/schema_components
860 additional_base_classes
866 $self->_validate_class_args;
868 croak "result_components_map must be a hash"
869 if defined $self->result_components_map
870 && ref $self->result_components_map ne 'HASH';
872 if ($self->result_components_map) {
873 my %rc_map = %{ $self->result_components_map };
874 foreach my $moniker (keys %rc_map) {
875 $rc_map{$moniker} = [ $rc_map{$moniker} ] unless ref $rc_map{$moniker};
877 $self->result_components_map(\%rc_map);
880 $self->result_components_map({});
882 $self->_validate_result_components_map;
884 croak "result_roles_map must be a hash"
885 if defined $self->result_roles_map
886 && ref $self->result_roles_map ne 'HASH';
888 if ($self->result_roles_map) {
889 my %rr_map = %{ $self->result_roles_map };
890 foreach my $moniker (keys %rr_map) {
891 $rr_map{$moniker} = [ $rr_map{$moniker} ] unless ref $rr_map{$moniker};
893 $self->result_roles_map(\%rr_map);
895 $self->result_roles_map({});
897 $self->_validate_result_roles_map;
899 if ($self->use_moose) {
900 if (not DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose')) {
901 die sprintf "You must install the following CPAN modules to enable the use_moose option: %s.\n",
902 DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('use_moose');
906 $self->{_tables} = {};
907 $self->{monikers} = {};
908 $self->{moniker_to_table} = {};
909 $self->{class_to_table} = {};
910 $self->{classes} = {};
911 $self->{_upgrading_classes} = {};
913 $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
914 $self->{schema} ||= $self->{schema_class};
915 $self->{table_comments_table} ||= 'table_comments';
916 $self->{column_comments_table} ||= 'column_comments';
918 croak "dump_overwrite is deprecated. Please read the"
919 . " DBIx::Class::Schema::Loader::Base documentation"
920 if $self->{dump_overwrite};
922 $self->{dynamic} = ! $self->{dump_directory};
923 $self->{temp_directory} ||= File::Temp::tempdir( 'dbicXXXX',
928 $self->{dump_directory} ||= $self->{temp_directory};
930 $self->real_dump_directory($self->{dump_directory});
932 $self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
933 $self->schema_version_to_dump($DBIx::Class::Schema::Loader::VERSION);
935 if (not defined $self->naming) {
936 $self->naming_set(0);
939 $self->naming_set(1);
942 if ((not ref $self->naming) && defined $self->naming) {
943 my $naming_ver = $self->naming;
945 relationships => $naming_ver,
946 monikers => $naming_ver,
947 column_accessors => $naming_ver,
952 for (values %{ $self->naming }) {
953 $_ = $CURRENT_V if $_ eq 'current';
956 $self->{naming} ||= {};
958 if ($self->custom_column_info && ref $self->custom_column_info ne 'CODE') {
959 croak 'custom_column_info must be a CODE ref';
962 $self->_check_back_compat;
964 $self->use_namespaces(1) unless defined $self->use_namespaces;
965 $self->generate_pod(1) unless defined $self->generate_pod;
966 $self->pod_comment_mode('auto') unless defined $self->pod_comment_mode;
967 $self->pod_comment_spillover_length(60) unless defined $self->pod_comment_spillover_length;
969 if (my $col_collision_map = $self->col_collision_map) {
970 if (my $reftype = ref $col_collision_map) {
971 if ($reftype ne 'HASH') {
972 croak "Invalid type $reftype for option 'col_collision_map'";
976 $self->col_collision_map({ '(.*)' => $col_collision_map });
980 if (my $rel_collision_map = $self->rel_collision_map) {
981 if (my $reftype = ref $rel_collision_map) {
982 if ($reftype ne 'HASH') {
983 croak "Invalid type $reftype for option 'rel_collision_map'";
987 $self->rel_collision_map({ '(.*)' => $rel_collision_map });
991 if (defined(my $rel_name_map = $self->rel_name_map)) {
992 my $reftype = ref $rel_name_map;
993 if ($reftype ne 'HASH' && $reftype ne 'CODE') {
994 croak "Invalid type $reftype for option 'rel_name_map', must be HASH or CODE";
998 if (defined(my $filter = $self->filter_generated_code)) {
999 my $reftype = ref $filter;
1000 if ($reftype && $reftype ne 'CODE') {
1001 croak "Invalid type $reftype for option 'filter_generated_code, must be a scalar or a CODE reference";
1005 if (defined $self->db_schema) {
1006 if (ref $self->db_schema eq 'ARRAY') {
1007 if (@{ $self->db_schema } > 1) {
1008 $self->{qualify_objects} = 1;
1010 elsif (@{ $self->db_schema } == 0) {
1011 $self->{db_schema} = undef;
1014 elsif (not ref $self->db_schema) {
1015 if ($self->db_schema eq '%') {
1016 $self->{qualify_objects} = 1;
1019 $self->{db_schema} = [ $self->db_schema ];
1023 if (not $self->moniker_parts) {
1024 $self->moniker_parts(['name']);
1027 if (not ref $self->moniker_parts) {
1028 $self->moniker_parts([ $self->moniker_parts ]);
1030 if (ref $self->moniker_parts ne 'ARRAY') {
1031 croak 'moniker_parts must be an arrayref';
1033 if ((firstidx { $_ eq 'name' } @{ $self->moniker_parts }) == -1) {
1034 croak "moniker_parts option *must* contain 'name'";
1041 sub _check_back_compat {
1044 # dynamic schemas will always be in 0.04006 mode, unless overridden
1045 if ($self->dynamic) {
1046 # just in case, though no one is likely to dump a dynamic schema
1047 $self->schema_version_to_dump('0.04006');
1049 if (not $self->naming_set) {
1050 warn <<EOF unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
1052 Dynamic schema detected, will run in 0.04006 mode.
1054 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
1055 to disable this warning.
1057 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
1062 $self->_upgrading_from('v4');
1065 if ((not defined $self->use_namespaces) && ($self->naming_set)) {
1066 $self->use_namespaces(1);
1069 $self->naming->{relationships} ||= 'v4';
1070 $self->naming->{monikers} ||= 'v4';
1072 if ($self->use_namespaces) {
1073 $self->_upgrading_from_load_classes(1);
1076 $self->use_namespaces(0);
1082 # otherwise check if we need backcompat mode for a static schema
1083 my $filename = $self->get_dump_filename($self->schema_class);
1084 return unless -e $filename;
1086 my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom) =
1087 $self->_parse_generated_file($filename);
1089 return unless $old_ver;
1091 # determine if the existing schema was dumped with use_moose => 1
1092 if (! defined $self->use_moose) {
1093 $self->{use_moose} = 1 if $old_gen =~ /^ (?!\s*\#) use \s+ Moose/xm;
1096 my $load_classes = ($old_gen =~ /^__PACKAGE__->load_classes;/m) ? 1 : 0;
1098 my $result_namespace = do { ($old_gen =~ /result_namespace => (.+)/) ? $1 : '' };
1099 my $ds = eval $result_namespace;
1101 Could not eval expression '$result_namespace' for result_namespace from
1104 $result_namespace = $ds || '';
1106 if ($load_classes && (not defined $self->use_namespaces)) {
1107 warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
1109 'load_classes;' static schema detected, turning off 'use_namespaces'.
1111 Set the 'use_namespaces' attribute or the SCHEMA_LOADER_BACKCOMPAT environment
1112 variable to disable this warning.
1114 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
1117 $self->use_namespaces(0);
1119 elsif ($load_classes && $self->use_namespaces) {
1120 $self->_upgrading_from_load_classes(1);
1122 elsif ((not $load_classes) && defined $self->use_namespaces && ! $self->use_namespaces) {
1123 $self->_downgrading_to_load_classes(
1124 $result_namespace || 'Result'
1127 elsif ((not defined $self->use_namespaces) || $self->use_namespaces) {
1128 if (not $self->result_namespace) {
1129 $self->result_namespace($result_namespace || 'Result');
1131 elsif ($result_namespace ne $self->result_namespace) {
1132 $self->_rewriting_result_namespace(
1133 $result_namespace || 'Result'
1138 # XXX when we go past .0 this will need fixing
1139 my ($v) = $old_ver =~ /([1-9])/;
1142 return if ($v eq $CURRENT_V || $old_ver =~ /^0\.\d\d999/);
1144 if (not %{ $self->naming }) {
1145 warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
1147 Version $old_ver static schema detected, turning on backcompat mode.
1149 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
1150 to disable this warning.
1152 See: 'naming' in perldoc DBIx::Class::Schema::Loader::Base .
1154 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 if upgrading
1155 from version 0.04006.
1158 $self->naming->{relationships} ||= $v;
1159 $self->naming->{monikers} ||= $v;
1160 $self->naming->{column_accessors} ||= $v;
1162 $self->schema_version_to_dump($old_ver);
1165 $self->_upgrading_from($v);
1169 sub _validate_class_args {
1172 foreach my $k (@CLASS_ARGS) {
1173 next unless $self->$k;
1175 my @classes = ref $self->$k eq 'ARRAY' ? @{ $self->$k } : $self->$k;
1176 $self->_validate_classes($k, \@classes);
1180 sub _validate_result_components_map {
1183 foreach my $classes (values %{ $self->result_components_map }) {
1184 $self->_validate_classes('result_components_map', $classes);
1188 sub _validate_result_roles_map {
1191 foreach my $classes (values %{ $self->result_roles_map }) {
1192 $self->_validate_classes('result_roles_map', $classes);
1196 sub _validate_classes {
1199 my $classes = shift;
1201 # make a copy to not destroy original
1202 my @classes = @$classes;
1204 foreach my $c (@classes) {
1205 # components default to being under the DBIx::Class namespace unless they
1206 # are preceeded with a '+'
1207 if ( $key =~ m/component/ && $c !~ s/^\+// ) {
1208 $c = 'DBIx::Class::' . $c;
1211 # 1 == installed, 0 == not installed, undef == invalid classname
1212 my $installed = Class::Inspector->installed($c);
1213 if ( defined($installed) ) {
1214 if ( $installed == 0 ) {
1215 croak qq/$c, as specified in the loader option "$key", is not installed/;
1218 croak qq/$c, as specified in the loader option "$key", is an invalid class name/;
1224 sub _find_file_in_inc {
1225 my ($self, $file) = @_;
1227 foreach my $prefix (@INC) {
1228 my $fullpath = File::Spec->catfile($prefix, $file);
1229 return $fullpath if -f $fullpath
1230 # abs_path throws on Windows for nonexistant files
1231 and (try { Cwd::abs_path($fullpath) }) ne
1232 ((try { Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) }) || '');
1238 sub _find_class_in_inc {
1239 my ($self, $class) = @_;
1241 return $self->_find_file_in_inc(class_path($class));
1247 return $self->_upgrading_from
1248 || $self->_upgrading_from_load_classes
1249 || $self->_downgrading_to_load_classes
1250 || $self->_rewriting_result_namespace
1254 sub _rewrite_old_classnames {
1255 my ($self, $code) = @_;
1257 return $code unless $self->_rewriting;
1259 my %old_classes = reverse %{ $self->_upgrading_classes };
1261 my $re = join '|', keys %old_classes;
1262 $re = qr/\b($re)\b/;
1264 $code =~ s/$re/$old_classes{$1} || $1/eg;
1269 sub _load_external {
1270 my ($self, $class) = @_;
1272 return if $self->{skip_load_external};
1274 # so that we don't load our own classes, under any circumstances
1275 local *INC = [ grep $_ ne $self->dump_directory, @INC ];
1277 my $real_inc_path = $self->_find_class_in_inc($class);
1279 my $old_class = $self->_upgrading_classes->{$class}
1280 if $self->_rewriting;
1282 my $old_real_inc_path = $self->_find_class_in_inc($old_class)
1283 if $old_class && $old_class ne $class;
1285 return unless $real_inc_path || $old_real_inc_path;
1287 if ($real_inc_path) {
1288 # If we make it to here, we loaded an external definition
1289 warn qq/# Loaded external class definition for '$class'\n/
1292 my $code = $self->_rewrite_old_classnames(slurp_file $real_inc_path);
1294 if ($self->dynamic) { # load the class too
1295 eval_package_without_redefine_warnings($class, $code);
1298 $self->_ext_stmt($class,
1299 qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
1300 .qq|# They are now part of the custom portion of this file\n|
1301 .qq|# for you to hand-edit. If you do not either delete\n|
1302 .qq|# this section or remove that file from \@INC, this section\n|
1303 .qq|# will be repeated redundantly when you re-create this\n|
1304 .qq|# file again via Loader! See skip_load_external to disable\n|
1305 .qq|# this feature.\n|
1308 $self->_ext_stmt($class, $code);
1309 $self->_ext_stmt($class,
1310 qq|# End of lines loaded from '$real_inc_path' |
1314 if ($old_real_inc_path) {
1315 my $code = slurp_file $old_real_inc_path;
1317 $self->_ext_stmt($class, <<"EOF");
1319 # These lines were loaded from '$old_real_inc_path',
1320 # based on the Result class name that would have been created by an older
1321 # version of the Loader. For a static schema, this happens only once during
1322 # upgrade. See skip_load_external to disable this feature.
1325 $code = $self->_rewrite_old_classnames($code);
1327 if ($self->dynamic) {
1330 Detected external content in '$old_real_inc_path', a class name that would have
1331 been used by an older version of the Loader.
1333 * PLEASE RENAME THIS CLASS: from '$old_class' to '$class', as that is the
1334 new name of the Result.
1336 eval_package_without_redefine_warnings($class, $code);
1340 $self->_ext_stmt($class, $code);
1341 $self->_ext_stmt($class,
1342 qq|# End of lines loaded from '$old_real_inc_path' |
1349 Does the actual schema-construction work.
1356 $self->_load_tables(
1357 $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude })
1365 Rescan the database for changes. Returns a list of the newly added table
1368 The schema argument should be the schema class or object to be affected. It
1369 should probably be derived from the original schema_class used during L</load>.
1374 my ($self, $schema) = @_;
1376 $self->{schema} = $schema;
1377 $self->_relbuilder->{schema} = $schema;
1380 my @current = $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude });
1382 foreach my $table (@current) {
1383 if(!exists $self->_tables->{$table->sql_name}) {
1384 push(@created, $table);
1389 @current{map $_->sql_name, @current} = ();
1390 foreach my $table (values %{ $self->_tables }) {
1391 if (not exists $current{$table->sql_name}) {
1392 $self->_remove_table($table);
1396 delete @$self{qw/_dump_storage _relations_started _uniqs_started/};
1398 my $loaded = $self->_load_tables(@current);
1400 foreach my $table (@created) {
1401 $self->monikers->{$table->sql_name} = $self->_table2moniker($table);
1404 return map { $self->monikers->{$_->sql_name} } @created;
1410 return if $self->{skip_relationships};
1412 return $self->{relbuilder} ||= do {
1413 my $relbuilder_suff =
1420 ->{$self->naming->{relationships}||$CURRENT_V} || '';
1422 my $relbuilder_class = 'DBIx::Class::Schema::Loader::RelBuilder'.$relbuilder_suff;
1423 $self->ensure_class_loaded($relbuilder_class);
1424 $relbuilder_class->new($self);
1429 my ($self, @tables) = @_;
1431 # Save the new tables to the tables list
1433 $self->_tables->{$_->sql_name} = $_;
1436 $self->_make_src_class($_) for @tables;
1438 # sanity-check for moniker clashes
1439 my $inverse_moniker_idx;
1440 foreach my $table (values %{ $self->_tables }) {
1441 push @{ $inverse_moniker_idx->{$self->monikers->{$table->sql_name}} }, $table;
1445 foreach my $moniker (keys %$inverse_moniker_idx) {
1446 my $tables = $inverse_moniker_idx->{$moniker};
1448 push @clashes, sprintf ("tables %s reduced to the same source moniker '%s'",
1449 join (', ', map $_->sql_name, @$tables),
1456 die 'Unable to load schema - chosen moniker/class naming style results in moniker clashes. '
1457 . 'In multi db_schema configurations you may need to set moniker_parts, '
1458 . 'otherwise change the naming style, or supply an explicit moniker_map: '
1459 . join ('; ', @clashes)
1464 $self->_setup_src_meta($_) for @tables;
1466 if(!$self->skip_relationships) {
1467 # The relationship loader needs a working schema
1468 local $self->{quiet} = 1;
1469 local $self->{dump_directory} = $self->{temp_directory};
1470 $self->_reload_classes(\@tables);
1471 $self->_load_relationships(\@tables);
1473 # Remove that temp dir from INC so it doesn't get reloaded
1474 @INC = grep $_ ne $self->dump_directory, @INC;
1477 $self->_load_roles($_) for @tables;
1479 $self->_load_external($_)
1480 for map { $self->classes->{$_->sql_name} } @tables;
1482 # Reload without unloading first to preserve any symbols from external
1484 $self->_reload_classes(\@tables, { unload => 0 });
1486 # Drop temporary cache
1487 delete $self->{_cache};
1492 sub _reload_classes {
1493 my ($self, $tables, $opts) = @_;
1495 my @tables = @$tables;
1497 my $unload = $opts->{unload};
1498 $unload = 1 unless defined $unload;
1500 # so that we don't repeat custom sections
1501 @INC = grep $_ ne $self->dump_directory, @INC;
1503 $self->_dump_to_dir(map { $self->classes->{$_->sql_name} } @tables);
1505 unshift @INC, $self->dump_directory;
1508 my %have_source = map { $_ => $self->schema->source($_) }
1509 $self->schema->sources;
1511 for my $table (@tables) {
1512 my $moniker = $self->monikers->{$table->sql_name};
1513 my $class = $self->classes->{$table->sql_name};
1516 no warnings 'redefine';
1517 local *Class::C3::reinitialize = sub {}; # to speed things up, reinitialized below
1520 if (my $mc = $self->_moose_metaclass($class)) {
1523 Class::Unload->unload($class) if $unload;
1524 my ($source, $resultset_class);
1526 ($source = $have_source{$moniker})
1527 && ($resultset_class = $source->resultset_class)
1528 && ($resultset_class ne 'DBIx::Class::ResultSet')
1530 my $has_file = Class::Inspector->loaded_filename($resultset_class);
1531 if (my $mc = $self->_moose_metaclass($resultset_class)) {
1534 Class::Unload->unload($resultset_class) if $unload;
1535 $self->_reload_class($resultset_class) if $has_file;
1537 $self->_reload_class($class);
1539 push @to_register, [$moniker, $class];
1542 Class::C3->reinitialize;
1543 for (@to_register) {
1544 $self->schema->register_class(@$_);
1548 sub _moose_metaclass {
1549 return undef unless $INC{'Class/MOP.pm'}; # if CMOP is not loaded the class could not have loaded in the 1st place
1553 my $mc = try { Class::MOP::class_of($class) }
1556 return $mc->isa('Moose::Meta::Class') ? $mc : undef;
1559 # We use this instead of ensure_class_loaded when there are package symbols we
1562 my ($self, $class) = @_;
1564 delete $INC{ +class_path($class) };
1567 eval_package_without_redefine_warnings ($class, "require $class");
1570 my $source = slurp_file $self->_get_dump_filename($class);
1571 die "Failed to reload class $class: $_.\n\nCLASS SOURCE:\n\n$source";
1575 sub _get_dump_filename {
1576 my ($self, $class) = (@_);
1578 $class =~ s{::}{/}g;
1579 return $self->dump_directory . q{/} . $class . q{.pm};
1582 =head2 get_dump_filename
1586 Returns the full path to the file for a class that the class has been or will
1587 be dumped to. This is a file in a temp dir for a dynamic schema.
1591 sub get_dump_filename {
1592 my ($self, $class) = (@_);
1594 local $self->{dump_directory} = $self->real_dump_directory;
1596 return $self->_get_dump_filename($class);
1599 sub _ensure_dump_subdirs {
1600 my ($self, $class) = (@_);
1602 my @name_parts = split(/::/, $class);
1603 pop @name_parts; # we don't care about the very last element,
1604 # which is a filename
1606 my $dir = $self->dump_directory;
1609 mkdir($dir) or croak "mkdir('$dir') failed: $!";
1611 last if !@name_parts;
1612 $dir = File::Spec->catdir($dir, shift @name_parts);
1617 my ($self, @classes) = @_;
1619 my $schema_class = $self->schema_class;
1620 my $schema_base_class = $self->schema_base_class || 'DBIx::Class::Schema';
1622 my $target_dir = $self->dump_directory;
1623 warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
1624 unless $self->dynamic or $self->quiet;
1628 . qq|package $schema_class;\n\n|
1629 . qq|# Created by DBIx::Class::Schema::Loader\n|
1630 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
1632 if ($self->use_moose) {
1633 $schema_text.= qq|use Moose;\nuse namespace::autoclean;\nextends '$schema_base_class';\n\n|;
1636 $schema_text .= qq|use strict;\nuse warnings;\n\nuse base '$schema_base_class';\n\n|;
1639 my @schema_components = @{ $self->schema_components || [] };
1641 if (@schema_components) {
1642 my $schema_components = dump @schema_components;
1643 $schema_components = "($schema_components)" if @schema_components == 1;
1645 $schema_text .= "__PACKAGE__->load_components${schema_components};\n\n";
1648 if ($self->use_namespaces) {
1649 $schema_text .= qq|__PACKAGE__->load_namespaces|;
1650 my $namespace_options;
1652 my @attr = qw/resultset_namespace default_resultset_class/;
1654 unshift @attr, 'result_namespace' unless (not $self->result_namespace) || $self->result_namespace eq 'Result';
1656 for my $attr (@attr) {
1658 my $code = dumper_squashed $self->$attr;
1659 $namespace_options .= qq| $attr => $code,\n|
1662 $schema_text .= qq|(\n$namespace_options)| if $namespace_options;
1663 $schema_text .= qq|;\n|;
1666 $schema_text .= qq|__PACKAGE__->load_classes;\n|;
1670 local $self->{version_to_dump} = $self->schema_version_to_dump;
1671 $self->_write_classfile($schema_class, $schema_text, 1);
1674 my $result_base_class = $self->result_base_class || 'DBIx::Class::Core';
1676 foreach my $src_class (@classes) {
1679 . qq|package $src_class;\n\n|
1680 . qq|# Created by DBIx::Class::Schema::Loader\n|
1681 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
1683 $src_text .= $self->_make_pod_heading($src_class);
1685 $src_text .= qq|use strict;\nuse warnings;\n\n|;
1687 $src_text .= $self->_base_class_pod($result_base_class)
1688 unless $result_base_class eq 'DBIx::Class::Core';
1690 if ($self->use_moose) {
1691 $src_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;|;
1693 # these options 'use base' which is compile time
1694 if (@{ $self->left_base_classes } || @{ $self->additional_base_classes }) {
1695 $src_text .= qq|\nBEGIN { extends '$result_base_class' }\n|;
1698 $src_text .= qq|\nextends '$result_base_class';\n|;
1702 $src_text .= qq|use base '$result_base_class';\n|;
1705 $self->_write_classfile($src_class, $src_text);
1708 # remove Result dir if downgrading from use_namespaces, and there are no
1710 if (my $result_ns = $self->_downgrading_to_load_classes
1711 || $self->_rewriting_result_namespace) {
1712 my $result_namespace = $self->_result_namespace(
1717 (my $result_dir = $result_namespace) =~ s{::}{/}g;
1718 $result_dir = $self->dump_directory . '/' . $result_dir;
1720 unless (my @files = glob "$result_dir/*") {
1725 warn "Schema dump completed.\n" unless $self->dynamic or $self->quiet;
1729 my ($self, $version, $ts) = @_;
1730 return qq|\n\n# Created by DBIx::Class::Schema::Loader|
1733 . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
1736 sub _write_classfile {
1737 my ($self, $class, $text, $is_schema) = @_;
1739 my $filename = $self->_get_dump_filename($class);
1740 $self->_ensure_dump_subdirs($class);
1742 if (-f $filename && $self->really_erase_my_files) {
1743 warn "Deleting existing file '$filename' due to "
1744 . "'really_erase_my_files' setting\n" unless $self->quiet;
1748 my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom)
1749 = $self->_parse_generated_file($filename);
1751 if (! $old_gen && -f $filename) {
1752 croak "Cannot overwrite '$filename' without 'really_erase_my_files',"
1753 . " it does not appear to have been generated by Loader"
1756 my $custom_content = $old_custom || '';
1758 # prepend extra custom content from a *renamed* class (singularization effect)
1759 if (my $renamed_class = $self->_upgrading_classes->{$class}) {
1760 my $old_filename = $self->_get_dump_filename($renamed_class);
1762 if (-f $old_filename) {
1763 my $extra_custom = ($self->_parse_generated_file ($old_filename))[4];
1765 $extra_custom =~ s/\n\n# You can replace.*\n1;\n//;
1767 $custom_content = join ("\n", '', $extra_custom, $custom_content)
1770 unlink $old_filename;
1774 $custom_content ||= $self->_default_custom_content($is_schema);
1776 # If upgrading to use_moose=1 replace default custom content with default Moose custom content.
1777 # If there is already custom content, which does not have the Moose content, add it.
1778 if ($self->use_moose) {
1780 my $non_moose_custom_content = do {
1781 local $self->{use_moose} = 0;
1782 $self->_default_custom_content;
1785 if ($custom_content eq $non_moose_custom_content) {
1786 $custom_content = $self->_default_custom_content($is_schema);
1788 elsif ($custom_content !~ /\Q@{[$self->_default_moose_custom_content($is_schema)]}\E/) {
1789 $custom_content .= $self->_default_custom_content($is_schema);
1792 elsif (defined $self->use_moose && $old_gen) {
1793 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'
1794 if $old_gen =~ /use \s+ MooseX?\b/x;
1797 $custom_content = $self->_rewrite_old_classnames($custom_content);
1800 for @{$self->{_dump_storage}->{$class} || []};
1802 if ($self->filter_generated_code) {
1803 my $filter = $self->filter_generated_code;
1805 if (ref $filter eq 'CODE') {
1807 ($is_schema ? 'schema' : 'result'),
1813 my ($out, $in) = (gensym, gensym);
1815 my $pid = open2($out, $in, $filter)
1816 or croak "Could not open pipe to $filter: $!";
1822 $text = decode('UTF-8', do { local $/; <$out> });
1824 $text =~ s/$CR?$LF/\n/g;
1828 my $exit_code = $? >> 8;
1830 if ($exit_code != 0) {
1831 croak "filter '$filter' exited non-zero: $exit_code";
1834 if (not $text or not $text =~ /\bpackage\b/) {
1835 warn("$class skipped due to filter") if $self->debug;
1840 # Check and see if the dump is in fact different
1844 $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
1845 if (Digest::MD5::md5_base64(encode 'UTF-8', $compare_to) eq $old_md5) {
1846 return unless $self->_upgrading_from && $is_schema;
1850 $text .= $self->_sig_comment(
1851 $self->version_to_dump,
1852 POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
1855 open(my $fh, '>:encoding(UTF-8)', $filename)
1856 or croak "Cannot open '$filename' for writing: $!";
1858 # Write the top half and its MD5 sum
1859 print $fh $text . Digest::MD5::md5_base64(encode 'UTF-8', $text) . "\n";
1861 # Write out anything loaded via external partial class file in @INC
1863 for @{$self->{_ext_storage}->{$class} || []};
1865 # Write out any custom content the user has added
1866 print $fh $custom_content;
1869 or croak "Error closing '$filename': $!";
1872 sub _default_moose_custom_content {
1873 my ($self, $is_schema) = @_;
1875 if (not $is_schema) {
1876 return qq|\n__PACKAGE__->meta->make_immutable;|;
1879 return qq|\n__PACKAGE__->meta->make_immutable(inline_constructor => 0);|;
1882 sub _default_custom_content {
1883 my ($self, $is_schema) = @_;
1884 my $default = qq|\n\n# You can replace this text with custom|
1885 . qq| code or comments, and it will be preserved on regeneration|;
1886 if ($self->use_moose) {
1887 $default .= $self->_default_moose_custom_content($is_schema);
1889 $default .= qq|\n1;\n|;
1893 sub _parse_generated_file {
1894 my ($self, $fn) = @_;
1896 return unless -f $fn;
1898 open(my $fh, '<:encoding(UTF-8)', $fn)
1899 or croak "Cannot open '$fn' for reading: $!";
1902 qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\r?\n};
1904 my ($md5, $ts, $ver, $gen);
1910 # Pull out the version and timestamp from the line above
1911 ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)\r?\Z/m;
1914 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"
1915 if !$self->overwrite_modifications && Digest::MD5::md5_base64(encode 'UTF-8', $gen) ne $md5;
1924 my $custom = do { local $/; <$fh> }
1928 $custom =~ s/$CRLF|$LF/\n/g;
1932 return ($gen, $md5, $ver, $ts, $custom);
1940 warn "$target: use $_;" if $self->debug;
1941 $self->_raw_stmt($target, "use $_;");
1949 my $blist = join(q{ }, @_);
1951 return unless $blist;
1953 warn "$target: use base qw/$blist/;" if $self->debug;
1954 $self->_raw_stmt($target, "use base qw/$blist/;");
1961 my $rlist = join(q{, }, map { qq{'$_'} } @_);
1963 return unless $rlist;
1965 warn "$target: with $rlist;" if $self->debug;
1966 $self->_raw_stmt($target, "\nwith $rlist;");
1969 sub _result_namespace {
1970 my ($self, $schema_class, $ns) = @_;
1971 my @result_namespace;
1973 $ns = $ns->[0] if ref $ns;
1975 if ($ns =~ /^\+(.*)/) {
1976 # Fully qualified namespace
1977 @result_namespace = ($1)
1980 # Relative namespace
1981 @result_namespace = ($schema_class, $ns);
1984 return wantarray ? @result_namespace : join '::', @result_namespace;
1987 # Create class with applicable bases, setup monikers, etc
1988 sub _make_src_class {
1989 my ($self, $table) = @_;
1991 my $schema = $self->schema;
1992 my $schema_class = $self->schema_class;
1994 my $table_moniker = $self->_table2moniker($table);
1995 my @result_namespace = ($schema_class);
1996 if ($self->use_namespaces) {
1997 my $result_namespace = $self->result_namespace || 'Result';
1998 @result_namespace = $self->_result_namespace(
2003 my $table_class = join(q{::}, @result_namespace, $table_moniker);
2005 if ((my $upgrading_v = $self->_upgrading_from)
2006 || $self->_rewriting) {
2007 local $self->naming->{monikers} = $upgrading_v
2010 my @result_namespace = @result_namespace;
2011 if ($self->_upgrading_from_load_classes) {
2012 @result_namespace = ($schema_class);
2014 elsif (my $ns = $self->_downgrading_to_load_classes) {
2015 @result_namespace = $self->_result_namespace(
2020 elsif ($ns = $self->_rewriting_result_namespace) {
2021 @result_namespace = $self->_result_namespace(
2027 my $old_table_moniker = do {
2028 local $self->naming->{monikers} = $upgrading_v;
2029 $self->_table2moniker($table);
2032 my $old_class = join(q{::}, @result_namespace, $old_table_moniker);
2034 $self->_upgrading_classes->{$table_class} = $old_class
2035 unless $table_class eq $old_class;
2038 $self->classes->{$table->sql_name} = $table_class;
2039 $self->monikers->{$table->sql_name} = $table_moniker;
2040 $self->moniker_to_table->{$table_moniker} = $table;
2041 $self->class_to_table->{$table_class} = $table;
2043 $self->_pod_class_list($table_class, 'ADDITIONAL CLASSES USED', @{$self->additional_classes});
2045 $self->_use ($table_class, @{$self->additional_classes});
2047 $self->_pod_class_list($table_class, 'LEFT BASE CLASSES', @{$self->left_base_classes});
2049 $self->_inject($table_class, @{$self->left_base_classes});
2051 my @components = @{ $self->components || [] };
2053 push @components, @{ $self->result_components_map->{$table_moniker} }
2054 if exists $self->result_components_map->{$table_moniker};
2056 my @fq_components = @components;
2057 foreach my $component (@fq_components) {
2058 if ($component !~ s/^\+//) {
2059 $component = "DBIx::Class::$component";
2063 $self->_pod_class_list($table_class, 'COMPONENTS LOADED', @fq_components);
2065 $self->_dbic_stmt($table_class, 'load_components', @components) if @components;
2067 $self->_pod_class_list($table_class, 'ADDITIONAL BASE CLASSES', @{$self->additional_base_classes});
2069 $self->_inject($table_class, @{$self->additional_base_classes});
2072 sub _is_result_class_method {
2073 my ($self, $name, $table) = @_;
2075 my $table_moniker = $table ? $self->monikers->{$table->sql_name} : '';
2077 $self->_result_class_methods({})
2078 if not defined $self->_result_class_methods;
2080 if (not exists $self->_result_class_methods->{$table_moniker}) {
2081 my (@methods, %methods);
2082 my $base = $self->result_base_class || 'DBIx::Class::Core';
2084 my @components = @{ $self->components || [] };
2086 push @components, @{ $self->result_components_map->{$table_moniker} }
2087 if exists $self->result_components_map->{$table_moniker};
2089 for my $c (@components) {
2090 $c = $c =~ /^\+/ ? substr($c,1) : "DBIx::Class::$c";
2093 my @roles = @{ $self->result_roles || [] };
2095 push @roles, @{ $self->result_roles_map->{$table_moniker} }
2096 if exists $self->result_roles_map->{$table_moniker};
2098 for my $class ($base, @components,
2099 ($self->use_moose ? 'Moose::Object' : ()), @roles) {
2100 $self->ensure_class_loaded($class);
2102 push @methods, @{ Class::Inspector->methods($class) || [] };
2105 push @methods, @{ Class::Inspector->methods('UNIVERSAL') };
2107 @methods{@methods} = ();
2109 $self->_result_class_methods->{$table_moniker} = \%methods;
2111 my $result_methods = $self->_result_class_methods->{$table_moniker};
2113 return exists $result_methods->{$name};
2116 sub _resolve_col_accessor_collisions {
2117 my ($self, $table, $col_info) = @_;
2119 while (my ($col, $info) = each %$col_info) {
2120 my $accessor = $info->{accessor} || $col;
2122 next if $accessor eq 'id'; # special case (very common column)
2124 if ($self->_is_result_class_method($accessor, $table)) {
2127 if (my $map = $self->col_collision_map) {
2128 for my $re (keys %$map) {
2129 if (my @matches = $col =~ /$re/) {
2130 $info->{accessor} = sprintf $map->{$re}, @matches;
2138 Column '$col' in table '$table' collides with an inherited method.
2139 See "COLUMN ACCESSOR COLLISIONS" in perldoc DBIx::Class::Schema::Loader::Base .
2141 $info->{accessor} = undef;
2147 # use the same logic to run moniker_map, col_accessor_map
2149 my ( $self, $map, $default_code, $ident, @extra ) = @_;
2151 my $default_ident = $default_code->( $ident, @extra );
2153 if( $map && ref $map eq 'HASH' ) {
2154 $new_ident = $map->{ $ident };
2156 elsif( $map && ref $map eq 'CODE' ) {
2157 $new_ident = $map->( $ident, $default_ident, @extra );
2160 $new_ident ||= $default_ident;
2165 sub _default_column_accessor_name {
2166 my ( $self, $column_name ) = @_;
2168 my $accessor_name = $self->_to_identifier('column_accessors', $column_name, '_');
2170 $accessor_name =~ s/\W+/_/g; # only if naming < v8, otherwise to_identifier
2173 if ((($self->naming->{column_accessors}||'') =~ /(\d+)/ && $1 < 7) || (not $self->preserve_case)) {
2174 # older naming just lc'd the col accessor and that's all.
2175 return lc $accessor_name;
2177 elsif (($self->naming->{column_accessors}||'') eq 'preserve') {
2178 return $accessor_name;
2181 return join '_', map lc, split_name $column_name;
2184 sub _make_column_accessor_name {
2185 my ($self, $column_name, $column_context_info ) = @_;
2187 my $accessor = $self->_run_user_map(
2188 $self->col_accessor_map,
2189 sub { $self->_default_column_accessor_name( shift ) },
2191 $column_context_info,
2197 # Set up metadata (cols, pks, etc)
2198 sub _setup_src_meta {
2199 my ($self, $table) = @_;
2201 my $schema = $self->schema;
2202 my $schema_class = $self->schema_class;
2204 my $table_class = $self->classes->{$table->sql_name};
2205 my $table_moniker = $self->monikers->{$table->sql_name};
2207 $self->_dbic_stmt($table_class, 'table', $table->dbic_name);
2209 my $cols = $self->_table_columns($table);
2210 my $col_info = $self->__columns_info_for($table);
2212 ### generate all the column accessor names
2213 while (my ($col, $info) = each %$col_info) {
2214 # hashref of other info that could be used by
2215 # user-defined accessor map functions
2217 table_class => $table_class,
2218 table_moniker => $table_moniker,
2219 table_name => $table,
2220 full_table_name => $table->dbic_name,
2221 schema_class => $schema_class,
2222 column_info => $info,
2225 $info->{accessor} = $self->_make_column_accessor_name( $col, $context );
2228 $self->_resolve_col_accessor_collisions($table, $col_info);
2230 # prune any redundant accessor names
2231 while (my ($col, $info) = each %$col_info) {
2232 no warnings 'uninitialized';
2233 delete $info->{accessor} if $info->{accessor} eq $col;
2236 my $fks = $self->_table_fk_info($table);
2238 foreach my $fkdef (@$fks) {
2239 for my $col (@{ $fkdef->{local_columns} }) {
2240 $col_info->{$col}{is_foreign_key} = 1;
2244 my $pks = $self->_table_pk_info($table) || [];
2246 my %uniq_tag; # used to eliminate duplicate uniqs
2248 $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
2250 my $uniqs = $self->_table_uniq_info($table) || [];
2253 foreach my $uniq (@$uniqs) {
2254 my ($name, $cols) = @$uniq;
2255 next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
2256 push @uniqs, [$name, $cols];
2259 my @non_nullable_uniqs = grep {
2260 all { $col_info->{$_}{is_nullable} == 0 } @{ $_->[1] }
2263 if ($self->uniq_to_primary && (not @$pks) && @non_nullable_uniqs) {
2264 my @by_colnum = sort { $b->[0] <=> $a->[0] }
2265 map [ scalar @{ $_->[1] }, $_ ], @non_nullable_uniqs;
2267 if (not (@by_colnum > 1 && $by_colnum[0][0] == $by_colnum[1][0])) {
2268 my @keys = map $_->[1], @by_colnum;
2272 # remove the uniq from list
2273 @uniqs = grep { $_->[0] ne $pk->[0] } @uniqs;
2279 foreach my $pkcol (@$pks) {
2280 $col_info->{$pkcol}{is_nullable} = 0;
2286 map { $_, ($col_info->{$_}||{}) } @$cols
2289 $self->_dbic_stmt($table_class, 'set_primary_key', @$pks)
2292 # Sort unique constraints by constraint name for repeatable results (rels
2293 # are sorted as well elsewhere.)
2294 @uniqs = sort { $a->[0] cmp $b->[0] } @uniqs;
2296 foreach my $uniq (@uniqs) {
2297 my ($name, $cols) = @$uniq;
2298 $self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
2302 sub __columns_info_for {
2303 my ($self, $table) = @_;
2305 my $result = $self->_columns_info_for($table);
2307 while (my ($col, $info) = each %$result) {
2308 $info = { %$info, %{ $self->_custom_column_info ($table, $col, $info) } };
2309 $info = { %$info, %{ $self->_datetime_column_info($table, $col, $info) } };
2311 $result->{$col} = $info;
2319 Returns a sorted list of loaded tables, using the original database table
2327 return values %{$self->_tables};
2330 sub _to_identifier {
2331 my ($self, $naming_key, $name, $sep_char) = @_;
2333 my ($v) = ($self->naming->{$naming_key}||$CURRENT_V) =~ /^v(\d+)\z/;
2335 my $to_identifier = $self->naming->{force_ascii} ?
2336 \&String::ToIdentifier::EN::to_identifier
2337 : \&String::ToIdentifier::EN::Unicode::to_identifier;
2339 return $v >= 8 ? $to_identifier->($name, $sep_char) : $name;
2342 # Make a moniker from a table
2343 sub _default_table2moniker {
2344 my ($self, $table) = @_;
2346 my ($v) = ($self->naming->{monikers}||$CURRENT_V) =~ /^v(\d+)\z/;
2348 my @name_parts = map $table->$_, @{ $self->moniker_parts };
2350 my $name_idx = firstidx { $_ eq 'name' } @{ $self->moniker_parts };
2354 foreach my $i (0 .. $#name_parts) {
2355 my $part = $name_parts[$i];
2357 if ($i != $name_idx || $v >= 8) {
2358 $part = $self->_to_identifier->('monikers', $part, '_');
2361 if ($i == $name_idx && $v == 5) {
2362 $part = Lingua::EN::Inflect::Number::to_S($part);
2365 my @part_parts = map lc, $v > 6 ? split_name $part : split /[\W_]+/, $part;
2367 if ($i == $name_idx && $v >= 6) {
2368 my $as_phrase = join ' ', @part_parts;
2370 my $inflected = ($self->naming->{monikers}||'') eq 'plural' ?
2371 Lingua::EN::Inflect::Phrase::to_PL($as_phrase)
2373 ($self->naming->{monikers}||'') eq 'preserve' ?
2376 Lingua::EN::Inflect::Phrase::to_S($as_phrase);
2378 @part_parts = split /\s+/, $inflected;
2381 push @all_parts, map ucfirst, @part_parts;
2384 return join '', @all_parts;
2387 sub _table2moniker {
2388 my ( $self, $table ) = @_;
2390 $self->_run_user_map(
2392 sub { $self->_default_table2moniker( shift ) },
2397 sub _load_relationships {
2398 my ($self, $tables) = @_;
2402 foreach my $table (@$tables) {
2403 my $local_moniker = $self->monikers->{$table->sql_name};
2405 my $tbl_fk_info = $self->_table_fk_info($table);
2407 foreach my $fkdef (@$tbl_fk_info) {
2408 $fkdef->{local_table} = $table;
2409 $fkdef->{local_moniker} = $local_moniker;
2410 $fkdef->{remote_source} =
2411 $self->monikers->{$fkdef->{remote_table}->sql_name};
2413 my $tbl_uniq_info = $self->_table_uniq_info($table);
2415 push @tables, [ $local_moniker, $tbl_fk_info, $tbl_uniq_info ];
2418 my $rel_stmts = $self->_relbuilder->generate_code(\@tables);
2420 foreach my $src_class (sort keys %$rel_stmts) {
2422 my @src_stmts = map $_->[1],
2423 sort { $a->[0] cmp $b->[0] }
2424 map [ $_->{args}[0], $_ ], @{ $rel_stmts->{$src_class} };
2426 foreach my $stmt (@src_stmts) {
2427 $self->_dbic_stmt($src_class,$stmt->{method}, @{$stmt->{args}});
2433 my ($self, $table) = @_;
2435 my $table_moniker = $self->monikers->{$table->sql_name};
2436 my $table_class = $self->classes->{$table->sql_name};
2438 my @roles = @{ $self->result_roles || [] };
2439 push @roles, @{ $self->result_roles_map->{$table_moniker} }
2440 if exists $self->result_roles_map->{$table_moniker};
2443 $self->_pod_class_list($table_class, 'L<Moose> ROLES APPLIED', @roles);
2445 $self->_with($table_class, @roles);
2449 # Overload these in driver class:
2451 # Returns an arrayref of column names
2452 sub _table_columns { croak "ABSTRACT METHOD" }
2454 # Returns arrayref of pk col names
2455 sub _table_pk_info { croak "ABSTRACT METHOD" }
2457 # Returns an arrayref of uniqs [ [ foo => [ col1, col2 ] ], [ bar => [ ... ] ] ]
2458 sub _table_uniq_info { croak "ABSTRACT METHOD" }
2460 # Returns an arrayref of foreign key constraints, each
2461 # being a hashref with 3 keys:
2462 # local_columns (arrayref), remote_columns (arrayref), remote_table
2463 sub _table_fk_info { croak "ABSTRACT METHOD" }
2465 # Returns an array of lower case table names
2466 sub _tables_list { croak "ABSTRACT METHOD" }
2468 # Execute a constructive DBIC class method, with debug/dump_to_dir hooks.
2474 # generate the pod for this statement, storing it with $self->_pod
2475 $self->_make_pod( $class, $method, @_ ) if $self->generate_pod;
2477 my $args = dump(@_);
2478 $args = '(' . $args . ')' if @_ < 2;
2479 my $stmt = $method . $args . q{;};
2481 warn qq|$class\->$stmt\n| if $self->debug;
2482 $self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
2486 sub _make_pod_heading {
2487 my ($self, $class) = @_;
2489 return '' if not $self->generate_pod;
2491 my $table = $self->class_to_table->{$class};
2494 my $pcm = $self->pod_comment_mode;
2495 my ($comment, $comment_overflows, $comment_in_name, $comment_in_desc);
2496 $comment = $self->__table_comment($table);
2497 $comment_overflows = ($comment and length $comment > $self->pod_comment_spillover_length);
2498 $comment_in_name = ($pcm eq 'name' or ($pcm eq 'auto' and !$comment_overflows));
2499 $comment_in_desc = ($pcm eq 'description' or ($pcm eq 'auto' and $comment_overflows));
2501 $pod .= "=head1 NAME\n\n";
2503 my $table_descr = $class;
2504 $table_descr .= " - " . $comment if $comment and $comment_in_name;
2506 $pod .= "$table_descr\n\n";
2508 if ($comment and $comment_in_desc) {
2509 $pod .= "=head1 DESCRIPTION\n\n${comment}\n\n";
2516 # generates the accompanying pod for a DBIC class method statement,
2517 # storing it with $self->_pod
2523 if ($method eq 'table') {
2525 $table = $$table if ref $table eq 'SCALAR';
2526 $self->_pod($class, "=head1 TABLE: C<$table>");
2527 $self->_pod_cut($class);
2529 elsif ( $method eq 'add_columns' ) {
2530 $self->_pod( $class, "=head1 ACCESSORS" );
2531 my $col_counter = 0;
2533 while( my ($name,$attrs) = splice @cols,0,2 ) {
2535 $self->_pod( $class, '=head2 ' . $name );
2536 $self->_pod( $class,
2538 my $s = $attrs->{$_};
2539 $s = !defined $s ? 'undef' :
2540 length($s) == 0 ? '(empty string)' :
2541 ref($s) eq 'SCALAR' ? $$s :
2542 ref($s) ? dumper_squashed $s :
2543 looks_like_number($s) ? $s : qq{'$s'};
2546 } sort keys %$attrs,
2548 if (my $comment = $self->__column_comment($self->class_to_table->{$class}, $col_counter, $name)) {
2549 $self->_pod( $class, $comment );
2552 $self->_pod_cut( $class );
2553 } elsif ( $method =~ /^(belongs_to|has_many|might_have)$/ ) {
2554 $self->_pod( $class, "=head1 RELATIONS" ) unless $self->{_relations_started} { $class } ;
2555 my ( $accessor, $rel_class ) = @_;
2556 $self->_pod( $class, "=head2 $accessor" );
2557 $self->_pod( $class, 'Type: ' . $method );
2558 $self->_pod( $class, "Related object: L<$rel_class>" );
2559 $self->_pod_cut( $class );
2560 $self->{_relations_started} { $class } = 1;
2562 elsif ($method eq 'add_unique_constraint') {
2563 $self->_pod($class, '=head1 UNIQUE CONSTRAINTS')
2564 unless $self->{_uniqs_started}{$class};
2566 my ($name, $cols) = @_;
2568 $self->_pod($class, "=head2 C<$name>");
2569 $self->_pod($class, '=over 4');
2571 foreach my $col (@$cols) {
2572 $self->_pod($class, "=item \* L</$col>");
2575 $self->_pod($class, '=back');
2576 $self->_pod_cut($class);
2578 $self->{_uniqs_started}{$class} = 1;
2580 elsif ($method eq 'set_primary_key') {
2581 $self->_pod($class, "=head1 PRIMARY KEY");
2582 $self->_pod($class, '=over 4');
2584 foreach my $col (@_) {
2585 $self->_pod($class, "=item \* L</$col>");
2588 $self->_pod($class, '=back');
2589 $self->_pod_cut($class);
2593 sub _pod_class_list {
2594 my ($self, $class, $title, @classes) = @_;
2596 return unless @classes && $self->generate_pod;
2598 $self->_pod($class, "=head1 $title");
2599 $self->_pod($class, '=over 4');
2601 foreach my $link (@classes) {
2602 $self->_pod($class, "=item * L<$link>");
2605 $self->_pod($class, '=back');
2606 $self->_pod_cut($class);
2609 sub _base_class_pod {
2610 my ($self, $base_class) = @_;
2612 return '' unless $self->generate_pod;
2615 =head1 BASE CLASS: L<$base_class>
2622 sub _filter_comment {
2623 my ($self, $txt) = @_;
2625 $txt = '' if not defined $txt;
2627 $txt =~ s/(?:\015?\012|\015\012?)/\n/g;
2632 sub __table_comment {
2635 if (my $code = $self->can('_table_comment')) {
2636 return $self->_filter_comment($self->$code(@_));
2642 sub __column_comment {
2645 if (my $code = $self->can('_column_comment')) {
2646 return $self->_filter_comment($self->$code(@_));
2652 # Stores a POD documentation
2654 my ($self, $class, $stmt) = @_;
2655 $self->_raw_stmt( $class, "\n" . $stmt );
2659 my ($self, $class ) = @_;
2660 $self->_raw_stmt( $class, "\n=cut\n" );
2663 # Store a raw source line for a class (for dumping purposes)
2665 my ($self, $class, $stmt) = @_;
2666 push(@{$self->{_dump_storage}->{$class}}, $stmt);
2669 # Like above, but separately for the externally loaded stuff
2671 my ($self, $class, $stmt) = @_;
2672 push(@{$self->{_ext_storage}->{$class}}, $stmt);
2675 sub _custom_column_info {
2676 my ( $self, $table_name, $column_name, $column_info ) = @_;
2678 if (my $code = $self->custom_column_info) {
2679 return $code->($table_name, $column_name, $column_info) || {};
2684 sub _datetime_column_info {
2685 my ( $self, $table_name, $column_name, $column_info ) = @_;
2687 my $type = $column_info->{data_type} || '';
2688 if ((grep $_, @{ $column_info }{map "inflate_$_", qw/date datetime timestamp/})
2689 or ($type =~ /date|timestamp/i)) {
2690 $result->{timezone} = $self->datetime_timezone if $self->datetime_timezone;
2691 $result->{locale} = $self->datetime_locale if $self->datetime_locale;
2697 my ($self, $name) = @_;
2699 return $self->preserve_case ? $name : lc($name);
2703 my ($self, $name) = @_;
2705 return $self->preserve_case ? $name : uc($name);
2709 my ($self, $table) = @_;
2712 my $schema = $self->schema;
2713 # in older DBIC it's a private method
2714 my $unregister = $schema->can('unregister_source') || $schema->can('_unregister_source');
2715 $schema->$unregister(delete $self->monikers->{$table->sql_name});
2716 delete $self->_upgrading_classes->{delete $self->classes->{$table->sql_name}};
2717 delete $self->_tables->{$table->sql_name};
2721 # remove the dump dir from @INC on destruction
2725 @INC = grep $_ ne $self->dump_directory, @INC;
2730 Returns a hashref of loaded table to moniker mappings. There will
2731 be two entries for each table, the original name and the "normalized"
2732 name, in the case that the two are different (such as databases
2733 that like uppercase table names, or preserve your original mixed-case
2734 definitions, or what-have-you).
2738 Returns a hashref of table to class mappings. In some cases it will
2739 contain multiple entries per table for the original and normalized table
2740 names, as above in L</monikers>.
2742 =head1 NON-ENGLISH DATABASES
2744 If you use the loader on a database with table and column names in a language
2745 other than English, you will want to turn off the English language specific
2748 To do so, use something like this in your laoder options:
2750 naming => { monikers => 'v4' },
2751 inflect_singular => sub { "$_[0]_rel" },
2752 inflect_plural => sub { "$_[0]_rel" },
2754 =head1 COLUMN ACCESSOR COLLISIONS
2756 Occasionally you may have a column name that collides with a perl method, such
2757 as C<can>. In such cases, the default action is to set the C<accessor> of the
2758 column spec to C<undef>.
2760 You can then name the accessor yourself by placing code such as the following
2763 __PACKAGE__->add_column('+can' => { accessor => 'my_can' });
2765 Another option is to use the L</col_collision_map> option.
2767 =head1 RELATIONSHIP NAME COLLISIONS
2769 In very rare cases, you may get a collision between a generated relationship
2770 name and a method in your Result class, for example if you have a foreign key
2771 called C<belongs_to>.
2773 This is a problem because relationship names are also relationship accessor
2774 methods in L<DBIx::Class>.
2776 The default behavior is to append C<_rel> to the relationship name and print
2777 out a warning that refers to this text.
2779 You can also control the renaming with the L</rel_collision_map> option.
2783 L<DBIx::Class::Schema::Loader>
2787 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
2791 This library is free software; you can redistribute it and/or modify it under
2792 the same terms as Perl itself.
2797 # vim:et sts=4 sw=4 tw=0: