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
193 such as relationship names to ASCII.
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> are created using L<String::ToIdentifier::EN::Unicode> or
247 L<String::ToIdentifier::EN> if L</force_ascii> is set; this is only significant
248 for table names with non-C<\w> characters such as C<.>.
250 For relationships, belongs_to accessors are made from column names by stripping
251 postfixes other than C<_id> as well, just C<id>, C<_?ref>, C<_?cd>, C<_?code>
256 For L</monikers>, this option does not inflect the table names but makes
257 monikers based on the actual name. For L</column_accessors> this option does
258 not normalize CamelCase column names to lowercase column accessors, but makes
259 accessors that are the same names as the columns (with any non-\w chars
260 replaced with underscores.)
264 For L</monikers>, singularizes the names using the most current inflector. This
265 is the same as setting the option to L</current>.
269 For L</monikers>, pluralizes the names, using the most current inflector.
273 Dynamic schemas will always default to the 0.04XXX relationship names and won't
274 singularize Results for backward compatibility, to activate the new RelBuilder
275 and singularization put this in your C<Schema.pm> file:
277 __PACKAGE__->naming('current');
279 Or if you prefer to use 0.07XXX features but insure that nothing breaks in the
280 next major version upgrade:
282 __PACKAGE__->naming('v7');
286 If true, will not print the usual C<Dumping manual schema ... Schema dump
287 completed.> messages. Does not affect warnings (except for warnings related to
288 L</really_erase_my_files>.)
292 By default POD will be generated for columns and relationships, using database
293 metadata for the text if available and supported.
295 Comment metadata can be stored in two ways.
297 The first is that you can create two tables named C<table_comments> and
298 C<column_comments> respectively. These tables must exist in the same database
299 and schema as the tables they describe. They both need to have columns named
300 C<table_name> and C<comment_text>. The second one needs to have a column named
301 C<column_name>. Then data stored in these tables will be used as a source of
302 metadata about tables and comments.
304 (If you wish you can change the name of these tables with the parameters
305 L</table_comments_table> and L</column_comments_table>.)
307 As a fallback you can use built-in commenting mechanisms. Currently this is
308 only supported for PostgreSQL, Oracle and MySQL. To create comments in
309 PostgreSQL you add statements of the form C<COMMENT ON TABLE some_table IS
310 '...'>, the same syntax is used in Oracle. To create comments in MySQL you add
311 C<COMMENT '...'> to the end of the column or table definition. Note that MySQL
312 restricts the length of comments, and also does not handle complex Unicode
315 Set this to C<0> to turn off all POD generation.
317 =head2 pod_comment_mode
319 Controls where table comments appear in the generated POD. Smaller table
320 comments are appended to the C<NAME> section of the documentation, and larger
321 ones are inserted into C<DESCRIPTION> instead. You can force a C<DESCRIPTION>
322 section to be generated with the comment always, only use C<NAME>, or choose
323 the length threshold at which the comment is forced into the description.
329 Use C<NAME> section only.
333 Force C<DESCRIPTION> always.
337 Use C<DESCRIPTION> if length > L</pod_comment_spillover_length>, this is the
342 =head2 pod_comment_spillover_length
344 When pod_comment_mode is set to C<auto>, this is the length of the comment at
345 which it will be forced into a separate description section.
349 =head2 table_comments_table
351 The table to look for comments about tables in. By default C<table_comments>.
352 See L</generate_pod> for details.
354 This must not be a fully qualified name, the table will be looked for in the
355 same database and schema as the table whose comment is being retrieved.
357 =head2 column_comments_table
359 The table to look for comments about columns in. By default C<column_comments>.
360 See L</generate_pod> for details.
362 This must not be a fully qualified name, the table will be looked for in the
363 same database and schema as the table/column whose comment is being retrieved.
365 =head2 relationship_attrs
367 Hashref of attributes to pass to each generated relationship, listed
368 by type. Also supports relationship type 'all', containing options to
369 pass to all generated relationships. Attributes set for more specific
370 relationship types override those set in 'all'.
374 relationship_attrs => {
375 belongs_to => { is_deferrable => 0 },
378 use this to turn off DEFERRABLE on your foreign key constraints.
382 If set to true, each constructive L<DBIx::Class> statement the loader
383 decides to execute will be C<warn>-ed before execution.
387 Set the name of the schema to load (schema in the sense that your database
390 Can be set to an arrayref of schema names for multiple schemas, or the special
391 value C<%> for all schemas.
393 For MSSQL, Sybase ASE, and Informix can be set to a hashref of databases as
394 keys and arrays of owners as values, set to the value:
398 for all owners in all databases.
400 You may need to control naming of monikers with L</moniker_parts> if you have
401 name clashes for tables in different schemas/databases.
405 The database table names are represented by the
406 L<DBIx::Class::Schema::Loader::Table> class in the loader, the
407 L<DBIx::Class::Schema::Loader::Table::Sybase> class for Sybase ASE and
408 L<DBIx::Class::Schema::Loader::Table::Informix> for Informix.
410 Monikers are created normally based on just the
411 L<name|DBIx::Class::Schema::Loader::DBObject/name> property, corresponding to
412 the table name, but can consist of other parts of the fully qualified name of
415 The L</moniker_parts> option is an arrayref of methods on the table class
416 corresponding to parts of the fully qualified table name, defaulting to
417 C<['name']>, in the order those parts are used to create the moniker name.
419 The C<'name'> entry B<must> be present.
421 Below is a table of supported databases and possible L</moniker_parts>.
425 =item * DB2, Firebird, mysql, Oracle, Pg, SQLAnywhere, SQLite, MS Access
429 =item * Informix, MSSQL, Sybase ASE
431 C<database>, C<schema>, C<name>
437 Only load tables matching regex. Best specified as a qr// regex.
441 Exclude tables matching regex. Best specified as a qr// regex.
445 Overrides the default table name to moniker translation. Can be either
446 a hashref of table keys and moniker values, or a coderef for a translator
447 function taking a single scalar table name argument and returning
448 a scalar moniker. If the hash entry does not exist, or the function
449 returns a false value, the code falls back to default behavior
452 The default behavior is to split on case transition and non-alphanumeric
453 boundaries, singularize the resulting phrase, then join the titlecased words
456 Table Name | Moniker Name
457 ---------------------------------
459 luser_group | LuserGroup
460 luser-opts | LuserOpt
461 stations_visited | StationVisited
462 routeChange | RouteChange
464 =head2 col_accessor_map
466 Same as moniker_map, but for column accessor names. If a coderef is
467 passed, the code is called with arguments of
469 the name of the column in the underlying database,
470 default accessor name that DBICSL would ordinarily give this column,
472 table_class => name of the DBIC class we are building,
473 table_moniker => calculated moniker for this table (after moniker_map if present),
474 table_name => name of the database table,
475 full_table_name => schema-qualified name of the database table (RDBMS specific),
476 schema_class => name of the schema class we are building,
477 column_info => hashref of column info (data_type, is_nullable, etc),
482 Similar in idea to moniker_map, but different in the details. It can be
483 a hashref or a code ref.
485 If it is a hashref, keys can be either the default relationship name, or the
486 moniker. The keys that are the default relationship name should map to the
487 name you want to change the relationship to. Keys that are monikers should map
488 to hashes mapping relationship names to their translation. You can do both at
489 once, and the more specific moniker version will be picked up first. So, for
490 instance, you could have
499 and relationships that would have been named C<bar> will now be named C<baz>
500 except that in the table whose moniker is C<Foo> it will be named C<blat>.
502 If it is a coderef, the argument passed will be a hashref of this form:
505 name => default relationship name,
506 type => the relationship type eg: C<has_many>,
507 local_class => name of the DBIC class we are building,
508 local_moniker => moniker of the DBIC class we are building,
509 local_columns => columns in this table in the relationship,
510 remote_class => name of the DBIC class we are related to,
511 remote_moniker => moniker of the DBIC class we are related to,
512 remote_columns => columns in the other table in the relationship,
515 DBICSL will try to use the value returned as the relationship name.
517 =head2 inflect_plural
519 Just like L</moniker_map> above (can be hash/code-ref, falls back to default
520 if hash key does not exist or coderef returns false), but acts as a map
521 for pluralizing relationship names. The default behavior is to utilize
522 L<Lingua::EN::Inflect::Phrase/to_PL>.
524 =head2 inflect_singular
526 As L</inflect_plural> above, but for singularizing relationship names.
527 Default behavior is to utilize L<Lingua::EN::Inflect::Phrase/to_S>.
529 =head2 schema_base_class
531 Base class for your schema classes. Defaults to 'DBIx::Class::Schema'.
533 =head2 result_base_class
535 Base class for your table classes (aka result classes). Defaults to
538 =head2 additional_base_classes
540 List of additional base classes all of your table classes will use.
542 =head2 left_base_classes
544 List of additional base classes all of your table classes will use
545 that need to be leftmost.
547 =head2 additional_classes
549 List of additional classes which all of your table classes will use.
551 =head2 schema_components
553 List of components to load into the Schema class.
557 List of additional components to be loaded into all of your Result
558 classes. A good example would be
559 L<InflateColumn::DateTime|DBIx::Class::InflateColumn::DateTime>
561 =head2 result_components_map
563 A hashref of moniker keys and component values. Unlike L</components>, which
564 loads the given components into every Result class, this option allows you to
565 load certain components for specified Result classes. For example:
567 result_components_map => {
568 StationVisited => '+YourApp::Schema::Component::StationVisited',
570 '+YourApp::Schema::Component::RouteChange',
571 'InflateColumn::DateTime',
575 You may use this in conjunction with L</components>.
579 List of L<Moose> roles to be applied to all of your Result classes.
581 =head2 result_roles_map
583 A hashref of moniker keys and role values. Unlike L</result_roles>, which
584 applies the given roles to every Result class, this option allows you to apply
585 certain roles for specified Result classes. For example:
587 result_roles_map => {
589 'YourApp::Role::Building',
590 'YourApp::Role::Destination',
592 RouteChange => 'YourApp::Role::TripEvent',
595 You may use this in conjunction with L</result_roles>.
597 =head2 use_namespaces
599 This is now the default, to go back to L<DBIx::Class::Schema/load_classes> pass
602 Generate result class names suitable for
603 L<DBIx::Class::Schema/load_namespaces> and call that instead of
604 L<DBIx::Class::Schema/load_classes>. When using this option you can also
605 specify any of the options for C<load_namespaces> (i.e. C<result_namespace>,
606 C<resultset_namespace>, C<default_resultset_class>), and they will be added
607 to the call (and the generated result class names adjusted appropriately).
609 =head2 dump_directory
611 The value of this option is a perl libdir pathname. Within
612 that directory this module will create a baseline manual
613 L<DBIx::Class::Schema> module set, based on what it creates at runtime.
615 The created schema class will have the same classname as the one on
616 which you are setting this option (and the ResultSource classes will be
617 based on this name as well).
619 Normally you wouldn't hard-code this setting in your schema class, as it
620 is meant for one-time manual usage.
622 See L<DBIx::Class::Schema::Loader/dump_to_dir> for examples of the
623 recommended way to access this functionality.
625 =head2 dump_overwrite
627 Deprecated. See L</really_erase_my_files> below, which does *not* mean
628 the same thing as the old C<dump_overwrite> setting from previous releases.
630 =head2 really_erase_my_files
632 Default false. If true, Loader will unconditionally delete any existing
633 files before creating the new ones from scratch when dumping a schema to disk.
635 The default behavior is instead to only replace the top portion of the
636 file, up to and including the final stanza which contains
637 C<# DO NOT MODIFY THE FIRST PART OF THIS FILE>
638 leaving any customizations you placed after that as they were.
640 When C<really_erase_my_files> is not set, if the output file already exists,
641 but the aforementioned final stanza is not found, or the checksum
642 contained there does not match the generated contents, Loader will
643 croak and not touch the file.
645 You should really be using version control on your schema classes (and all
646 of the rest of your code for that matter). Don't blame me if a bug in this
647 code wipes something out when it shouldn't have, you've been warned.
649 =head2 overwrite_modifications
651 Default false. If false, when updating existing files, Loader will
652 refuse to modify any Loader-generated code that has been modified
653 since its last run (as determined by the checksum Loader put in its
656 If true, Loader will discard any manual modifications that have been
657 made to Loader-generated code.
659 Again, you should be using version control on your schema classes. Be
660 careful with this option.
662 =head2 custom_column_info
664 Hook for adding extra attributes to the
665 L<column_info|DBIx::Class::ResultSource/column_info> for a column.
667 Must be a coderef that returns a hashref with the extra attributes.
669 Receives the table name, column name and column_info.
673 custom_column_info => sub {
674 my ($table_name, $column_name, $column_info) = @_;
676 if ($column_name eq 'dog' && $column_info->{default_value} eq 'snoopy') {
677 return { is_snoopy => 1 };
681 This attribute can also be used to set C<inflate_datetime> on a non-datetime
682 column so it also receives the L</datetime_timezone> and/or L</datetime_locale>.
684 =head2 datetime_timezone
686 Sets the timezone attribute for L<DBIx::Class::InflateColumn::DateTime> for all
687 columns with the DATE/DATETIME/TIMESTAMP data_types.
689 =head2 datetime_locale
691 Sets the locale attribute for L<DBIx::Class::InflateColumn::DateTime> for all
692 columns with the DATE/DATETIME/TIMESTAMP data_types.
694 =head2 datetime_undef_if_invalid
696 Pass a C<0> for this option when using MySQL if you B<DON'T> want C<<
697 datetime_undef_if_invalid => 1 >> in your column info for DATE, DATETIME and
700 The default is recommended to deal with data such as C<00/00/00> which
701 sometimes ends up in such columns in MySQL.
705 File in Perl format, which should return a HASH reference, from which to read
710 Usually column names are lowercased, to make them easier to work with in
711 L<DBIx::Class>. This option lets you turn this behavior off, if the driver
714 Drivers for case sensitive databases like Sybase ASE or MSSQL with a
715 case-sensitive collation will turn this option on unconditionally.
717 Currently the drivers for SQLite, mysql, MSSQL and Firebird/InterBase support
720 =head2 qualify_objects
722 Set to true to prepend the L</db_schema> to table names for C<<
723 __PACKAGE__->table >> calls, and to some other things like Oracle sequences.
727 Creates Schema and Result classes that use L<Moose>, L<MooseX::NonMoose> and
728 L<namespace::autoclean>. The default content after the md5 sum also makes the
731 It is safe to upgrade your existing Schema to this option.
733 =head2 col_collision_map
735 This option controls how accessors for column names which collide with perl
736 methods are named. See L</COLUMN ACCESSOR COLLISIONS> for more information.
738 This option takes either a single L<sprintf|perlfunc/sprintf> format or a hashref of
739 strings which are compiled to regular expressions that map to
740 L<sprintf|perlfunc/sprintf> formats.
744 col_collision_map => 'column_%s'
746 col_collision_map => { '(.*)' => 'column_%s' }
748 col_collision_map => { '(foo).*(bar)' => 'column_%s_%s' }
750 =head2 rel_collision_map
752 Works just like L</col_collision_map>, but for relationship names/accessors
753 rather than column names/accessors.
755 The default is to just append C<_rel> to the relationship name, see
756 L</RELATIONSHIP NAME COLLISIONS>.
758 =head2 uniq_to_primary
760 Automatically promotes the largest unique constraints with non-nullable columns
761 on tables to primary keys, assuming there is only one largest unique
764 =head2 filter_generated_code
766 An optional hook that lets you filter the generated text for various classes
767 through a function that change it in any way that you want. The function will
768 receive the type of file, C<schema> or C<result>, class and code; and returns
769 the new code to use instead. For instance you could add custom comments, or do
770 anything else that you want.
772 The option can also be set to a string, which is then used as a filter program,
775 If this exists but fails to return text matching C</\bpackage\b/>, no file will
778 filter_generated_code => sub {
779 my ($type, $class, $text) = @_;
786 None of these methods are intended for direct invocation by regular
787 users of L<DBIx::Class::Schema::Loader>. Some are proxied via
788 L<DBIx::Class::Schema::Loader>.
792 # ensure that a peice of object data is a valid arrayref, creating
793 # an empty one or encapsulating whatever's there.
794 sub _ensure_arrayref {
799 $self->{$_} = [ $self->{$_} ]
800 unless ref $self->{$_} eq 'ARRAY';
806 Constructor for L<DBIx::Class::Schema::Loader::Base>, used internally
807 by L<DBIx::Class::Schema::Loader>.
812 my ( $class, %args ) = @_;
814 if (exists $args{column_accessor_map}) {
815 $args{col_accessor_map} = delete $args{column_accessor_map};
818 my $self = { %args };
820 # don't lose undef options
821 for (values %$self) {
822 $_ = 0 unless defined $_;
825 bless $self => $class;
827 if (my $config_file = $self->config_file) {
828 my $config_opts = do $config_file;
830 croak "Error reading config from $config_file: $@" if $@;
832 croak "Config file $config_file must be a hashref" unless ref($config_opts) eq 'HASH';
834 while (my ($k, $v) = each %$config_opts) {
835 $self->{$k} = $v unless exists $self->{$k};
839 if (defined $self->{result_component_map}) {
840 if (defined $self->result_components_map) {
841 croak "Specify only one of result_components_map or result_component_map";
843 $self->result_components_map($self->{result_component_map})
846 if (defined $self->{result_role_map}) {
847 if (defined $self->result_roles_map) {
848 croak "Specify only one of result_roles_map or result_role_map";
850 $self->result_roles_map($self->{result_role_map})
853 croak "the result_roles and result_roles_map options may only be used in conjunction with use_moose=1"
854 if ((not defined $self->use_moose) || (not $self->use_moose))
855 && ((defined $self->result_roles) || (defined $self->result_roles_map));
857 $self->_ensure_arrayref(qw/schema_components
859 additional_base_classes
865 $self->_validate_class_args;
867 croak "result_components_map must be a hash"
868 if defined $self->result_components_map
869 && ref $self->result_components_map ne 'HASH';
871 if ($self->result_components_map) {
872 my %rc_map = %{ $self->result_components_map };
873 foreach my $moniker (keys %rc_map) {
874 $rc_map{$moniker} = [ $rc_map{$moniker} ] unless ref $rc_map{$moniker};
876 $self->result_components_map(\%rc_map);
879 $self->result_components_map({});
881 $self->_validate_result_components_map;
883 croak "result_roles_map must be a hash"
884 if defined $self->result_roles_map
885 && ref $self->result_roles_map ne 'HASH';
887 if ($self->result_roles_map) {
888 my %rr_map = %{ $self->result_roles_map };
889 foreach my $moniker (keys %rr_map) {
890 $rr_map{$moniker} = [ $rr_map{$moniker} ] unless ref $rr_map{$moniker};
892 $self->result_roles_map(\%rr_map);
894 $self->result_roles_map({});
896 $self->_validate_result_roles_map;
898 if ($self->use_moose) {
899 if (not DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose')) {
900 die sprintf "You must install the following CPAN modules to enable the use_moose option: %s.\n",
901 DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('use_moose');
905 $self->{_tables} = {};
906 $self->{monikers} = {};
907 $self->{moniker_to_table} = {};
908 $self->{class_to_table} = {};
909 $self->{classes} = {};
910 $self->{_upgrading_classes} = {};
912 $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
913 $self->{schema} ||= $self->{schema_class};
914 $self->{table_comments_table} ||= 'table_comments';
915 $self->{column_comments_table} ||= 'column_comments';
917 croak "dump_overwrite is deprecated. Please read the"
918 . " DBIx::Class::Schema::Loader::Base documentation"
919 if $self->{dump_overwrite};
921 $self->{dynamic} = ! $self->{dump_directory};
922 $self->{temp_directory} ||= File::Temp::tempdir( 'dbicXXXX',
927 $self->{dump_directory} ||= $self->{temp_directory};
929 $self->real_dump_directory($self->{dump_directory});
931 $self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
932 $self->schema_version_to_dump($DBIx::Class::Schema::Loader::VERSION);
934 if (not defined $self->naming) {
935 $self->naming_set(0);
938 $self->naming_set(1);
941 if ((not ref $self->naming) && defined $self->naming) {
942 my $naming_ver = $self->naming;
944 relationships => $naming_ver,
945 monikers => $naming_ver,
946 column_accessors => $naming_ver,
951 for (values %{ $self->naming }) {
952 $_ = $CURRENT_V if $_ eq 'current';
955 $self->{naming} ||= {};
957 if ($self->custom_column_info && ref $self->custom_column_info ne 'CODE') {
958 croak 'custom_column_info must be a CODE ref';
961 $self->_check_back_compat;
963 $self->use_namespaces(1) unless defined $self->use_namespaces;
964 $self->generate_pod(1) unless defined $self->generate_pod;
965 $self->pod_comment_mode('auto') unless defined $self->pod_comment_mode;
966 $self->pod_comment_spillover_length(60) unless defined $self->pod_comment_spillover_length;
968 if (my $col_collision_map = $self->col_collision_map) {
969 if (my $reftype = ref $col_collision_map) {
970 if ($reftype ne 'HASH') {
971 croak "Invalid type $reftype for option 'col_collision_map'";
975 $self->col_collision_map({ '(.*)' => $col_collision_map });
979 if (my $rel_collision_map = $self->rel_collision_map) {
980 if (my $reftype = ref $rel_collision_map) {
981 if ($reftype ne 'HASH') {
982 croak "Invalid type $reftype for option 'rel_collision_map'";
986 $self->rel_collision_map({ '(.*)' => $rel_collision_map });
990 if (defined(my $rel_name_map = $self->rel_name_map)) {
991 my $reftype = ref $rel_name_map;
992 if ($reftype ne 'HASH' && $reftype ne 'CODE') {
993 croak "Invalid type $reftype for option 'rel_name_map', must be HASH or CODE";
997 if (defined(my $filter = $self->filter_generated_code)) {
998 my $reftype = ref $filter;
999 if ($reftype && $reftype ne 'CODE') {
1000 croak "Invalid type $reftype for option 'filter_generated_code, must be a scalar or a CODE reference";
1004 if (defined $self->db_schema) {
1005 if (ref $self->db_schema eq 'ARRAY') {
1006 if (@{ $self->db_schema } > 1) {
1007 $self->{qualify_objects} = 1;
1009 elsif (@{ $self->db_schema } == 0) {
1010 $self->{db_schema} = undef;
1013 elsif (not ref $self->db_schema) {
1014 if ($self->db_schema eq '%') {
1015 $self->{qualify_objects} = 1;
1018 $self->{db_schema} = [ $self->db_schema ];
1022 if (not $self->moniker_parts) {
1023 $self->moniker_parts(['name']);
1026 if (not ref $self->moniker_parts) {
1027 $self->moniker_parts([ $self->moniker_parts ]);
1029 if (ref $self->moniker_parts ne 'ARRAY') {
1030 croak 'moniker_parts must be an arrayref';
1032 if ((firstidx { $_ eq 'name' } @{ $self->moniker_parts }) == -1) {
1033 croak "moniker_parts option *must* contain 'name'";
1040 sub _check_back_compat {
1043 # dynamic schemas will always be in 0.04006 mode, unless overridden
1044 if ($self->dynamic) {
1045 # just in case, though no one is likely to dump a dynamic schema
1046 $self->schema_version_to_dump('0.04006');
1048 if (not $self->naming_set) {
1049 warn <<EOF unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
1051 Dynamic schema detected, will run in 0.04006 mode.
1053 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
1054 to disable this warning.
1056 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
1061 $self->_upgrading_from('v4');
1064 if ((not defined $self->use_namespaces) && ($self->naming_set)) {
1065 $self->use_namespaces(1);
1068 $self->naming->{relationships} ||= 'v4';
1069 $self->naming->{monikers} ||= 'v4';
1071 if ($self->use_namespaces) {
1072 $self->_upgrading_from_load_classes(1);
1075 $self->use_namespaces(0);
1081 # otherwise check if we need backcompat mode for a static schema
1082 my $filename = $self->get_dump_filename($self->schema_class);
1083 return unless -e $filename;
1085 my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom) =
1086 $self->_parse_generated_file($filename);
1088 return unless $old_ver;
1090 # determine if the existing schema was dumped with use_moose => 1
1091 if (! defined $self->use_moose) {
1092 $self->{use_moose} = 1 if $old_gen =~ /^ (?!\s*\#) use \s+ Moose/xm;
1095 my $load_classes = ($old_gen =~ /^__PACKAGE__->load_classes;/m) ? 1 : 0;
1097 my $result_namespace = do { ($old_gen =~ /result_namespace => (.+)/) ? $1 : '' };
1098 my $ds = eval $result_namespace;
1100 Could not eval expression '$result_namespace' for result_namespace from
1103 $result_namespace = $ds || '';
1105 if ($load_classes && (not defined $self->use_namespaces)) {
1106 warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
1108 'load_classes;' static schema detected, turning off 'use_namespaces'.
1110 Set the 'use_namespaces' attribute or the SCHEMA_LOADER_BACKCOMPAT environment
1111 variable to disable this warning.
1113 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
1116 $self->use_namespaces(0);
1118 elsif ($load_classes && $self->use_namespaces) {
1119 $self->_upgrading_from_load_classes(1);
1121 elsif ((not $load_classes) && defined $self->use_namespaces && ! $self->use_namespaces) {
1122 $self->_downgrading_to_load_classes(
1123 $result_namespace || 'Result'
1126 elsif ((not defined $self->use_namespaces) || $self->use_namespaces) {
1127 if (not $self->result_namespace) {
1128 $self->result_namespace($result_namespace || 'Result');
1130 elsif ($result_namespace ne $self->result_namespace) {
1131 $self->_rewriting_result_namespace(
1132 $result_namespace || 'Result'
1137 # XXX when we go past .0 this will need fixing
1138 my ($v) = $old_ver =~ /([1-9])/;
1141 return if ($v eq $CURRENT_V || $old_ver =~ /^0\.\d\d999/);
1143 if (not %{ $self->naming }) {
1144 warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
1146 Version $old_ver static schema detected, turning on backcompat mode.
1148 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
1149 to disable this warning.
1151 See: 'naming' in perldoc DBIx::Class::Schema::Loader::Base .
1153 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 if upgrading
1154 from version 0.04006.
1157 $self->naming->{relationships} ||= $v;
1158 $self->naming->{monikers} ||= $v;
1159 $self->naming->{column_accessors} ||= $v;
1161 $self->schema_version_to_dump($old_ver);
1164 $self->_upgrading_from($v);
1168 sub _validate_class_args {
1171 foreach my $k (@CLASS_ARGS) {
1172 next unless $self->$k;
1174 my @classes = ref $self->$k eq 'ARRAY' ? @{ $self->$k } : $self->$k;
1175 $self->_validate_classes($k, \@classes);
1179 sub _validate_result_components_map {
1182 foreach my $classes (values %{ $self->result_components_map }) {
1183 $self->_validate_classes('result_components_map', $classes);
1187 sub _validate_result_roles_map {
1190 foreach my $classes (values %{ $self->result_roles_map }) {
1191 $self->_validate_classes('result_roles_map', $classes);
1195 sub _validate_classes {
1198 my $classes = shift;
1200 # make a copy to not destroy original
1201 my @classes = @$classes;
1203 foreach my $c (@classes) {
1204 # components default to being under the DBIx::Class namespace unless they
1205 # are preceeded with a '+'
1206 if ( $key =~ m/component/ && $c !~ s/^\+// ) {
1207 $c = 'DBIx::Class::' . $c;
1210 # 1 == installed, 0 == not installed, undef == invalid classname
1211 my $installed = Class::Inspector->installed($c);
1212 if ( defined($installed) ) {
1213 if ( $installed == 0 ) {
1214 croak qq/$c, as specified in the loader option "$key", is not installed/;
1217 croak qq/$c, as specified in the loader option "$key", is an invalid class name/;
1223 sub _find_file_in_inc {
1224 my ($self, $file) = @_;
1226 foreach my $prefix (@INC) {
1227 my $fullpath = File::Spec->catfile($prefix, $file);
1228 return $fullpath if -f $fullpath
1229 # abs_path throws on Windows for nonexistant files
1230 and (try { Cwd::abs_path($fullpath) }) ne
1231 ((try { Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) }) || '');
1237 sub _find_class_in_inc {
1238 my ($self, $class) = @_;
1240 return $self->_find_file_in_inc(class_path($class));
1246 return $self->_upgrading_from
1247 || $self->_upgrading_from_load_classes
1248 || $self->_downgrading_to_load_classes
1249 || $self->_rewriting_result_namespace
1253 sub _rewrite_old_classnames {
1254 my ($self, $code) = @_;
1256 return $code unless $self->_rewriting;
1258 my %old_classes = reverse %{ $self->_upgrading_classes };
1260 my $re = join '|', keys %old_classes;
1261 $re = qr/\b($re)\b/;
1263 $code =~ s/$re/$old_classes{$1} || $1/eg;
1268 sub _load_external {
1269 my ($self, $class) = @_;
1271 return if $self->{skip_load_external};
1273 # so that we don't load our own classes, under any circumstances
1274 local *INC = [ grep $_ ne $self->dump_directory, @INC ];
1276 my $real_inc_path = $self->_find_class_in_inc($class);
1278 my $old_class = $self->_upgrading_classes->{$class}
1279 if $self->_rewriting;
1281 my $old_real_inc_path = $self->_find_class_in_inc($old_class)
1282 if $old_class && $old_class ne $class;
1284 return unless $real_inc_path || $old_real_inc_path;
1286 if ($real_inc_path) {
1287 # If we make it to here, we loaded an external definition
1288 warn qq/# Loaded external class definition for '$class'\n/
1291 my $code = $self->_rewrite_old_classnames(slurp_file $real_inc_path);
1293 if ($self->dynamic) { # load the class too
1294 eval_package_without_redefine_warnings($class, $code);
1297 $self->_ext_stmt($class,
1298 qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
1299 .qq|# They are now part of the custom portion of this file\n|
1300 .qq|# for you to hand-edit. If you do not either delete\n|
1301 .qq|# this section or remove that file from \@INC, this section\n|
1302 .qq|# will be repeated redundantly when you re-create this\n|
1303 .qq|# file again via Loader! See skip_load_external to disable\n|
1304 .qq|# this feature.\n|
1307 $self->_ext_stmt($class, $code);
1308 $self->_ext_stmt($class,
1309 qq|# End of lines loaded from '$real_inc_path' |
1313 if ($old_real_inc_path) {
1314 my $code = slurp_file $old_real_inc_path;
1316 $self->_ext_stmt($class, <<"EOF");
1318 # These lines were loaded from '$old_real_inc_path',
1319 # based on the Result class name that would have been created by an older
1320 # version of the Loader. For a static schema, this happens only once during
1321 # upgrade. See skip_load_external to disable this feature.
1324 $code = $self->_rewrite_old_classnames($code);
1326 if ($self->dynamic) {
1329 Detected external content in '$old_real_inc_path', a class name that would have
1330 been used by an older version of the Loader.
1332 * PLEASE RENAME THIS CLASS: from '$old_class' to '$class', as that is the
1333 new name of the Result.
1335 eval_package_without_redefine_warnings($class, $code);
1339 $self->_ext_stmt($class, $code);
1340 $self->_ext_stmt($class,
1341 qq|# End of lines loaded from '$old_real_inc_path' |
1348 Does the actual schema-construction work.
1355 $self->_load_tables(
1356 $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude })
1364 Rescan the database for changes. Returns a list of the newly added table
1367 The schema argument should be the schema class or object to be affected. It
1368 should probably be derived from the original schema_class used during L</load>.
1373 my ($self, $schema) = @_;
1375 $self->{schema} = $schema;
1376 $self->_relbuilder->{schema} = $schema;
1379 my @current = $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude });
1381 foreach my $table (@current) {
1382 if(!exists $self->_tables->{$table->sql_name}) {
1383 push(@created, $table);
1388 @current{map $_->sql_name, @current} = ();
1389 foreach my $table (values %{ $self->_tables }) {
1390 if (not exists $current{$table->sql_name}) {
1391 $self->_remove_table($table);
1395 delete @$self{qw/_dump_storage _relations_started _uniqs_started/};
1397 my $loaded = $self->_load_tables(@current);
1399 foreach my $table (@created) {
1400 $self->monikers->{$table->sql_name} = $self->_table2moniker($table);
1403 return map { $self->monikers->{$_->sql_name} } @created;
1409 return if $self->{skip_relationships};
1411 return $self->{relbuilder} ||= do {
1412 my $relbuilder_suff =
1419 ->{$self->naming->{relationships}||$CURRENT_V} || '';
1421 my $relbuilder_class = 'DBIx::Class::Schema::Loader::RelBuilder'.$relbuilder_suff;
1422 $self->ensure_class_loaded($relbuilder_class);
1423 $relbuilder_class->new($self);
1428 my ($self, @tables) = @_;
1430 # Save the new tables to the tables list
1432 $self->_tables->{$_->sql_name} = $_;
1435 $self->_make_src_class($_) for @tables;
1437 # sanity-check for moniker clashes
1438 my $inverse_moniker_idx;
1439 foreach my $table (values %{ $self->_tables }) {
1440 push @{ $inverse_moniker_idx->{$self->monikers->{$table->sql_name}} }, $table;
1444 foreach my $moniker (keys %$inverse_moniker_idx) {
1445 my $tables = $inverse_moniker_idx->{$moniker};
1447 push @clashes, sprintf ("tables %s reduced to the same source moniker '%s'",
1448 join (', ', map $_->sql_name, @$tables),
1455 die 'Unable to load schema - chosen moniker/class naming style results in moniker clashes. '
1456 . 'In multi db_schema configurations you may need to set moniker_parts, '
1457 . 'otherwise change the naming style, or supply an explicit moniker_map: '
1458 . join ('; ', @clashes)
1463 $self->_setup_src_meta($_) for @tables;
1465 if(!$self->skip_relationships) {
1466 # The relationship loader needs a working schema
1467 local $self->{quiet} = 1;
1468 local $self->{dump_directory} = $self->{temp_directory};
1469 $self->_reload_classes(\@tables);
1470 $self->_load_relationships(\@tables);
1472 # Remove that temp dir from INC so it doesn't get reloaded
1473 @INC = grep $_ ne $self->dump_directory, @INC;
1476 $self->_load_roles($_) for @tables;
1478 $self->_load_external($_)
1479 for map { $self->classes->{$_->sql_name} } @tables;
1481 # Reload without unloading first to preserve any symbols from external
1483 $self->_reload_classes(\@tables, { unload => 0 });
1485 # Drop temporary cache
1486 delete $self->{_cache};
1491 sub _reload_classes {
1492 my ($self, $tables, $opts) = @_;
1494 my @tables = @$tables;
1496 my $unload = $opts->{unload};
1497 $unload = 1 unless defined $unload;
1499 # so that we don't repeat custom sections
1500 @INC = grep $_ ne $self->dump_directory, @INC;
1502 $self->_dump_to_dir(map { $self->classes->{$_->sql_name} } @tables);
1504 unshift @INC, $self->dump_directory;
1507 my %have_source = map { $_ => $self->schema->source($_) }
1508 $self->schema->sources;
1510 for my $table (@tables) {
1511 my $moniker = $self->monikers->{$table->sql_name};
1512 my $class = $self->classes->{$table->sql_name};
1515 no warnings 'redefine';
1516 local *Class::C3::reinitialize = sub {}; # to speed things up, reinitialized below
1519 if (my $mc = $self->_moose_metaclass($class)) {
1522 Class::Unload->unload($class) if $unload;
1523 my ($source, $resultset_class);
1525 ($source = $have_source{$moniker})
1526 && ($resultset_class = $source->resultset_class)
1527 && ($resultset_class ne 'DBIx::Class::ResultSet')
1529 my $has_file = Class::Inspector->loaded_filename($resultset_class);
1530 if (my $mc = $self->_moose_metaclass($resultset_class)) {
1533 Class::Unload->unload($resultset_class) if $unload;
1534 $self->_reload_class($resultset_class) if $has_file;
1536 $self->_reload_class($class);
1538 push @to_register, [$moniker, $class];
1541 Class::C3->reinitialize;
1542 for (@to_register) {
1543 $self->schema->register_class(@$_);
1547 sub _moose_metaclass {
1548 return undef unless $INC{'Class/MOP.pm'}; # if CMOP is not loaded the class could not have loaded in the 1st place
1552 my $mc = try { Class::MOP::class_of($class) }
1555 return $mc->isa('Moose::Meta::Class') ? $mc : undef;
1558 # We use this instead of ensure_class_loaded when there are package symbols we
1561 my ($self, $class) = @_;
1563 delete $INC{ +class_path($class) };
1566 eval_package_without_redefine_warnings ($class, "require $class");
1569 my $source = slurp_file $self->_get_dump_filename($class);
1570 die "Failed to reload class $class: $_.\n\nCLASS SOURCE:\n\n$source";
1574 sub _get_dump_filename {
1575 my ($self, $class) = (@_);
1577 $class =~ s{::}{/}g;
1578 return $self->dump_directory . q{/} . $class . q{.pm};
1581 =head2 get_dump_filename
1585 Returns the full path to the file for a class that the class has been or will
1586 be dumped to. This is a file in a temp dir for a dynamic schema.
1590 sub get_dump_filename {
1591 my ($self, $class) = (@_);
1593 local $self->{dump_directory} = $self->real_dump_directory;
1595 return $self->_get_dump_filename($class);
1598 sub _ensure_dump_subdirs {
1599 my ($self, $class) = (@_);
1601 my @name_parts = split(/::/, $class);
1602 pop @name_parts; # we don't care about the very last element,
1603 # which is a filename
1605 my $dir = $self->dump_directory;
1608 mkdir($dir) or croak "mkdir('$dir') failed: $!";
1610 last if !@name_parts;
1611 $dir = File::Spec->catdir($dir, shift @name_parts);
1616 my ($self, @classes) = @_;
1618 my $schema_class = $self->schema_class;
1619 my $schema_base_class = $self->schema_base_class || 'DBIx::Class::Schema';
1621 my $target_dir = $self->dump_directory;
1622 warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
1623 unless $self->dynamic or $self->quiet;
1627 . qq|package $schema_class;\n\n|
1628 . qq|# Created by DBIx::Class::Schema::Loader\n|
1629 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
1631 if ($self->use_moose) {
1632 $schema_text.= qq|use Moose;\nuse namespace::autoclean;\nextends '$schema_base_class';\n\n|;
1635 $schema_text .= qq|use strict;\nuse warnings;\n\nuse base '$schema_base_class';\n\n|;
1638 my @schema_components = @{ $self->schema_components || [] };
1640 if (@schema_components) {
1641 my $schema_components = dump @schema_components;
1642 $schema_components = "($schema_components)" if @schema_components == 1;
1644 $schema_text .= "__PACKAGE__->load_components${schema_components};\n\n";
1647 if ($self->use_namespaces) {
1648 $schema_text .= qq|__PACKAGE__->load_namespaces|;
1649 my $namespace_options;
1651 my @attr = qw/resultset_namespace default_resultset_class/;
1653 unshift @attr, 'result_namespace' unless (not $self->result_namespace) || $self->result_namespace eq 'Result';
1655 for my $attr (@attr) {
1657 my $code = dumper_squashed $self->$attr;
1658 $namespace_options .= qq| $attr => $code,\n|
1661 $schema_text .= qq|(\n$namespace_options)| if $namespace_options;
1662 $schema_text .= qq|;\n|;
1665 $schema_text .= qq|__PACKAGE__->load_classes;\n|;
1669 local $self->{version_to_dump} = $self->schema_version_to_dump;
1670 $self->_write_classfile($schema_class, $schema_text, 1);
1673 my $result_base_class = $self->result_base_class || 'DBIx::Class::Core';
1675 foreach my $src_class (@classes) {
1678 . qq|package $src_class;\n\n|
1679 . qq|# Created by DBIx::Class::Schema::Loader\n|
1680 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
1682 $src_text .= $self->_make_pod_heading($src_class);
1684 $src_text .= qq|use strict;\nuse warnings;\n\n|;
1686 $src_text .= $self->_base_class_pod($result_base_class)
1687 unless $result_base_class eq 'DBIx::Class::Core';
1689 if ($self->use_moose) {
1690 $src_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;|;
1692 # these options 'use base' which is compile time
1693 if (@{ $self->left_base_classes } || @{ $self->additional_base_classes }) {
1694 $src_text .= qq|\nBEGIN { extends '$result_base_class' }\n|;
1697 $src_text .= qq|\nextends '$result_base_class';\n|;
1701 $src_text .= qq|use base '$result_base_class';\n|;
1704 $self->_write_classfile($src_class, $src_text);
1707 # remove Result dir if downgrading from use_namespaces, and there are no
1709 if (my $result_ns = $self->_downgrading_to_load_classes
1710 || $self->_rewriting_result_namespace) {
1711 my $result_namespace = $self->_result_namespace(
1716 (my $result_dir = $result_namespace) =~ s{::}{/}g;
1717 $result_dir = $self->dump_directory . '/' . $result_dir;
1719 unless (my @files = glob "$result_dir/*") {
1724 warn "Schema dump completed.\n" unless $self->dynamic or $self->quiet;
1728 my ($self, $version, $ts) = @_;
1729 return qq|\n\n# Created by DBIx::Class::Schema::Loader|
1732 . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
1735 sub _write_classfile {
1736 my ($self, $class, $text, $is_schema) = @_;
1738 my $filename = $self->_get_dump_filename($class);
1739 $self->_ensure_dump_subdirs($class);
1741 if (-f $filename && $self->really_erase_my_files) {
1742 warn "Deleting existing file '$filename' due to "
1743 . "'really_erase_my_files' setting\n" unless $self->quiet;
1747 my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom)
1748 = $self->_parse_generated_file($filename);
1750 if (! $old_gen && -f $filename) {
1751 croak "Cannot overwrite '$filename' without 'really_erase_my_files',"
1752 . " it does not appear to have been generated by Loader"
1755 my $custom_content = $old_custom || '';
1757 # prepend extra custom content from a *renamed* class (singularization effect)
1758 if (my $renamed_class = $self->_upgrading_classes->{$class}) {
1759 my $old_filename = $self->_get_dump_filename($renamed_class);
1761 if (-f $old_filename) {
1762 my $extra_custom = ($self->_parse_generated_file ($old_filename))[4];
1764 $extra_custom =~ s/\n\n# You can replace.*\n1;\n//;
1766 $custom_content = join ("\n", '', $extra_custom, $custom_content)
1769 unlink $old_filename;
1773 $custom_content ||= $self->_default_custom_content($is_schema);
1775 # If upgrading to use_moose=1 replace default custom content with default Moose custom content.
1776 # If there is already custom content, which does not have the Moose content, add it.
1777 if ($self->use_moose) {
1779 my $non_moose_custom_content = do {
1780 local $self->{use_moose} = 0;
1781 $self->_default_custom_content;
1784 if ($custom_content eq $non_moose_custom_content) {
1785 $custom_content = $self->_default_custom_content($is_schema);
1787 elsif ($custom_content !~ /\Q@{[$self->_default_moose_custom_content($is_schema)]}\E/) {
1788 $custom_content .= $self->_default_custom_content($is_schema);
1791 elsif (defined $self->use_moose && $old_gen) {
1792 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'
1793 if $old_gen =~ /use \s+ MooseX?\b/x;
1796 $custom_content = $self->_rewrite_old_classnames($custom_content);
1799 for @{$self->{_dump_storage}->{$class} || []};
1801 if ($self->filter_generated_code) {
1802 my $filter = $self->filter_generated_code;
1804 if (ref $filter eq 'CODE') {
1806 ($is_schema ? 'schema' : 'result'),
1812 my ($out, $in) = (gensym, gensym);
1814 my $pid = open2($out, $in, $filter)
1815 or croak "Could not open pipe to $filter: $!";
1821 $text = decode('UTF-8', do { local $/; <$out> });
1823 $text =~ s/$CR?$LF/\n/g;
1827 my $exit_code = $? >> 8;
1829 if ($exit_code != 0) {
1830 croak "filter '$filter' exited non-zero: $exit_code";
1833 if (not $text or not $text =~ /\bpackage\b/) {
1834 warn("$class skipped due to filter") if $self->debug;
1839 # Check and see if the dump is in fact different
1843 $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
1844 if (Digest::MD5::md5_base64(encode 'UTF-8', $compare_to) eq $old_md5) {
1845 return unless $self->_upgrading_from && $is_schema;
1849 $text .= $self->_sig_comment(
1850 $self->version_to_dump,
1851 POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
1854 open(my $fh, '>:encoding(UTF-8)', $filename)
1855 or croak "Cannot open '$filename' for writing: $!";
1857 # Write the top half and its MD5 sum
1858 print $fh $text . Digest::MD5::md5_base64(encode 'UTF-8', $text) . "\n";
1860 # Write out anything loaded via external partial class file in @INC
1862 for @{$self->{_ext_storage}->{$class} || []};
1864 # Write out any custom content the user has added
1865 print $fh $custom_content;
1868 or croak "Error closing '$filename': $!";
1871 sub _default_moose_custom_content {
1872 my ($self, $is_schema) = @_;
1874 if (not $is_schema) {
1875 return qq|\n__PACKAGE__->meta->make_immutable;|;
1878 return qq|\n__PACKAGE__->meta->make_immutable(inline_constructor => 0);|;
1881 sub _default_custom_content {
1882 my ($self, $is_schema) = @_;
1883 my $default = qq|\n\n# You can replace this text with custom|
1884 . qq| code or comments, and it will be preserved on regeneration|;
1885 if ($self->use_moose) {
1886 $default .= $self->_default_moose_custom_content($is_schema);
1888 $default .= qq|\n1;\n|;
1892 sub _parse_generated_file {
1893 my ($self, $fn) = @_;
1895 return unless -f $fn;
1897 open(my $fh, '<:encoding(UTF-8)', $fn)
1898 or croak "Cannot open '$fn' for reading: $!";
1901 qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\r?\n};
1903 my ($md5, $ts, $ver, $gen);
1909 # Pull out the version and timestamp from the line above
1910 ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)\r?\Z/m;
1913 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"
1914 if !$self->overwrite_modifications && Digest::MD5::md5_base64(encode 'UTF-8', $gen) ne $md5;
1923 my $custom = do { local $/; <$fh> }
1927 $custom =~ s/$CRLF|$LF/\n/g;
1931 return ($gen, $md5, $ver, $ts, $custom);
1939 warn "$target: use $_;" if $self->debug;
1940 $self->_raw_stmt($target, "use $_;");
1948 my $blist = join(q{ }, @_);
1950 return unless $blist;
1952 warn "$target: use base qw/$blist/;" if $self->debug;
1953 $self->_raw_stmt($target, "use base qw/$blist/;");
1960 my $rlist = join(q{, }, map { qq{'$_'} } @_);
1962 return unless $rlist;
1964 warn "$target: with $rlist;" if $self->debug;
1965 $self->_raw_stmt($target, "\nwith $rlist;");
1968 sub _result_namespace {
1969 my ($self, $schema_class, $ns) = @_;
1970 my @result_namespace;
1972 $ns = $ns->[0] if ref $ns;
1974 if ($ns =~ /^\+(.*)/) {
1975 # Fully qualified namespace
1976 @result_namespace = ($1)
1979 # Relative namespace
1980 @result_namespace = ($schema_class, $ns);
1983 return wantarray ? @result_namespace : join '::', @result_namespace;
1986 # Create class with applicable bases, setup monikers, etc
1987 sub _make_src_class {
1988 my ($self, $table) = @_;
1990 my $schema = $self->schema;
1991 my $schema_class = $self->schema_class;
1993 my $table_moniker = $self->_table2moniker($table);
1994 my @result_namespace = ($schema_class);
1995 if ($self->use_namespaces) {
1996 my $result_namespace = $self->result_namespace || 'Result';
1997 @result_namespace = $self->_result_namespace(
2002 my $table_class = join(q{::}, @result_namespace, $table_moniker);
2004 if ((my $upgrading_v = $self->_upgrading_from)
2005 || $self->_rewriting) {
2006 local $self->naming->{monikers} = $upgrading_v
2009 my @result_namespace = @result_namespace;
2010 if ($self->_upgrading_from_load_classes) {
2011 @result_namespace = ($schema_class);
2013 elsif (my $ns = $self->_downgrading_to_load_classes) {
2014 @result_namespace = $self->_result_namespace(
2019 elsif ($ns = $self->_rewriting_result_namespace) {
2020 @result_namespace = $self->_result_namespace(
2026 my $old_table_moniker = do {
2027 local $self->naming->{monikers} = $upgrading_v;
2028 $self->_table2moniker($table);
2031 my $old_class = join(q{::}, @result_namespace, $old_table_moniker);
2033 $self->_upgrading_classes->{$table_class} = $old_class
2034 unless $table_class eq $old_class;
2037 $self->classes->{$table->sql_name} = $table_class;
2038 $self->monikers->{$table->sql_name} = $table_moniker;
2039 $self->moniker_to_table->{$table_moniker} = $table;
2040 $self->class_to_table->{$table_class} = $table;
2042 $self->_pod_class_list($table_class, 'ADDITIONAL CLASSES USED', @{$self->additional_classes});
2044 $self->_use ($table_class, @{$self->additional_classes});
2046 $self->_pod_class_list($table_class, 'LEFT BASE CLASSES', @{$self->left_base_classes});
2048 $self->_inject($table_class, @{$self->left_base_classes});
2050 my @components = @{ $self->components || [] };
2052 push @components, @{ $self->result_components_map->{$table_moniker} }
2053 if exists $self->result_components_map->{$table_moniker};
2055 my @fq_components = @components;
2056 foreach my $component (@fq_components) {
2057 if ($component !~ s/^\+//) {
2058 $component = "DBIx::Class::$component";
2062 $self->_pod_class_list($table_class, 'COMPONENTS LOADED', @fq_components);
2064 $self->_dbic_stmt($table_class, 'load_components', @components) if @components;
2066 $self->_pod_class_list($table_class, 'ADDITIONAL BASE CLASSES', @{$self->additional_base_classes});
2068 $self->_inject($table_class, @{$self->additional_base_classes});
2071 sub _is_result_class_method {
2072 my ($self, $name, $table) = @_;
2074 my $table_moniker = $table ? $self->monikers->{$table->sql_name} : '';
2076 $self->_result_class_methods({})
2077 if not defined $self->_result_class_methods;
2079 if (not exists $self->_result_class_methods->{$table_moniker}) {
2080 my (@methods, %methods);
2081 my $base = $self->result_base_class || 'DBIx::Class::Core';
2083 my @components = @{ $self->components || [] };
2085 push @components, @{ $self->result_components_map->{$table_moniker} }
2086 if exists $self->result_components_map->{$table_moniker};
2088 for my $c (@components) {
2089 $c = $c =~ /^\+/ ? substr($c,1) : "DBIx::Class::$c";
2092 my @roles = @{ $self->result_roles || [] };
2094 push @roles, @{ $self->result_roles_map->{$table_moniker} }
2095 if exists $self->result_roles_map->{$table_moniker};
2097 for my $class ($base, @components,
2098 ($self->use_moose ? 'Moose::Object' : ()), @roles) {
2099 $self->ensure_class_loaded($class);
2101 push @methods, @{ Class::Inspector->methods($class) || [] };
2104 push @methods, @{ Class::Inspector->methods('UNIVERSAL') };
2106 @methods{@methods} = ();
2108 $self->_result_class_methods->{$table_moniker} = \%methods;
2110 my $result_methods = $self->_result_class_methods->{$table_moniker};
2112 return exists $result_methods->{$name};
2115 sub _resolve_col_accessor_collisions {
2116 my ($self, $table, $col_info) = @_;
2118 while (my ($col, $info) = each %$col_info) {
2119 my $accessor = $info->{accessor} || $col;
2121 next if $accessor eq 'id'; # special case (very common column)
2123 if ($self->_is_result_class_method($accessor, $table)) {
2126 if (my $map = $self->col_collision_map) {
2127 for my $re (keys %$map) {
2128 if (my @matches = $col =~ /$re/) {
2129 $info->{accessor} = sprintf $map->{$re}, @matches;
2137 Column '$col' in table '$table' collides with an inherited method.
2138 See "COLUMN ACCESSOR COLLISIONS" in perldoc DBIx::Class::Schema::Loader::Base .
2140 $info->{accessor} = undef;
2146 # use the same logic to run moniker_map, col_accessor_map
2148 my ( $self, $map, $default_code, $ident, @extra ) = @_;
2150 my $default_ident = $default_code->( $ident, @extra );
2152 if( $map && ref $map eq 'HASH' ) {
2153 $new_ident = $map->{ $ident };
2155 elsif( $map && ref $map eq 'CODE' ) {
2156 $new_ident = $map->( $ident, $default_ident, @extra );
2159 $new_ident ||= $default_ident;
2164 sub _default_column_accessor_name {
2165 my ( $self, $column_name ) = @_;
2167 my $accessor_name = $column_name;
2168 $accessor_name =~ s/\W+/_/g;
2170 if ((($self->naming->{column_accessors}||'') =~ /(\d+)/ && $1 < 7) || (not $self->preserve_case)) {
2171 # older naming just lc'd the col accessor and that's all.
2172 return lc $accessor_name;
2174 elsif (($self->naming->{column_accessors}||'') eq 'preserve') {
2175 return $accessor_name;
2178 return join '_', map lc, split_name $column_name;
2181 sub _make_column_accessor_name {
2182 my ($self, $column_name, $column_context_info ) = @_;
2184 my $accessor = $self->_run_user_map(
2185 $self->col_accessor_map,
2186 sub { $self->_default_column_accessor_name( shift ) },
2188 $column_context_info,
2194 # Set up metadata (cols, pks, etc)
2195 sub _setup_src_meta {
2196 my ($self, $table) = @_;
2198 my $schema = $self->schema;
2199 my $schema_class = $self->schema_class;
2201 my $table_class = $self->classes->{$table->sql_name};
2202 my $table_moniker = $self->monikers->{$table->sql_name};
2204 $self->_dbic_stmt($table_class, 'table', $table->dbic_name);
2206 my $cols = $self->_table_columns($table);
2207 my $col_info = $self->__columns_info_for($table);
2209 ### generate all the column accessor names
2210 while (my ($col, $info) = each %$col_info) {
2211 # hashref of other info that could be used by
2212 # user-defined accessor map functions
2214 table_class => $table_class,
2215 table_moniker => $table_moniker,
2216 table_name => $table,
2217 full_table_name => $table->dbic_name,
2218 schema_class => $schema_class,
2219 column_info => $info,
2222 $info->{accessor} = $self->_make_column_accessor_name( $col, $context );
2225 $self->_resolve_col_accessor_collisions($table, $col_info);
2227 # prune any redundant accessor names
2228 while (my ($col, $info) = each %$col_info) {
2229 no warnings 'uninitialized';
2230 delete $info->{accessor} if $info->{accessor} eq $col;
2233 my $fks = $self->_table_fk_info($table);
2235 foreach my $fkdef (@$fks) {
2236 for my $col (@{ $fkdef->{local_columns} }) {
2237 $col_info->{$col}{is_foreign_key} = 1;
2241 my $pks = $self->_table_pk_info($table) || [];
2243 my %uniq_tag; # used to eliminate duplicate uniqs
2245 $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
2247 my $uniqs = $self->_table_uniq_info($table) || [];
2250 foreach my $uniq (@$uniqs) {
2251 my ($name, $cols) = @$uniq;
2252 next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
2253 push @uniqs, [$name, $cols];
2256 my @non_nullable_uniqs = grep {
2257 all { $col_info->{$_}{is_nullable} == 0 } @{ $_->[1] }
2260 if ($self->uniq_to_primary && (not @$pks) && @non_nullable_uniqs) {
2261 my @by_colnum = sort { $b->[0] <=> $a->[0] }
2262 map [ scalar @{ $_->[1] }, $_ ], @non_nullable_uniqs;
2264 if (not (@by_colnum > 1 && $by_colnum[0][0] == $by_colnum[1][0])) {
2265 my @keys = map $_->[1], @by_colnum;
2269 # remove the uniq from list
2270 @uniqs = grep { $_->[0] ne $pk->[0] } @uniqs;
2276 foreach my $pkcol (@$pks) {
2277 $col_info->{$pkcol}{is_nullable} = 0;
2283 map { $_, ($col_info->{$_}||{}) } @$cols
2286 $self->_dbic_stmt($table_class, 'set_primary_key', @$pks)
2289 # Sort unique constraints by constraint name for repeatable results (rels
2290 # are sorted as well elsewhere.)
2291 @uniqs = sort { $a->[0] cmp $b->[0] } @uniqs;
2293 foreach my $uniq (@uniqs) {
2294 my ($name, $cols) = @$uniq;
2295 $self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
2299 sub __columns_info_for {
2300 my ($self, $table) = @_;
2302 my $result = $self->_columns_info_for($table);
2304 while (my ($col, $info) = each %$result) {
2305 $info = { %$info, %{ $self->_custom_column_info ($table, $col, $info) } };
2306 $info = { %$info, %{ $self->_datetime_column_info($table, $col, $info) } };
2308 $result->{$col} = $info;
2316 Returns a sorted list of loaded tables, using the original database table
2324 return values %{$self->_tables};
2327 # Make a moniker from a table
2328 sub _default_table2moniker {
2329 my ($self, $table) = @_;
2331 my ($v) = ($self->naming->{monikers}||$CURRENT_V) =~ /^v(\d+)\z/;
2333 my @name_parts = map $table->$_, @{ $self->moniker_parts };
2335 my $name_idx = firstidx { $_ eq 'name' } @{ $self->moniker_parts };
2337 my $to_identifier = $self->naming->{force_ascii} ?
2338 \&String::ToIdentifier::EN::to_identifier
2339 : \&String::ToIdentifier::EN::Unicode::to_identifier;
2343 foreach my $i (0 .. $#name_parts) {
2344 my $part = $name_parts[$i];
2346 if ($i != $name_idx || $v > 7) {
2347 $part = $to_identifier->($part, '_');
2350 if ($i == $name_idx && $v == 5) {
2351 $part = Lingua::EN::Inflect::Number::to_S($part);
2354 my @part_parts = map lc, $v > 6 ? split_name $part : split /[\W_]+/, $part;
2356 if ($i == $name_idx && $v >= 6) {
2357 my $as_phrase = join ' ', @part_parts;
2359 my $inflected = ($self->naming->{monikers}||'') eq 'plural' ?
2360 Lingua::EN::Inflect::Phrase::to_PL($as_phrase)
2362 ($self->naming->{monikers}||'') eq 'preserve' ?
2365 Lingua::EN::Inflect::Phrase::to_S($as_phrase);
2367 @part_parts = split /\s+/, $inflected;
2370 push @all_parts, map ucfirst, @part_parts;
2373 return join '', @all_parts;
2376 sub _table2moniker {
2377 my ( $self, $table ) = @_;
2379 $self->_run_user_map(
2381 sub { $self->_default_table2moniker( shift ) },
2386 sub _load_relationships {
2387 my ($self, $tables) = @_;
2391 foreach my $table (@$tables) {
2392 my $local_moniker = $self->monikers->{$table->sql_name};
2394 my $tbl_fk_info = $self->_table_fk_info($table);
2396 foreach my $fkdef (@$tbl_fk_info) {
2397 $fkdef->{local_table} = $table;
2398 $fkdef->{local_moniker} = $local_moniker;
2399 $fkdef->{remote_source} =
2400 $self->monikers->{$fkdef->{remote_table}->sql_name};
2402 my $tbl_uniq_info = $self->_table_uniq_info($table);
2404 push @tables, [ $local_moniker, $tbl_fk_info, $tbl_uniq_info ];
2407 my $rel_stmts = $self->_relbuilder->generate_code(\@tables);
2409 foreach my $src_class (sort keys %$rel_stmts) {
2411 my @src_stmts = map $_->[1],
2412 sort { $a->[0] cmp $b->[0] }
2413 map [ $_->{args}[0], $_ ], @{ $rel_stmts->{$src_class} };
2415 foreach my $stmt (@src_stmts) {
2416 $self->_dbic_stmt($src_class,$stmt->{method}, @{$stmt->{args}});
2422 my ($self, $table) = @_;
2424 my $table_moniker = $self->monikers->{$table->sql_name};
2425 my $table_class = $self->classes->{$table->sql_name};
2427 my @roles = @{ $self->result_roles || [] };
2428 push @roles, @{ $self->result_roles_map->{$table_moniker} }
2429 if exists $self->result_roles_map->{$table_moniker};
2432 $self->_pod_class_list($table_class, 'L<Moose> ROLES APPLIED', @roles);
2434 $self->_with($table_class, @roles);
2438 # Overload these in driver class:
2440 # Returns an arrayref of column names
2441 sub _table_columns { croak "ABSTRACT METHOD" }
2443 # Returns arrayref of pk col names
2444 sub _table_pk_info { croak "ABSTRACT METHOD" }
2446 # Returns an arrayref of uniqs [ [ foo => [ col1, col2 ] ], [ bar => [ ... ] ] ]
2447 sub _table_uniq_info { croak "ABSTRACT METHOD" }
2449 # Returns an arrayref of foreign key constraints, each
2450 # being a hashref with 3 keys:
2451 # local_columns (arrayref), remote_columns (arrayref), remote_table
2452 sub _table_fk_info { croak "ABSTRACT METHOD" }
2454 # Returns an array of lower case table names
2455 sub _tables_list { croak "ABSTRACT METHOD" }
2457 # Execute a constructive DBIC class method, with debug/dump_to_dir hooks.
2463 # generate the pod for this statement, storing it with $self->_pod
2464 $self->_make_pod( $class, $method, @_ ) if $self->generate_pod;
2466 my $args = dump(@_);
2467 $args = '(' . $args . ')' if @_ < 2;
2468 my $stmt = $method . $args . q{;};
2470 warn qq|$class\->$stmt\n| if $self->debug;
2471 $self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
2475 sub _make_pod_heading {
2476 my ($self, $class) = @_;
2478 return '' if not $self->generate_pod;
2480 my $table = $self->class_to_table->{$class};
2483 my $pcm = $self->pod_comment_mode;
2484 my ($comment, $comment_overflows, $comment_in_name, $comment_in_desc);
2485 $comment = $self->__table_comment($table);
2486 $comment_overflows = ($comment and length $comment > $self->pod_comment_spillover_length);
2487 $comment_in_name = ($pcm eq 'name' or ($pcm eq 'auto' and !$comment_overflows));
2488 $comment_in_desc = ($pcm eq 'description' or ($pcm eq 'auto' and $comment_overflows));
2490 $pod .= "=head1 NAME\n\n";
2492 my $table_descr = $class;
2493 $table_descr .= " - " . $comment if $comment and $comment_in_name;
2495 $pod .= "$table_descr\n\n";
2497 if ($comment and $comment_in_desc) {
2498 $pod .= "=head1 DESCRIPTION\n\n${comment}\n\n";
2505 # generates the accompanying pod for a DBIC class method statement,
2506 # storing it with $self->_pod
2512 if ($method eq 'table') {
2514 $table = $$table if ref $table eq 'SCALAR';
2515 $self->_pod($class, "=head1 TABLE: C<$table>");
2516 $self->_pod_cut($class);
2518 elsif ( $method eq 'add_columns' ) {
2519 $self->_pod( $class, "=head1 ACCESSORS" );
2520 my $col_counter = 0;
2522 while( my ($name,$attrs) = splice @cols,0,2 ) {
2524 $self->_pod( $class, '=head2 ' . $name );
2525 $self->_pod( $class,
2527 my $s = $attrs->{$_};
2528 $s = !defined $s ? 'undef' :
2529 length($s) == 0 ? '(empty string)' :
2530 ref($s) eq 'SCALAR' ? $$s :
2531 ref($s) ? dumper_squashed $s :
2532 looks_like_number($s) ? $s : qq{'$s'};
2535 } sort keys %$attrs,
2537 if (my $comment = $self->__column_comment($self->class_to_table->{$class}, $col_counter, $name)) {
2538 $self->_pod( $class, $comment );
2541 $self->_pod_cut( $class );
2542 } elsif ( $method =~ /^(belongs_to|has_many|might_have)$/ ) {
2543 $self->_pod( $class, "=head1 RELATIONS" ) unless $self->{_relations_started} { $class } ;
2544 my ( $accessor, $rel_class ) = @_;
2545 $self->_pod( $class, "=head2 $accessor" );
2546 $self->_pod( $class, 'Type: ' . $method );
2547 $self->_pod( $class, "Related object: L<$rel_class>" );
2548 $self->_pod_cut( $class );
2549 $self->{_relations_started} { $class } = 1;
2551 elsif ($method eq 'add_unique_constraint') {
2552 $self->_pod($class, '=head1 UNIQUE CONSTRAINTS')
2553 unless $self->{_uniqs_started}{$class};
2555 my ($name, $cols) = @_;
2557 $self->_pod($class, "=head2 C<$name>");
2558 $self->_pod($class, '=over 4');
2560 foreach my $col (@$cols) {
2561 $self->_pod($class, "=item \* L</$col>");
2564 $self->_pod($class, '=back');
2565 $self->_pod_cut($class);
2567 $self->{_uniqs_started}{$class} = 1;
2569 elsif ($method eq 'set_primary_key') {
2570 $self->_pod($class, "=head1 PRIMARY KEY");
2571 $self->_pod($class, '=over 4');
2573 foreach my $col (@_) {
2574 $self->_pod($class, "=item \* L</$col>");
2577 $self->_pod($class, '=back');
2578 $self->_pod_cut($class);
2582 sub _pod_class_list {
2583 my ($self, $class, $title, @classes) = @_;
2585 return unless @classes && $self->generate_pod;
2587 $self->_pod($class, "=head1 $title");
2588 $self->_pod($class, '=over 4');
2590 foreach my $link (@classes) {
2591 $self->_pod($class, "=item * L<$link>");
2594 $self->_pod($class, '=back');
2595 $self->_pod_cut($class);
2598 sub _base_class_pod {
2599 my ($self, $base_class) = @_;
2601 return '' unless $self->generate_pod;
2604 =head1 BASE CLASS: L<$base_class>
2611 sub _filter_comment {
2612 my ($self, $txt) = @_;
2614 $txt = '' if not defined $txt;
2616 $txt =~ s/(?:\015?\012|\015\012?)/\n/g;
2621 sub __table_comment {
2624 if (my $code = $self->can('_table_comment')) {
2625 return $self->_filter_comment($self->$code(@_));
2631 sub __column_comment {
2634 if (my $code = $self->can('_column_comment')) {
2635 return $self->_filter_comment($self->$code(@_));
2641 # Stores a POD documentation
2643 my ($self, $class, $stmt) = @_;
2644 $self->_raw_stmt( $class, "\n" . $stmt );
2648 my ($self, $class ) = @_;
2649 $self->_raw_stmt( $class, "\n=cut\n" );
2652 # Store a raw source line for a class (for dumping purposes)
2654 my ($self, $class, $stmt) = @_;
2655 push(@{$self->{_dump_storage}->{$class}}, $stmt);
2658 # Like above, but separately for the externally loaded stuff
2660 my ($self, $class, $stmt) = @_;
2661 push(@{$self->{_ext_storage}->{$class}}, $stmt);
2664 sub _custom_column_info {
2665 my ( $self, $table_name, $column_name, $column_info ) = @_;
2667 if (my $code = $self->custom_column_info) {
2668 return $code->($table_name, $column_name, $column_info) || {};
2673 sub _datetime_column_info {
2674 my ( $self, $table_name, $column_name, $column_info ) = @_;
2676 my $type = $column_info->{data_type} || '';
2677 if ((grep $_, @{ $column_info }{map "inflate_$_", qw/date datetime timestamp/})
2678 or ($type =~ /date|timestamp/i)) {
2679 $result->{timezone} = $self->datetime_timezone if $self->datetime_timezone;
2680 $result->{locale} = $self->datetime_locale if $self->datetime_locale;
2686 my ($self, $name) = @_;
2688 return $self->preserve_case ? $name : lc($name);
2692 my ($self, $name) = @_;
2694 return $self->preserve_case ? $name : uc($name);
2698 my ($self, $table) = @_;
2701 my $schema = $self->schema;
2702 # in older DBIC it's a private method
2703 my $unregister = $schema->can('unregister_source') || $schema->can('_unregister_source');
2704 $schema->$unregister(delete $self->monikers->{$table->sql_name});
2705 delete $self->_upgrading_classes->{delete $self->classes->{$table->sql_name}};
2706 delete $self->_tables->{$table->sql_name};
2710 # remove the dump dir from @INC on destruction
2714 @INC = grep $_ ne $self->dump_directory, @INC;
2719 Returns a hashref of loaded table to moniker mappings. There will
2720 be two entries for each table, the original name and the "normalized"
2721 name, in the case that the two are different (such as databases
2722 that like uppercase table names, or preserve your original mixed-case
2723 definitions, or what-have-you).
2727 Returns a hashref of table to class mappings. In some cases it will
2728 contain multiple entries per table for the original and normalized table
2729 names, as above in L</monikers>.
2731 =head1 NON-ENGLISH DATABASES
2733 If you use the loader on a database with table and column names in a language
2734 other than English, you will want to turn off the English language specific
2737 To do so, use something like this in your laoder options:
2739 naming => { monikers => 'v4' },
2740 inflect_singular => sub { "$_[0]_rel" },
2741 inflect_plural => sub { "$_[0]_rel" },
2743 =head1 COLUMN ACCESSOR COLLISIONS
2745 Occasionally you may have a column name that collides with a perl method, such
2746 as C<can>. In such cases, the default action is to set the C<accessor> of the
2747 column spec to C<undef>.
2749 You can then name the accessor yourself by placing code such as the following
2752 __PACKAGE__->add_column('+can' => { accessor => 'my_can' });
2754 Another option is to use the L</col_collision_map> option.
2756 =head1 RELATIONSHIP NAME COLLISIONS
2758 In very rare cases, you may get a collision between a generated relationship
2759 name and a method in your Result class, for example if you have a foreign key
2760 called C<belongs_to>.
2762 This is a problem because relationship names are also relationship accessor
2763 methods in L<DBIx::Class>.
2765 The default behavior is to append C<_rel> to the relationship name and print
2766 out a warning that refers to this text.
2768 You can also control the renaming with the L</rel_collision_map> option.
2772 L<DBIx::Class::Schema::Loader>
2776 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
2780 This library is free software; you can redistribute it and/or modify it under
2781 the same terms as Perl itself.
2786 # vim:et sts=4 sw=4 tw=0: