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. They both need to have columns named
299 C<table_name> and C<comment_text>. The second one needs to have a column
300 named C<column_name>. Then data stored in these tables will be used as a
301 source of metadata about tables and comments.
303 (If you wish you can change the name of these tables with the parameters
304 L</table_comments_table> and L</column_comments_table>.)
306 As a fallback you can use built-in commenting mechanisms. Currently this is
307 only supported for PostgreSQL, Oracle and MySQL. To create comments in
308 PostgreSQL you add statements of the form C<COMMENT ON TABLE some_table IS
309 '...'>, the same syntax is used in Oracle. To create comments in MySQL you add
310 C<COMMENT '...'> to the end of the column or table definition. Note that MySQL
311 restricts the length of comments, and also does not handle complex Unicode
314 Set this to C<0> to turn off all POD generation.
316 =head2 pod_comment_mode
318 Controls where table comments appear in the generated POD. Smaller table
319 comments are appended to the C<NAME> section of the documentation, and larger
320 ones are inserted into C<DESCRIPTION> instead. You can force a C<DESCRIPTION>
321 section to be generated with the comment always, only use C<NAME>, or choose
322 the length threshold at which the comment is forced into the description.
328 Use C<NAME> section only.
332 Force C<DESCRIPTION> always.
336 Use C<DESCRIPTION> if length > L</pod_comment_spillover_length>, this is the
341 =head2 pod_comment_spillover_length
343 When pod_comment_mode is set to C<auto>, this is the length of the comment at
344 which it will be forced into a separate description section.
348 =head2 table_comments_table
350 The table to look for comments about tables in. By default C<table_comments>.
351 See L</generate_pod> for details.
353 =head2 column_comments_table
355 The table to look for comments about columns in. By default C<column_comments>.
356 See L</generate_pod> for details.
358 =head2 relationship_attrs
360 Hashref of attributes to pass to each generated relationship, listed
361 by type. Also supports relationship type 'all', containing options to
362 pass to all generated relationships. Attributes set for more specific
363 relationship types override those set in 'all'.
367 relationship_attrs => {
368 belongs_to => { is_deferrable => 0 },
371 use this to turn off DEFERRABLE on your foreign key constraints.
375 If set to true, each constructive L<DBIx::Class> statement the loader
376 decides to execute will be C<warn>-ed before execution.
380 Set the name of the schema to load (schema in the sense that your database
383 Can be set to an arrayref of schema names for multiple schemas, or the special
384 value C<%> for all schemas.
386 For MSSQL, Sybase ASE, and Informix can be set to a hashref of databases as
387 keys and arrays of owners as values, set to the value:
391 for all owners in all databases.
393 You may need to control naming of monikers with L</moniker_parts> if you have
394 name clashes for tables in different schemas/databases.
398 The database table names are represented by the
399 L<DBIx::Class::Schema::Loader::Table> class in the loader, the
400 L<DBIx::Class::Schema::Loader::Table::Sybase> class for Sybase ASE and
401 L<DBIx::Class::Schema::Loader::Table::Informix> for Informix.
403 Monikers are created normally based on just the
404 L<name|DBIx::Class::Schema::Loader::DBObject/name> property, corresponding to
405 the table name, but can consist of other parts of the fully qualified name of
408 The L</moniker_parts> option is an arrayref of methods on the table class
409 corresponding to parts of the fully qualified table name, defaulting to
410 C<['name']>, in the order those parts are used to create the moniker name.
412 The C<'name'> entry B<must> be present.
414 Below is a table of supported databases and possible L</moniker_parts>.
418 =item * DB2, Firebird, mysql, Oracle, Pg, SQLAnywhere, SQLite, MS Access
422 =item * Informix, MSSQL, Sybase ASE
424 C<database>, C<schema>, C<name>
430 Only load tables matching regex. Best specified as a qr// regex.
434 Exclude tables matching regex. Best specified as a qr// regex.
438 Overrides the default table name to moniker translation. Can be either
439 a hashref of table keys and moniker values, or a coderef for a translator
440 function taking a single scalar table name argument and returning
441 a scalar moniker. If the hash entry does not exist, or the function
442 returns a false value, the code falls back to default behavior
445 The default behavior is to split on case transition and non-alphanumeric
446 boundaries, singularize the resulting phrase, then join the titlecased words
449 Table Name | Moniker Name
450 ---------------------------------
452 luser_group | LuserGroup
453 luser-opts | LuserOpt
454 stations_visited | StationVisited
455 routeChange | RouteChange
457 =head2 col_accessor_map
459 Same as moniker_map, but for column accessor names. If a coderef is
460 passed, the code is called with arguments of
462 the name of the column in the underlying database,
463 default accessor name that DBICSL would ordinarily give this column,
465 table_class => name of the DBIC class we are building,
466 table_moniker => calculated moniker for this table (after moniker_map if present),
467 table_name => name of the database table,
468 full_table_name => schema-qualified name of the database table (RDBMS specific),
469 schema_class => name of the schema class we are building,
470 column_info => hashref of column info (data_type, is_nullable, etc),
475 Similar in idea to moniker_map, but different in the details. It can be
476 a hashref or a code ref.
478 If it is a hashref, keys can be either the default relationship name, or the
479 moniker. The keys that are the default relationship name should map to the
480 name you want to change the relationship to. Keys that are monikers should map
481 to hashes mapping relationship names to their translation. You can do both at
482 once, and the more specific moniker version will be picked up first. So, for
483 instance, you could have
492 and relationships that would have been named C<bar> will now be named C<baz>
493 except that in the table whose moniker is C<Foo> it will be named C<blat>.
495 If it is a coderef, the argument passed will be a hashref of this form:
498 name => default relationship name,
499 type => the relationship type eg: C<has_many>,
500 local_class => name of the DBIC class we are building,
501 local_moniker => moniker of the DBIC class we are building,
502 local_columns => columns in this table in the relationship,
503 remote_class => name of the DBIC class we are related to,
504 remote_moniker => moniker of the DBIC class we are related to,
505 remote_columns => columns in the other table in the relationship,
508 DBICSL will try to use the value returned as the relationship name.
510 =head2 inflect_plural
512 Just like L</moniker_map> above (can be hash/code-ref, falls back to default
513 if hash key does not exist or coderef returns false), but acts as a map
514 for pluralizing relationship names. The default behavior is to utilize
515 L<Lingua::EN::Inflect::Phrase/to_PL>.
517 =head2 inflect_singular
519 As L</inflect_plural> above, but for singularizing relationship names.
520 Default behavior is to utilize L<Lingua::EN::Inflect::Phrase/to_S>.
522 =head2 schema_base_class
524 Base class for your schema classes. Defaults to 'DBIx::Class::Schema'.
526 =head2 result_base_class
528 Base class for your table classes (aka result classes). Defaults to
531 =head2 additional_base_classes
533 List of additional base classes all of your table classes will use.
535 =head2 left_base_classes
537 List of additional base classes all of your table classes will use
538 that need to be leftmost.
540 =head2 additional_classes
542 List of additional classes which all of your table classes will use.
544 =head2 schema_components
546 List of components to load into the Schema class.
550 List of additional components to be loaded into all of your Result
551 classes. A good example would be
552 L<InflateColumn::DateTime|DBIx::Class::InflateColumn::DateTime>
554 =head2 result_components_map
556 A hashref of moniker keys and component values. Unlike L</components>, which
557 loads the given components into every Result class, this option allows you to
558 load certain components for specified Result classes. For example:
560 result_components_map => {
561 StationVisited => '+YourApp::Schema::Component::StationVisited',
563 '+YourApp::Schema::Component::RouteChange',
564 'InflateColumn::DateTime',
568 You may use this in conjunction with L</components>.
572 List of L<Moose> roles to be applied to all of your Result classes.
574 =head2 result_roles_map
576 A hashref of moniker keys and role values. Unlike L</result_roles>, which
577 applies the given roles to every Result class, this option allows you to apply
578 certain roles for specified Result classes. For example:
580 result_roles_map => {
582 'YourApp::Role::Building',
583 'YourApp::Role::Destination',
585 RouteChange => 'YourApp::Role::TripEvent',
588 You may use this in conjunction with L</result_roles>.
590 =head2 use_namespaces
592 This is now the default, to go back to L<DBIx::Class::Schema/load_classes> pass
595 Generate result class names suitable for
596 L<DBIx::Class::Schema/load_namespaces> and call that instead of
597 L<DBIx::Class::Schema/load_classes>. When using this option you can also
598 specify any of the options for C<load_namespaces> (i.e. C<result_namespace>,
599 C<resultset_namespace>, C<default_resultset_class>), and they will be added
600 to the call (and the generated result class names adjusted appropriately).
602 =head2 dump_directory
604 The value of this option is a perl libdir pathname. Within
605 that directory this module will create a baseline manual
606 L<DBIx::Class::Schema> module set, based on what it creates at runtime.
608 The created schema class will have the same classname as the one on
609 which you are setting this option (and the ResultSource classes will be
610 based on this name as well).
612 Normally you wouldn't hard-code this setting in your schema class, as it
613 is meant for one-time manual usage.
615 See L<DBIx::Class::Schema::Loader/dump_to_dir> for examples of the
616 recommended way to access this functionality.
618 =head2 dump_overwrite
620 Deprecated. See L</really_erase_my_files> below, which does *not* mean
621 the same thing as the old C<dump_overwrite> setting from previous releases.
623 =head2 really_erase_my_files
625 Default false. If true, Loader will unconditionally delete any existing
626 files before creating the new ones from scratch when dumping a schema to disk.
628 The default behavior is instead to only replace the top portion of the
629 file, up to and including the final stanza which contains
630 C<# DO NOT MODIFY THE FIRST PART OF THIS FILE>
631 leaving any customizations you placed after that as they were.
633 When C<really_erase_my_files> is not set, if the output file already exists,
634 but the aforementioned final stanza is not found, or the checksum
635 contained there does not match the generated contents, Loader will
636 croak and not touch the file.
638 You should really be using version control on your schema classes (and all
639 of the rest of your code for that matter). Don't blame me if a bug in this
640 code wipes something out when it shouldn't have, you've been warned.
642 =head2 overwrite_modifications
644 Default false. If false, when updating existing files, Loader will
645 refuse to modify any Loader-generated code that has been modified
646 since its last run (as determined by the checksum Loader put in its
649 If true, Loader will discard any manual modifications that have been
650 made to Loader-generated code.
652 Again, you should be using version control on your schema classes. Be
653 careful with this option.
655 =head2 custom_column_info
657 Hook for adding extra attributes to the
658 L<column_info|DBIx::Class::ResultSource/column_info> for a column.
660 Must be a coderef that returns a hashref with the extra attributes.
662 Receives the table name, column name and column_info.
666 custom_column_info => sub {
667 my ($table_name, $column_name, $column_info) = @_;
669 if ($column_name eq 'dog' && $column_info->{default_value} eq 'snoopy') {
670 return { is_snoopy => 1 };
674 This attribute can also be used to set C<inflate_datetime> on a non-datetime
675 column so it also receives the L</datetime_timezone> and/or L</datetime_locale>.
677 =head2 datetime_timezone
679 Sets the timezone attribute for L<DBIx::Class::InflateColumn::DateTime> for all
680 columns with the DATE/DATETIME/TIMESTAMP data_types.
682 =head2 datetime_locale
684 Sets the locale attribute for L<DBIx::Class::InflateColumn::DateTime> for all
685 columns with the DATE/DATETIME/TIMESTAMP data_types.
687 =head2 datetime_undef_if_invalid
689 Pass a C<0> for this option when using MySQL if you B<DON'T> want C<<
690 datetime_undef_if_invalid => 1 >> in your column info for DATE, DATETIME and
693 The default is recommended to deal with data such as C<00/00/00> which
694 sometimes ends up in such columns in MySQL.
698 File in Perl format, which should return a HASH reference, from which to read
703 Usually column names are lowercased, to make them easier to work with in
704 L<DBIx::Class>. This option lets you turn this behavior off, if the driver
707 Drivers for case sensitive databases like Sybase ASE or MSSQL with a
708 case-sensitive collation will turn this option on unconditionally.
710 Currently the drivers for SQLite, mysql, MSSQL and Firebird/InterBase support
713 =head2 qualify_objects
715 Set to true to prepend the L</db_schema> to table names for C<<
716 __PACKAGE__->table >> calls, and to some other things like Oracle sequences.
720 Creates Schema and Result classes that use L<Moose>, L<MooseX::NonMoose> and
721 L<namespace::autoclean>. The default content after the md5 sum also makes the
724 It is safe to upgrade your existing Schema to this option.
726 =head2 col_collision_map
728 This option controls how accessors for column names which collide with perl
729 methods are named. See L</COLUMN ACCESSOR COLLISIONS> for more information.
731 This option takes either a single L<sprintf|perlfunc/sprintf> format or a hashref of
732 strings which are compiled to regular expressions that map to
733 L<sprintf|perlfunc/sprintf> formats.
737 col_collision_map => 'column_%s'
739 col_collision_map => { '(.*)' => 'column_%s' }
741 col_collision_map => { '(foo).*(bar)' => 'column_%s_%s' }
743 =head2 rel_collision_map
745 Works just like L</col_collision_map>, but for relationship names/accessors
746 rather than column names/accessors.
748 The default is to just append C<_rel> to the relationship name, see
749 L</RELATIONSHIP NAME COLLISIONS>.
751 =head2 uniq_to_primary
753 Automatically promotes the largest unique constraints with non-nullable columns
754 on tables to primary keys, assuming there is only one largest unique
757 =head2 filter_generated_code
759 An optional hook that lets you filter the generated text for various classes
760 through a function that change it in any way that you want. The function will
761 receive the type of file, C<schema> or C<result>, class and code; and returns
762 the new code to use instead. For instance you could add custom comments, or do
763 anything else that you want.
765 The option can also be set to a string, which is then used as a filter program,
768 If this exists but fails to return text matching C</\bpackage\b/>, no file will
771 filter_generated_code => sub {
772 my ($type, $class, $text) = @_;
779 None of these methods are intended for direct invocation by regular
780 users of L<DBIx::Class::Schema::Loader>. Some are proxied via
781 L<DBIx::Class::Schema::Loader>.
785 # ensure that a peice of object data is a valid arrayref, creating
786 # an empty one or encapsulating whatever's there.
787 sub _ensure_arrayref {
792 $self->{$_} = [ $self->{$_} ]
793 unless ref $self->{$_} eq 'ARRAY';
799 Constructor for L<DBIx::Class::Schema::Loader::Base>, used internally
800 by L<DBIx::Class::Schema::Loader>.
805 my ( $class, %args ) = @_;
807 if (exists $args{column_accessor_map}) {
808 $args{col_accessor_map} = delete $args{column_accessor_map};
811 my $self = { %args };
813 # don't lose undef options
814 for (values %$self) {
815 $_ = 0 unless defined $_;
818 bless $self => $class;
820 if (my $config_file = $self->config_file) {
821 my $config_opts = do $config_file;
823 croak "Error reading config from $config_file: $@" if $@;
825 croak "Config file $config_file must be a hashref" unless ref($config_opts) eq 'HASH';
827 while (my ($k, $v) = each %$config_opts) {
828 $self->{$k} = $v unless exists $self->{$k};
832 if (defined $self->{result_component_map}) {
833 if (defined $self->result_components_map) {
834 croak "Specify only one of result_components_map or result_component_map";
836 $self->result_components_map($self->{result_component_map})
839 if (defined $self->{result_role_map}) {
840 if (defined $self->result_roles_map) {
841 croak "Specify only one of result_roles_map or result_role_map";
843 $self->result_roles_map($self->{result_role_map})
846 croak "the result_roles and result_roles_map options may only be used in conjunction with use_moose=1"
847 if ((not defined $self->use_moose) || (not $self->use_moose))
848 && ((defined $self->result_roles) || (defined $self->result_roles_map));
850 $self->_ensure_arrayref(qw/schema_components
852 additional_base_classes
858 $self->_validate_class_args;
860 croak "result_components_map must be a hash"
861 if defined $self->result_components_map
862 && ref $self->result_components_map ne 'HASH';
864 if ($self->result_components_map) {
865 my %rc_map = %{ $self->result_components_map };
866 foreach my $moniker (keys %rc_map) {
867 $rc_map{$moniker} = [ $rc_map{$moniker} ] unless ref $rc_map{$moniker};
869 $self->result_components_map(\%rc_map);
872 $self->result_components_map({});
874 $self->_validate_result_components_map;
876 croak "result_roles_map must be a hash"
877 if defined $self->result_roles_map
878 && ref $self->result_roles_map ne 'HASH';
880 if ($self->result_roles_map) {
881 my %rr_map = %{ $self->result_roles_map };
882 foreach my $moniker (keys %rr_map) {
883 $rr_map{$moniker} = [ $rr_map{$moniker} ] unless ref $rr_map{$moniker};
885 $self->result_roles_map(\%rr_map);
887 $self->result_roles_map({});
889 $self->_validate_result_roles_map;
891 if ($self->use_moose) {
892 if (not DBIx::Class::Schema::Loader::Optional::Dependencies->req_ok_for('use_moose')) {
893 die sprintf "You must install the following CPAN modules to enable the use_moose option: %s.\n",
894 DBIx::Class::Schema::Loader::Optional::Dependencies->req_missing_for('use_moose');
898 $self->{_tables} = {};
899 $self->{monikers} = {};
900 $self->{moniker_to_table} = {};
901 $self->{class_to_table} = {};
902 $self->{classes} = {};
903 $self->{_upgrading_classes} = {};
905 $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
906 $self->{schema} ||= $self->{schema_class};
907 $self->{table_comments_table} ||= 'table_comments';
908 $self->{column_comments_table} ||= 'column_comments';
910 croak "dump_overwrite is deprecated. Please read the"
911 . " DBIx::Class::Schema::Loader::Base documentation"
912 if $self->{dump_overwrite};
914 $self->{dynamic} = ! $self->{dump_directory};
915 $self->{temp_directory} ||= File::Temp::tempdir( 'dbicXXXX',
920 $self->{dump_directory} ||= $self->{temp_directory};
922 $self->real_dump_directory($self->{dump_directory});
924 $self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
925 $self->schema_version_to_dump($DBIx::Class::Schema::Loader::VERSION);
927 if (not defined $self->naming) {
928 $self->naming_set(0);
931 $self->naming_set(1);
934 if ((not ref $self->naming) && defined $self->naming) {
935 my $naming_ver = $self->naming;
937 relationships => $naming_ver,
938 monikers => $naming_ver,
939 column_accessors => $naming_ver,
944 for (values %{ $self->naming }) {
945 $_ = $CURRENT_V if $_ eq 'current';
948 $self->{naming} ||= {};
950 if ($self->custom_column_info && ref $self->custom_column_info ne 'CODE') {
951 croak 'custom_column_info must be a CODE ref';
954 $self->_check_back_compat;
956 $self->use_namespaces(1) unless defined $self->use_namespaces;
957 $self->generate_pod(1) unless defined $self->generate_pod;
958 $self->pod_comment_mode('auto') unless defined $self->pod_comment_mode;
959 $self->pod_comment_spillover_length(60) unless defined $self->pod_comment_spillover_length;
961 if (my $col_collision_map = $self->col_collision_map) {
962 if (my $reftype = ref $col_collision_map) {
963 if ($reftype ne 'HASH') {
964 croak "Invalid type $reftype for option 'col_collision_map'";
968 $self->col_collision_map({ '(.*)' => $col_collision_map });
972 if (my $rel_collision_map = $self->rel_collision_map) {
973 if (my $reftype = ref $rel_collision_map) {
974 if ($reftype ne 'HASH') {
975 croak "Invalid type $reftype for option 'rel_collision_map'";
979 $self->rel_collision_map({ '(.*)' => $rel_collision_map });
983 if (defined(my $rel_name_map = $self->rel_name_map)) {
984 my $reftype = ref $rel_name_map;
985 if ($reftype ne 'HASH' && $reftype ne 'CODE') {
986 croak "Invalid type $reftype for option 'rel_name_map', must be HASH or CODE";
990 if (defined(my $filter = $self->filter_generated_code)) {
991 my $reftype = ref $filter;
992 if ($reftype && $reftype ne 'CODE') {
993 croak "Invalid type $reftype for option 'filter_generated_code, must be a scalar or a CODE reference";
997 if (defined $self->db_schema) {
998 if (ref $self->db_schema eq 'ARRAY') {
999 if (@{ $self->db_schema } > 1) {
1000 $self->{qualify_objects} = 1;
1002 elsif (@{ $self->db_schema } == 0) {
1003 $self->{db_schema} = undef;
1006 elsif (not ref $self->db_schema) {
1007 if ($self->db_schema eq '%') {
1008 $self->{qualify_objects} = 1;
1011 $self->{db_schema} = [ $self->db_schema ];
1015 if (not $self->moniker_parts) {
1016 $self->moniker_parts(['name']);
1019 if (not ref $self->moniker_parts) {
1020 $self->moniker_parts([ $self->moniker_parts ]);
1022 if (ref $self->moniker_parts ne 'ARRAY') {
1023 croak 'moniker_parts must be an arrayref';
1025 if ((firstidx { $_ eq 'name' } @{ $self->moniker_parts }) == -1) {
1026 croak "moniker_parts option *must* contain 'name'";
1033 sub _check_back_compat {
1036 # dynamic schemas will always be in 0.04006 mode, unless overridden
1037 if ($self->dynamic) {
1038 # just in case, though no one is likely to dump a dynamic schema
1039 $self->schema_version_to_dump('0.04006');
1041 if (not $self->naming_set) {
1042 warn <<EOF unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
1044 Dynamic schema detected, will run in 0.04006 mode.
1046 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
1047 to disable this warning.
1049 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
1054 $self->_upgrading_from('v4');
1057 if ((not defined $self->use_namespaces) && ($self->naming_set)) {
1058 $self->use_namespaces(1);
1061 $self->naming->{relationships} ||= 'v4';
1062 $self->naming->{monikers} ||= 'v4';
1064 if ($self->use_namespaces) {
1065 $self->_upgrading_from_load_classes(1);
1068 $self->use_namespaces(0);
1074 # otherwise check if we need backcompat mode for a static schema
1075 my $filename = $self->get_dump_filename($self->schema_class);
1076 return unless -e $filename;
1078 my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom) =
1079 $self->_parse_generated_file($filename);
1081 return unless $old_ver;
1083 # determine if the existing schema was dumped with use_moose => 1
1084 if (! defined $self->use_moose) {
1085 $self->{use_moose} = 1 if $old_gen =~ /^ (?!\s*\#) use \s+ Moose/xm;
1088 my $load_classes = ($old_gen =~ /^__PACKAGE__->load_classes;/m) ? 1 : 0;
1090 my $result_namespace = do { ($old_gen =~ /result_namespace => (.+)/) ? $1 : '' };
1091 my $ds = eval $result_namespace;
1093 Could not eval expression '$result_namespace' for result_namespace from
1096 $result_namespace = $ds || '';
1098 if ($load_classes && (not defined $self->use_namespaces)) {
1099 warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
1101 'load_classes;' static schema detected, turning off 'use_namespaces'.
1103 Set the 'use_namespaces' attribute or the SCHEMA_LOADER_BACKCOMPAT environment
1104 variable to disable this warning.
1106 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 for more
1109 $self->use_namespaces(0);
1111 elsif ($load_classes && $self->use_namespaces) {
1112 $self->_upgrading_from_load_classes(1);
1114 elsif ((not $load_classes) && defined $self->use_namespaces && ! $self->use_namespaces) {
1115 $self->_downgrading_to_load_classes(
1116 $result_namespace || 'Result'
1119 elsif ((not defined $self->use_namespaces) || $self->use_namespaces) {
1120 if (not $self->result_namespace) {
1121 $self->result_namespace($result_namespace || 'Result');
1123 elsif ($result_namespace ne $self->result_namespace) {
1124 $self->_rewriting_result_namespace(
1125 $result_namespace || 'Result'
1130 # XXX when we go past .0 this will need fixing
1131 my ($v) = $old_ver =~ /([1-9])/;
1134 return if ($v eq $CURRENT_V || $old_ver =~ /^0\.\d\d999/);
1136 if (not %{ $self->naming }) {
1137 warn <<"EOF" unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
1139 Version $old_ver static schema detected, turning on backcompat mode.
1141 Set the 'naming' attribute or the SCHEMA_LOADER_BACKCOMPAT environment variable
1142 to disable this warning.
1144 See: 'naming' in perldoc DBIx::Class::Schema::Loader::Base .
1146 See perldoc DBIx::Class::Schema::Loader::Manual::UpgradingFromV4 if upgrading
1147 from version 0.04006.
1150 $self->naming->{relationships} ||= $v;
1151 $self->naming->{monikers} ||= $v;
1152 $self->naming->{column_accessors} ||= $v;
1154 $self->schema_version_to_dump($old_ver);
1157 $self->_upgrading_from($v);
1161 sub _validate_class_args {
1164 foreach my $k (@CLASS_ARGS) {
1165 next unless $self->$k;
1167 my @classes = ref $self->$k eq 'ARRAY' ? @{ $self->$k } : $self->$k;
1168 $self->_validate_classes($k, \@classes);
1172 sub _validate_result_components_map {
1175 foreach my $classes (values %{ $self->result_components_map }) {
1176 $self->_validate_classes('result_components_map', $classes);
1180 sub _validate_result_roles_map {
1183 foreach my $classes (values %{ $self->result_roles_map }) {
1184 $self->_validate_classes('result_roles_map', $classes);
1188 sub _validate_classes {
1191 my $classes = shift;
1193 # make a copy to not destroy original
1194 my @classes = @$classes;
1196 foreach my $c (@classes) {
1197 # components default to being under the DBIx::Class namespace unless they
1198 # are preceeded with a '+'
1199 if ( $key =~ m/component/ && $c !~ s/^\+// ) {
1200 $c = 'DBIx::Class::' . $c;
1203 # 1 == installed, 0 == not installed, undef == invalid classname
1204 my $installed = Class::Inspector->installed($c);
1205 if ( defined($installed) ) {
1206 if ( $installed == 0 ) {
1207 croak qq/$c, as specified in the loader option "$key", is not installed/;
1210 croak qq/$c, as specified in the loader option "$key", is an invalid class name/;
1216 sub _find_file_in_inc {
1217 my ($self, $file) = @_;
1219 foreach my $prefix (@INC) {
1220 my $fullpath = File::Spec->catfile($prefix, $file);
1221 return $fullpath if -f $fullpath
1222 # abs_path throws on Windows for nonexistant files
1223 and (try { Cwd::abs_path($fullpath) }) ne
1224 ((try { Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) }) || '');
1230 sub _find_class_in_inc {
1231 my ($self, $class) = @_;
1233 return $self->_find_file_in_inc(class_path($class));
1239 return $self->_upgrading_from
1240 || $self->_upgrading_from_load_classes
1241 || $self->_downgrading_to_load_classes
1242 || $self->_rewriting_result_namespace
1246 sub _rewrite_old_classnames {
1247 my ($self, $code) = @_;
1249 return $code unless $self->_rewriting;
1251 my %old_classes = reverse %{ $self->_upgrading_classes };
1253 my $re = join '|', keys %old_classes;
1254 $re = qr/\b($re)\b/;
1256 $code =~ s/$re/$old_classes{$1} || $1/eg;
1261 sub _load_external {
1262 my ($self, $class) = @_;
1264 return if $self->{skip_load_external};
1266 # so that we don't load our own classes, under any circumstances
1267 local *INC = [ grep $_ ne $self->dump_directory, @INC ];
1269 my $real_inc_path = $self->_find_class_in_inc($class);
1271 my $old_class = $self->_upgrading_classes->{$class}
1272 if $self->_rewriting;
1274 my $old_real_inc_path = $self->_find_class_in_inc($old_class)
1275 if $old_class && $old_class ne $class;
1277 return unless $real_inc_path || $old_real_inc_path;
1279 if ($real_inc_path) {
1280 # If we make it to here, we loaded an external definition
1281 warn qq/# Loaded external class definition for '$class'\n/
1284 my $code = $self->_rewrite_old_classnames(slurp_file $real_inc_path);
1286 if ($self->dynamic) { # load the class too
1287 eval_package_without_redefine_warnings($class, $code);
1290 $self->_ext_stmt($class,
1291 qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
1292 .qq|# They are now part of the custom portion of this file\n|
1293 .qq|# for you to hand-edit. If you do not either delete\n|
1294 .qq|# this section or remove that file from \@INC, this section\n|
1295 .qq|# will be repeated redundantly when you re-create this\n|
1296 .qq|# file again via Loader! See skip_load_external to disable\n|
1297 .qq|# this feature.\n|
1300 $self->_ext_stmt($class, $code);
1301 $self->_ext_stmt($class,
1302 qq|# End of lines loaded from '$real_inc_path' |
1306 if ($old_real_inc_path) {
1307 my $code = slurp_file $old_real_inc_path;
1309 $self->_ext_stmt($class, <<"EOF");
1311 # These lines were loaded from '$old_real_inc_path',
1312 # based on the Result class name that would have been created by an older
1313 # version of the Loader. For a static schema, this happens only once during
1314 # upgrade. See skip_load_external to disable this feature.
1317 $code = $self->_rewrite_old_classnames($code);
1319 if ($self->dynamic) {
1322 Detected external content in '$old_real_inc_path', a class name that would have
1323 been used by an older version of the Loader.
1325 * PLEASE RENAME THIS CLASS: from '$old_class' to '$class', as that is the
1326 new name of the Result.
1328 eval_package_without_redefine_warnings($class, $code);
1332 $self->_ext_stmt($class, $code);
1333 $self->_ext_stmt($class,
1334 qq|# End of lines loaded from '$old_real_inc_path' |
1341 Does the actual schema-construction work.
1348 $self->_load_tables(
1349 $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude })
1357 Rescan the database for changes. Returns a list of the newly added table
1360 The schema argument should be the schema class or object to be affected. It
1361 should probably be derived from the original schema_class used during L</load>.
1366 my ($self, $schema) = @_;
1368 $self->{schema} = $schema;
1369 $self->_relbuilder->{schema} = $schema;
1372 my @current = $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude });
1374 foreach my $table (@current) {
1375 if(!exists $self->_tables->{$table->sql_name}) {
1376 push(@created, $table);
1381 @current{map $_->sql_name, @current} = ();
1382 foreach my $table (values %{ $self->_tables }) {
1383 if (not exists $current{$table->sql_name}) {
1384 $self->_remove_table($table);
1388 delete @$self{qw/_dump_storage _relations_started _uniqs_started/};
1390 my $loaded = $self->_load_tables(@current);
1392 foreach my $table (@created) {
1393 $self->monikers->{$table->sql_name} = $self->_table2moniker($table);
1396 return map { $self->monikers->{$_->sql_name} } @created;
1402 return if $self->{skip_relationships};
1404 return $self->{relbuilder} ||= do {
1405 my $relbuilder_suff =
1412 ->{$self->naming->{relationships}||$CURRENT_V} || '';
1414 my $relbuilder_class = 'DBIx::Class::Schema::Loader::RelBuilder'.$relbuilder_suff;
1415 $self->ensure_class_loaded($relbuilder_class);
1416 $relbuilder_class->new($self);
1421 my ($self, @tables) = @_;
1423 # Save the new tables to the tables list
1425 $self->_tables->{$_->sql_name} = $_;
1428 $self->_make_src_class($_) for @tables;
1430 # sanity-check for moniker clashes
1431 my $inverse_moniker_idx;
1432 foreach my $table (values %{ $self->_tables }) {
1433 push @{ $inverse_moniker_idx->{$self->monikers->{$table->sql_name}} }, $table;
1437 foreach my $moniker (keys %$inverse_moniker_idx) {
1438 my $tables = $inverse_moniker_idx->{$moniker};
1440 push @clashes, sprintf ("tables %s reduced to the same source moniker '%s'",
1441 join (', ', map $_->sql_name, @$tables),
1448 die 'Unable to load schema - chosen moniker/class naming style results in moniker clashes. '
1449 . 'In multi db_schema configurations you may need to set moniker_parts, '
1450 . 'otherwise change the naming style, or supply an explicit moniker_map: '
1451 . join ('; ', @clashes)
1456 $self->_setup_src_meta($_) for @tables;
1458 if(!$self->skip_relationships) {
1459 # The relationship loader needs a working schema
1460 local $self->{quiet} = 1;
1461 local $self->{dump_directory} = $self->{temp_directory};
1462 $self->_reload_classes(\@tables);
1463 $self->_load_relationships(\@tables);
1465 # Remove that temp dir from INC so it doesn't get reloaded
1466 @INC = grep $_ ne $self->dump_directory, @INC;
1469 $self->_load_roles($_) for @tables;
1471 $self->_load_external($_)
1472 for map { $self->classes->{$_->sql_name} } @tables;
1474 # Reload without unloading first to preserve any symbols from external
1476 $self->_reload_classes(\@tables, { unload => 0 });
1478 # Drop temporary cache
1479 delete $self->{_cache};
1484 sub _reload_classes {
1485 my ($self, $tables, $opts) = @_;
1487 my @tables = @$tables;
1489 my $unload = $opts->{unload};
1490 $unload = 1 unless defined $unload;
1492 # so that we don't repeat custom sections
1493 @INC = grep $_ ne $self->dump_directory, @INC;
1495 $self->_dump_to_dir(map { $self->classes->{$_->sql_name} } @tables);
1497 unshift @INC, $self->dump_directory;
1500 my %have_source = map { $_ => $self->schema->source($_) }
1501 $self->schema->sources;
1503 for my $table (@tables) {
1504 my $moniker = $self->monikers->{$table->sql_name};
1505 my $class = $self->classes->{$table->sql_name};
1508 no warnings 'redefine';
1509 local *Class::C3::reinitialize = sub {}; # to speed things up, reinitialized below
1512 if (my $mc = $self->_moose_metaclass($class)) {
1515 Class::Unload->unload($class) if $unload;
1516 my ($source, $resultset_class);
1518 ($source = $have_source{$moniker})
1519 && ($resultset_class = $source->resultset_class)
1520 && ($resultset_class ne 'DBIx::Class::ResultSet')
1522 my $has_file = Class::Inspector->loaded_filename($resultset_class);
1523 if (my $mc = $self->_moose_metaclass($resultset_class)) {
1526 Class::Unload->unload($resultset_class) if $unload;
1527 $self->_reload_class($resultset_class) if $has_file;
1529 $self->_reload_class($class);
1531 push @to_register, [$moniker, $class];
1534 Class::C3->reinitialize;
1535 for (@to_register) {
1536 $self->schema->register_class(@$_);
1540 sub _moose_metaclass {
1541 return undef unless $INC{'Class/MOP.pm'}; # if CMOP is not loaded the class could not have loaded in the 1st place
1545 my $mc = try { Class::MOP::class_of($class) }
1548 return $mc->isa('Moose::Meta::Class') ? $mc : undef;
1551 # We use this instead of ensure_class_loaded when there are package symbols we
1554 my ($self, $class) = @_;
1556 delete $INC{ +class_path($class) };
1559 eval_package_without_redefine_warnings ($class, "require $class");
1562 my $source = slurp_file $self->_get_dump_filename($class);
1563 die "Failed to reload class $class: $_.\n\nCLASS SOURCE:\n\n$source";
1567 sub _get_dump_filename {
1568 my ($self, $class) = (@_);
1570 $class =~ s{::}{/}g;
1571 return $self->dump_directory . q{/} . $class . q{.pm};
1574 =head2 get_dump_filename
1578 Returns the full path to the file for a class that the class has been or will
1579 be dumped to. This is a file in a temp dir for a dynamic schema.
1583 sub get_dump_filename {
1584 my ($self, $class) = (@_);
1586 local $self->{dump_directory} = $self->real_dump_directory;
1588 return $self->_get_dump_filename($class);
1591 sub _ensure_dump_subdirs {
1592 my ($self, $class) = (@_);
1594 my @name_parts = split(/::/, $class);
1595 pop @name_parts; # we don't care about the very last element,
1596 # which is a filename
1598 my $dir = $self->dump_directory;
1601 mkdir($dir) or croak "mkdir('$dir') failed: $!";
1603 last if !@name_parts;
1604 $dir = File::Spec->catdir($dir, shift @name_parts);
1609 my ($self, @classes) = @_;
1611 my $schema_class = $self->schema_class;
1612 my $schema_base_class = $self->schema_base_class || 'DBIx::Class::Schema';
1614 my $target_dir = $self->dump_directory;
1615 warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
1616 unless $self->dynamic or $self->quiet;
1620 . qq|package $schema_class;\n\n|
1621 . qq|# Created by DBIx::Class::Schema::Loader\n|
1622 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
1624 if ($self->use_moose) {
1625 $schema_text.= qq|use Moose;\nuse namespace::autoclean;\nextends '$schema_base_class';\n\n|;
1628 $schema_text .= qq|use strict;\nuse warnings;\n\nuse base '$schema_base_class';\n\n|;
1631 my @schema_components = @{ $self->schema_components || [] };
1633 if (@schema_components) {
1634 my $schema_components = dump @schema_components;
1635 $schema_components = "($schema_components)" if @schema_components == 1;
1637 $schema_text .= "__PACKAGE__->load_components${schema_components};\n\n";
1640 if ($self->use_namespaces) {
1641 $schema_text .= qq|__PACKAGE__->load_namespaces|;
1642 my $namespace_options;
1644 my @attr = qw/resultset_namespace default_resultset_class/;
1646 unshift @attr, 'result_namespace' unless (not $self->result_namespace) || $self->result_namespace eq 'Result';
1648 for my $attr (@attr) {
1650 my $code = dumper_squashed $self->$attr;
1651 $namespace_options .= qq| $attr => $code,\n|
1654 $schema_text .= qq|(\n$namespace_options)| if $namespace_options;
1655 $schema_text .= qq|;\n|;
1658 $schema_text .= qq|__PACKAGE__->load_classes;\n|;
1662 local $self->{version_to_dump} = $self->schema_version_to_dump;
1663 $self->_write_classfile($schema_class, $schema_text, 1);
1666 my $result_base_class = $self->result_base_class || 'DBIx::Class::Core';
1668 foreach my $src_class (@classes) {
1671 . qq|package $src_class;\n\n|
1672 . qq|# Created by DBIx::Class::Schema::Loader\n|
1673 . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
1675 $src_text .= $self->_make_pod_heading($src_class);
1677 $src_text .= qq|use strict;\nuse warnings;\n\n|;
1679 $src_text .= $self->_base_class_pod($result_base_class)
1680 unless $result_base_class eq 'DBIx::Class::Core';
1682 if ($self->use_moose) {
1683 $src_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;|;
1685 # these options 'use base' which is compile time
1686 if (@{ $self->left_base_classes } || @{ $self->additional_base_classes }) {
1687 $src_text .= qq|\nBEGIN { extends '$result_base_class' }\n|;
1690 $src_text .= qq|\nextends '$result_base_class';\n|;
1694 $src_text .= qq|use base '$result_base_class';\n|;
1697 $self->_write_classfile($src_class, $src_text);
1700 # remove Result dir if downgrading from use_namespaces, and there are no
1702 if (my $result_ns = $self->_downgrading_to_load_classes
1703 || $self->_rewriting_result_namespace) {
1704 my $result_namespace = $self->_result_namespace(
1709 (my $result_dir = $result_namespace) =~ s{::}{/}g;
1710 $result_dir = $self->dump_directory . '/' . $result_dir;
1712 unless (my @files = glob "$result_dir/*") {
1717 warn "Schema dump completed.\n" unless $self->dynamic or $self->quiet;
1721 my ($self, $version, $ts) = @_;
1722 return qq|\n\n# Created by DBIx::Class::Schema::Loader|
1725 . qq|\n# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:|;
1728 sub _write_classfile {
1729 my ($self, $class, $text, $is_schema) = @_;
1731 my $filename = $self->_get_dump_filename($class);
1732 $self->_ensure_dump_subdirs($class);
1734 if (-f $filename && $self->really_erase_my_files) {
1735 warn "Deleting existing file '$filename' due to "
1736 . "'really_erase_my_files' setting\n" unless $self->quiet;
1740 my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom)
1741 = $self->_parse_generated_file($filename);
1743 if (! $old_gen && -f $filename) {
1744 croak "Cannot overwrite '$filename' without 'really_erase_my_files',"
1745 . " it does not appear to have been generated by Loader"
1748 my $custom_content = $old_custom || '';
1750 # prepend extra custom content from a *renamed* class (singularization effect)
1751 if (my $renamed_class = $self->_upgrading_classes->{$class}) {
1752 my $old_filename = $self->_get_dump_filename($renamed_class);
1754 if (-f $old_filename) {
1755 my $extra_custom = ($self->_parse_generated_file ($old_filename))[4];
1757 $extra_custom =~ s/\n\n# You can replace.*\n1;\n//;
1759 $custom_content = join ("\n", '', $extra_custom, $custom_content)
1762 unlink $old_filename;
1766 $custom_content ||= $self->_default_custom_content($is_schema);
1768 # If upgrading to use_moose=1 replace default custom content with default Moose custom content.
1769 # If there is already custom content, which does not have the Moose content, add it.
1770 if ($self->use_moose) {
1772 my $non_moose_custom_content = do {
1773 local $self->{use_moose} = 0;
1774 $self->_default_custom_content;
1777 if ($custom_content eq $non_moose_custom_content) {
1778 $custom_content = $self->_default_custom_content($is_schema);
1780 elsif ($custom_content !~ /\Q@{[$self->_default_moose_custom_content($is_schema)]}\E/) {
1781 $custom_content .= $self->_default_custom_content($is_schema);
1784 elsif (defined $self->use_moose && $old_gen) {
1785 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'
1786 if $old_gen =~ /use \s+ MooseX?\b/x;
1789 $custom_content = $self->_rewrite_old_classnames($custom_content);
1792 for @{$self->{_dump_storage}->{$class} || []};
1794 if ($self->filter_generated_code) {
1795 my $filter = $self->filter_generated_code;
1797 if (ref $filter eq 'CODE') {
1799 ($is_schema ? 'schema' : 'result'),
1805 my ($out, $in) = (gensym, gensym);
1807 my $pid = open2($out, $in, $filter)
1808 or croak "Could not open pipe to $filter: $!";
1814 $text = decode('UTF-8', do { local $/; <$out> });
1816 $text =~ s/$CR?$LF/\n/g;
1820 my $exit_code = $? >> 8;
1822 if ($exit_code != 0) {
1823 croak "filter '$filter' exited non-zero: $exit_code";
1826 if (not $text or not $text =~ /\bpackage\b/) {
1827 warn("$class skipped due to filter") if $self->debug;
1832 # Check and see if the dump is in fact different
1836 $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
1837 if (Digest::MD5::md5_base64(encode 'UTF-8', $compare_to) eq $old_md5) {
1838 return unless $self->_upgrading_from && $is_schema;
1842 $text .= $self->_sig_comment(
1843 $self->version_to_dump,
1844 POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
1847 open(my $fh, '>:encoding(UTF-8)', $filename)
1848 or croak "Cannot open '$filename' for writing: $!";
1850 # Write the top half and its MD5 sum
1851 print $fh $text . Digest::MD5::md5_base64(encode 'UTF-8', $text) . "\n";
1853 # Write out anything loaded via external partial class file in @INC
1855 for @{$self->{_ext_storage}->{$class} || []};
1857 # Write out any custom content the user has added
1858 print $fh $custom_content;
1861 or croak "Error closing '$filename': $!";
1864 sub _default_moose_custom_content {
1865 my ($self, $is_schema) = @_;
1867 if (not $is_schema) {
1868 return qq|\n__PACKAGE__->meta->make_immutable;|;
1871 return qq|\n__PACKAGE__->meta->make_immutable(inline_constructor => 0);|;
1874 sub _default_custom_content {
1875 my ($self, $is_schema) = @_;
1876 my $default = qq|\n\n# You can replace this text with custom|
1877 . qq| code or comments, and it will be preserved on regeneration|;
1878 if ($self->use_moose) {
1879 $default .= $self->_default_moose_custom_content($is_schema);
1881 $default .= qq|\n1;\n|;
1885 sub _parse_generated_file {
1886 my ($self, $fn) = @_;
1888 return unless -f $fn;
1890 open(my $fh, '<:encoding(UTF-8)', $fn)
1891 or croak "Cannot open '$fn' for reading: $!";
1894 qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\r?\n};
1896 my ($md5, $ts, $ver, $gen);
1902 # Pull out the version and timestamp from the line above
1903 ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)\r?\Z/m;
1906 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"
1907 if !$self->overwrite_modifications && Digest::MD5::md5_base64(encode 'UTF-8', $gen) ne $md5;
1916 my $custom = do { local $/; <$fh> }
1920 $custom =~ s/$CRLF|$LF/\n/g;
1924 return ($gen, $md5, $ver, $ts, $custom);
1932 warn "$target: use $_;" if $self->debug;
1933 $self->_raw_stmt($target, "use $_;");
1941 my $blist = join(q{ }, @_);
1943 return unless $blist;
1945 warn "$target: use base qw/$blist/;" if $self->debug;
1946 $self->_raw_stmt($target, "use base qw/$blist/;");
1953 my $rlist = join(q{, }, map { qq{'$_'} } @_);
1955 return unless $rlist;
1957 warn "$target: with $rlist;" if $self->debug;
1958 $self->_raw_stmt($target, "\nwith $rlist;");
1961 sub _result_namespace {
1962 my ($self, $schema_class, $ns) = @_;
1963 my @result_namespace;
1965 $ns = $ns->[0] if ref $ns;
1967 if ($ns =~ /^\+(.*)/) {
1968 # Fully qualified namespace
1969 @result_namespace = ($1)
1972 # Relative namespace
1973 @result_namespace = ($schema_class, $ns);
1976 return wantarray ? @result_namespace : join '::', @result_namespace;
1979 # Create class with applicable bases, setup monikers, etc
1980 sub _make_src_class {
1981 my ($self, $table) = @_;
1983 my $schema = $self->schema;
1984 my $schema_class = $self->schema_class;
1986 my $table_moniker = $self->_table2moniker($table);
1987 my @result_namespace = ($schema_class);
1988 if ($self->use_namespaces) {
1989 my $result_namespace = $self->result_namespace || 'Result';
1990 @result_namespace = $self->_result_namespace(
1995 my $table_class = join(q{::}, @result_namespace, $table_moniker);
1997 if ((my $upgrading_v = $self->_upgrading_from)
1998 || $self->_rewriting) {
1999 local $self->naming->{monikers} = $upgrading_v
2002 my @result_namespace = @result_namespace;
2003 if ($self->_upgrading_from_load_classes) {
2004 @result_namespace = ($schema_class);
2006 elsif (my $ns = $self->_downgrading_to_load_classes) {
2007 @result_namespace = $self->_result_namespace(
2012 elsif ($ns = $self->_rewriting_result_namespace) {
2013 @result_namespace = $self->_result_namespace(
2019 my $old_table_moniker = do {
2020 local $self->naming->{monikers} = $upgrading_v;
2021 $self->_table2moniker($table);
2024 my $old_class = join(q{::}, @result_namespace, $old_table_moniker);
2026 $self->_upgrading_classes->{$table_class} = $old_class
2027 unless $table_class eq $old_class;
2030 $self->classes->{$table->sql_name} = $table_class;
2031 $self->monikers->{$table->sql_name} = $table_moniker;
2032 $self->moniker_to_table->{$table_moniker} = $table;
2033 $self->class_to_table->{$table_class} = $table;
2035 $self->_pod_class_list($table_class, 'ADDITIONAL CLASSES USED', @{$self->additional_classes});
2037 $self->_use ($table_class, @{$self->additional_classes});
2039 $self->_pod_class_list($table_class, 'LEFT BASE CLASSES', @{$self->left_base_classes});
2041 $self->_inject($table_class, @{$self->left_base_classes});
2043 my @components = @{ $self->components || [] };
2045 push @components, @{ $self->result_components_map->{$table_moniker} }
2046 if exists $self->result_components_map->{$table_moniker};
2048 my @fq_components = @components;
2049 foreach my $component (@fq_components) {
2050 if ($component !~ s/^\+//) {
2051 $component = "DBIx::Class::$component";
2055 $self->_pod_class_list($table_class, 'COMPONENTS LOADED', @fq_components);
2057 $self->_dbic_stmt($table_class, 'load_components', @components) if @components;
2059 $self->_pod_class_list($table_class, 'ADDITIONAL BASE CLASSES', @{$self->additional_base_classes});
2061 $self->_inject($table_class, @{$self->additional_base_classes});
2064 sub _is_result_class_method {
2065 my ($self, $name, $table) = @_;
2067 my $table_moniker = $table ? $self->monikers->{$table->sql_name} : '';
2069 $self->_result_class_methods({})
2070 if not defined $self->_result_class_methods;
2072 if (not exists $self->_result_class_methods->{$table_moniker}) {
2073 my (@methods, %methods);
2074 my $base = $self->result_base_class || 'DBIx::Class::Core';
2076 my @components = @{ $self->components || [] };
2078 push @components, @{ $self->result_components_map->{$table_moniker} }
2079 if exists $self->result_components_map->{$table_moniker};
2081 for my $c (@components) {
2082 $c = $c =~ /^\+/ ? substr($c,1) : "DBIx::Class::$c";
2085 my @roles = @{ $self->result_roles || [] };
2087 push @roles, @{ $self->result_roles_map->{$table_moniker} }
2088 if exists $self->result_roles_map->{$table_moniker};
2090 for my $class ($base, @components,
2091 ($self->use_moose ? 'Moose::Object' : ()), @roles) {
2092 $self->ensure_class_loaded($class);
2094 push @methods, @{ Class::Inspector->methods($class) || [] };
2097 push @methods, @{ Class::Inspector->methods('UNIVERSAL') };
2099 @methods{@methods} = ();
2101 $self->_result_class_methods->{$table_moniker} = \%methods;
2103 my $result_methods = $self->_result_class_methods->{$table_moniker};
2105 return exists $result_methods->{$name};
2108 sub _resolve_col_accessor_collisions {
2109 my ($self, $table, $col_info) = @_;
2111 while (my ($col, $info) = each %$col_info) {
2112 my $accessor = $info->{accessor} || $col;
2114 next if $accessor eq 'id'; # special case (very common column)
2116 if ($self->_is_result_class_method($accessor, $table)) {
2119 if (my $map = $self->col_collision_map) {
2120 for my $re (keys %$map) {
2121 if (my @matches = $col =~ /$re/) {
2122 $info->{accessor} = sprintf $map->{$re}, @matches;
2130 Column '$col' in table '$table' collides with an inherited method.
2131 See "COLUMN ACCESSOR COLLISIONS" in perldoc DBIx::Class::Schema::Loader::Base .
2133 $info->{accessor} = undef;
2139 # use the same logic to run moniker_map, col_accessor_map
2141 my ( $self, $map, $default_code, $ident, @extra ) = @_;
2143 my $default_ident = $default_code->( $ident, @extra );
2145 if( $map && ref $map eq 'HASH' ) {
2146 $new_ident = $map->{ $ident };
2148 elsif( $map && ref $map eq 'CODE' ) {
2149 $new_ident = $map->( $ident, $default_ident, @extra );
2152 $new_ident ||= $default_ident;
2157 sub _default_column_accessor_name {
2158 my ( $self, $column_name ) = @_;
2160 my $accessor_name = $column_name;
2161 $accessor_name =~ s/\W+/_/g;
2163 if ((($self->naming->{column_accessors}||'') =~ /(\d+)/ && $1 < 7) || (not $self->preserve_case)) {
2164 # older naming just lc'd the col accessor and that's all.
2165 return lc $accessor_name;
2167 elsif (($self->naming->{column_accessors}||'') eq 'preserve') {
2168 return $accessor_name;
2171 return join '_', map lc, split_name $column_name;
2174 sub _make_column_accessor_name {
2175 my ($self, $column_name, $column_context_info ) = @_;
2177 my $accessor = $self->_run_user_map(
2178 $self->col_accessor_map,
2179 sub { $self->_default_column_accessor_name( shift ) },
2181 $column_context_info,
2187 # Set up metadata (cols, pks, etc)
2188 sub _setup_src_meta {
2189 my ($self, $table) = @_;
2191 my $schema = $self->schema;
2192 my $schema_class = $self->schema_class;
2194 my $table_class = $self->classes->{$table->sql_name};
2195 my $table_moniker = $self->monikers->{$table->sql_name};
2197 $self->_dbic_stmt($table_class, 'table', $table->dbic_name);
2199 my $cols = $self->_table_columns($table);
2200 my $col_info = $self->__columns_info_for($table);
2202 ### generate all the column accessor names
2203 while (my ($col, $info) = each %$col_info) {
2204 # hashref of other info that could be used by
2205 # user-defined accessor map functions
2207 table_class => $table_class,
2208 table_moniker => $table_moniker,
2209 table_name => $table,
2210 full_table_name => $table->dbic_name,
2211 schema_class => $schema_class,
2212 column_info => $info,
2215 $info->{accessor} = $self->_make_column_accessor_name( $col, $context );
2218 $self->_resolve_col_accessor_collisions($table, $col_info);
2220 # prune any redundant accessor names
2221 while (my ($col, $info) = each %$col_info) {
2222 no warnings 'uninitialized';
2223 delete $info->{accessor} if $info->{accessor} eq $col;
2226 my $fks = $self->_table_fk_info($table);
2228 foreach my $fkdef (@$fks) {
2229 for my $col (@{ $fkdef->{local_columns} }) {
2230 $col_info->{$col}{is_foreign_key} = 1;
2234 my $pks = $self->_table_pk_info($table) || [];
2236 my %uniq_tag; # used to eliminate duplicate uniqs
2238 $uniq_tag{ join("\0", @$pks) }++ if @$pks; # pk is a uniq
2240 my $uniqs = $self->_table_uniq_info($table) || [];
2243 foreach my $uniq (@$uniqs) {
2244 my ($name, $cols) = @$uniq;
2245 next if $uniq_tag{ join("\0", @$cols) }++; # skip duplicates
2246 push @uniqs, [$name, $cols];
2249 my @non_nullable_uniqs = grep {
2250 all { $col_info->{$_}{is_nullable} == 0 } @{ $_->[1] }
2253 if ($self->uniq_to_primary && (not @$pks) && @non_nullable_uniqs) {
2254 my @by_colnum = sort { $b->[0] <=> $a->[0] }
2255 map [ scalar @{ $_->[1] }, $_ ], @non_nullable_uniqs;
2257 if (not (@by_colnum > 1 && $by_colnum[0][0] == $by_colnum[1][0])) {
2258 my @keys = map $_->[1], @by_colnum;
2262 # remove the uniq from list
2263 @uniqs = grep { $_->[0] ne $pk->[0] } @uniqs;
2269 foreach my $pkcol (@$pks) {
2270 $col_info->{$pkcol}{is_nullable} = 0;
2276 map { $_, ($col_info->{$_}||{}) } @$cols
2279 $self->_dbic_stmt($table_class, 'set_primary_key', @$pks)
2282 # Sort unique constraints by constraint name for repeatable results (rels
2283 # are sorted as well elsewhere.)
2284 @uniqs = sort { $a->[0] cmp $b->[0] } @uniqs;
2286 foreach my $uniq (@uniqs) {
2287 my ($name, $cols) = @$uniq;
2288 $self->_dbic_stmt($table_class,'add_unique_constraint', $name, $cols);
2292 sub __columns_info_for {
2293 my ($self, $table) = @_;
2295 my $result = $self->_columns_info_for($table);
2297 while (my ($col, $info) = each %$result) {
2298 $info = { %$info, %{ $self->_custom_column_info ($table, $col, $info) } };
2299 $info = { %$info, %{ $self->_datetime_column_info($table, $col, $info) } };
2301 $result->{$col} = $info;
2309 Returns a sorted list of loaded tables, using the original database table
2317 return values %{$self->_tables};
2320 # Make a moniker from a table
2321 sub _default_table2moniker {
2322 my ($self, $table) = @_;
2324 my ($v) = ($self->naming->{monikers}||$CURRENT_V) =~ /^v(\d+)\z/;
2326 my @name_parts = map $table->$_, @{ $self->moniker_parts };
2328 my $name_idx = firstidx { $_ eq 'name' } @{ $self->moniker_parts };
2330 my $to_identifier = $self->naming->{force_ascii} ?
2331 \&String::ToIdentifier::EN::to_identifier
2332 : \&String::ToIdentifier::EN::Unicode::to_identifier;
2336 foreach my $i (0 .. $#name_parts) {
2337 my $part = $name_parts[$i];
2339 if ($i != $name_idx || $v > 7) {
2340 $part = $to_identifier->($part, '_');
2343 if ($i == $name_idx && $v == 5) {
2344 $part = Lingua::EN::Inflect::Number::to_S($part);
2347 my @part_parts = map lc, $v > 6 ? split_name $part : split /[\W_]+/, $part;
2349 if ($i == $name_idx && $v >= 6) {
2350 my $as_phrase = join ' ', @part_parts;
2352 my $inflected = ($self->naming->{monikers}||'') eq 'plural' ?
2353 Lingua::EN::Inflect::Phrase::to_PL($as_phrase)
2355 ($self->naming->{monikers}||'') eq 'preserve' ?
2358 Lingua::EN::Inflect::Phrase::to_S($as_phrase);
2360 @part_parts = split /\s+/, $inflected;
2363 push @all_parts, map ucfirst, @part_parts;
2366 return join '', @all_parts;
2369 sub _table2moniker {
2370 my ( $self, $table ) = @_;
2372 $self->_run_user_map(
2374 sub { $self->_default_table2moniker( shift ) },
2379 sub _load_relationships {
2380 my ($self, $tables) = @_;
2384 foreach my $table (@$tables) {
2385 my $local_moniker = $self->monikers->{$table->sql_name};
2387 my $tbl_fk_info = $self->_table_fk_info($table);
2389 foreach my $fkdef (@$tbl_fk_info) {
2390 $fkdef->{local_table} = $table;
2391 $fkdef->{local_moniker} = $local_moniker;
2392 $fkdef->{remote_source} =
2393 $self->monikers->{$fkdef->{remote_table}->sql_name};
2395 my $tbl_uniq_info = $self->_table_uniq_info($table);
2397 push @tables, [ $local_moniker, $tbl_fk_info, $tbl_uniq_info ];
2400 my $rel_stmts = $self->_relbuilder->generate_code(\@tables);
2402 foreach my $src_class (sort keys %$rel_stmts) {
2404 my @src_stmts = map $_->[1],
2405 sort { $a->[0] cmp $b->[0] }
2406 map [ $_->{args}[0], $_ ], @{ $rel_stmts->{$src_class} };
2408 foreach my $stmt (@src_stmts) {
2409 $self->_dbic_stmt($src_class,$stmt->{method}, @{$stmt->{args}});
2415 my ($self, $table) = @_;
2417 my $table_moniker = $self->monikers->{$table->sql_name};
2418 my $table_class = $self->classes->{$table->sql_name};
2420 my @roles = @{ $self->result_roles || [] };
2421 push @roles, @{ $self->result_roles_map->{$table_moniker} }
2422 if exists $self->result_roles_map->{$table_moniker};
2425 $self->_pod_class_list($table_class, 'L<Moose> ROLES APPLIED', @roles);
2427 $self->_with($table_class, @roles);
2431 # Overload these in driver class:
2433 # Returns an arrayref of column names
2434 sub _table_columns { croak "ABSTRACT METHOD" }
2436 # Returns arrayref of pk col names
2437 sub _table_pk_info { croak "ABSTRACT METHOD" }
2439 # Returns an arrayref of uniqs [ [ foo => [ col1, col2 ] ], [ bar => [ ... ] ] ]
2440 sub _table_uniq_info { croak "ABSTRACT METHOD" }
2442 # Returns an arrayref of foreign key constraints, each
2443 # being a hashref with 3 keys:
2444 # local_columns (arrayref), remote_columns (arrayref), remote_table
2445 sub _table_fk_info { croak "ABSTRACT METHOD" }
2447 # Returns an array of lower case table names
2448 sub _tables_list { croak "ABSTRACT METHOD" }
2450 # Execute a constructive DBIC class method, with debug/dump_to_dir hooks.
2456 # generate the pod for this statement, storing it with $self->_pod
2457 $self->_make_pod( $class, $method, @_ ) if $self->generate_pod;
2459 my $args = dump(@_);
2460 $args = '(' . $args . ')' if @_ < 2;
2461 my $stmt = $method . $args . q{;};
2463 warn qq|$class\->$stmt\n| if $self->debug;
2464 $self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
2468 sub _make_pod_heading {
2469 my ($self, $class) = @_;
2471 return '' if not $self->generate_pod;
2473 my $table = $self->class_to_table->{$class};
2476 my $pcm = $self->pod_comment_mode;
2477 my ($comment, $comment_overflows, $comment_in_name, $comment_in_desc);
2478 $comment = $self->__table_comment($table);
2479 $comment_overflows = ($comment and length $comment > $self->pod_comment_spillover_length);
2480 $comment_in_name = ($pcm eq 'name' or ($pcm eq 'auto' and !$comment_overflows));
2481 $comment_in_desc = ($pcm eq 'description' or ($pcm eq 'auto' and $comment_overflows));
2483 $pod .= "=head1 NAME\n\n";
2485 my $table_descr = $class;
2486 $table_descr .= " - " . $comment if $comment and $comment_in_name;
2488 $pod .= "$table_descr\n\n";
2490 if ($comment and $comment_in_desc) {
2491 $pod .= "=head1 DESCRIPTION\n\n${comment}\n\n";
2498 # generates the accompanying pod for a DBIC class method statement,
2499 # storing it with $self->_pod
2505 if ($method eq 'table') {
2507 $table = $$table if ref $table eq 'SCALAR';
2508 $self->_pod($class, "=head1 TABLE: C<$table>");
2509 $self->_pod_cut($class);
2511 elsif ( $method eq 'add_columns' ) {
2512 $self->_pod( $class, "=head1 ACCESSORS" );
2513 my $col_counter = 0;
2515 while( my ($name,$attrs) = splice @cols,0,2 ) {
2517 $self->_pod( $class, '=head2 ' . $name );
2518 $self->_pod( $class,
2520 my $s = $attrs->{$_};
2521 $s = !defined $s ? 'undef' :
2522 length($s) == 0 ? '(empty string)' :
2523 ref($s) eq 'SCALAR' ? $$s :
2524 ref($s) ? dumper_squashed $s :
2525 looks_like_number($s) ? $s : qq{'$s'};
2528 } sort keys %$attrs,
2530 if (my $comment = $self->__column_comment($self->class_to_table->{$class}, $col_counter, $name)) {
2531 $self->_pod( $class, $comment );
2534 $self->_pod_cut( $class );
2535 } elsif ( $method =~ /^(belongs_to|has_many|might_have)$/ ) {
2536 $self->_pod( $class, "=head1 RELATIONS" ) unless $self->{_relations_started} { $class } ;
2537 my ( $accessor, $rel_class ) = @_;
2538 $self->_pod( $class, "=head2 $accessor" );
2539 $self->_pod( $class, 'Type: ' . $method );
2540 $self->_pod( $class, "Related object: L<$rel_class>" );
2541 $self->_pod_cut( $class );
2542 $self->{_relations_started} { $class } = 1;
2544 elsif ($method eq 'add_unique_constraint') {
2545 $self->_pod($class, '=head1 UNIQUE CONSTRAINTS')
2546 unless $self->{_uniqs_started}{$class};
2548 my ($name, $cols) = @_;
2550 $self->_pod($class, "=head2 C<$name>");
2551 $self->_pod($class, '=over 4');
2553 foreach my $col (@$cols) {
2554 $self->_pod($class, "=item \* L</$col>");
2557 $self->_pod($class, '=back');
2558 $self->_pod_cut($class);
2560 $self->{_uniqs_started}{$class} = 1;
2562 elsif ($method eq 'set_primary_key') {
2563 $self->_pod($class, "=head1 PRIMARY KEY");
2564 $self->_pod($class, '=over 4');
2566 foreach my $col (@_) {
2567 $self->_pod($class, "=item \* L</$col>");
2570 $self->_pod($class, '=back');
2571 $self->_pod_cut($class);
2575 sub _pod_class_list {
2576 my ($self, $class, $title, @classes) = @_;
2578 return unless @classes && $self->generate_pod;
2580 $self->_pod($class, "=head1 $title");
2581 $self->_pod($class, '=over 4');
2583 foreach my $link (@classes) {
2584 $self->_pod($class, "=item * L<$link>");
2587 $self->_pod($class, '=back');
2588 $self->_pod_cut($class);
2591 sub _base_class_pod {
2592 my ($self, $base_class) = @_;
2594 return '' unless $self->generate_pod;
2597 =head1 BASE CLASS: L<$base_class>
2604 sub _filter_comment {
2605 my ($self, $txt) = @_;
2607 $txt = '' if not defined $txt;
2609 $txt =~ s/(?:\015?\012|\015\012?)/\n/g;
2614 sub __table_comment {
2617 if (my $code = $self->can('_table_comment')) {
2618 return $self->_filter_comment($self->$code(@_));
2624 sub __column_comment {
2627 if (my $code = $self->can('_column_comment')) {
2628 return $self->_filter_comment($self->$code(@_));
2634 # Stores a POD documentation
2636 my ($self, $class, $stmt) = @_;
2637 $self->_raw_stmt( $class, "\n" . $stmt );
2641 my ($self, $class ) = @_;
2642 $self->_raw_stmt( $class, "\n=cut\n" );
2645 # Store a raw source line for a class (for dumping purposes)
2647 my ($self, $class, $stmt) = @_;
2648 push(@{$self->{_dump_storage}->{$class}}, $stmt);
2651 # Like above, but separately for the externally loaded stuff
2653 my ($self, $class, $stmt) = @_;
2654 push(@{$self->{_ext_storage}->{$class}}, $stmt);
2657 sub _custom_column_info {
2658 my ( $self, $table_name, $column_name, $column_info ) = @_;
2660 if (my $code = $self->custom_column_info) {
2661 return $code->($table_name, $column_name, $column_info) || {};
2666 sub _datetime_column_info {
2667 my ( $self, $table_name, $column_name, $column_info ) = @_;
2669 my $type = $column_info->{data_type} || '';
2670 if ((grep $_, @{ $column_info }{map "inflate_$_", qw/date datetime timestamp/})
2671 or ($type =~ /date|timestamp/i)) {
2672 $result->{timezone} = $self->datetime_timezone if $self->datetime_timezone;
2673 $result->{locale} = $self->datetime_locale if $self->datetime_locale;
2679 my ($self, $name) = @_;
2681 return $self->preserve_case ? $name : lc($name);
2685 my ($self, $name) = @_;
2687 return $self->preserve_case ? $name : uc($name);
2691 my ($self, $table) = @_;
2694 my $schema = $self->schema;
2695 # in older DBIC it's a private method
2696 my $unregister = $schema->can('unregister_source') || $schema->can('_unregister_source');
2697 $schema->$unregister(delete $self->monikers->{$table->sql_name});
2698 delete $self->_upgrading_classes->{delete $self->classes->{$table->sql_name}};
2699 delete $self->_tables->{$table->sql_name};
2703 # remove the dump dir from @INC on destruction
2707 @INC = grep $_ ne $self->dump_directory, @INC;
2712 Returns a hashref of loaded table to moniker mappings. There will
2713 be two entries for each table, the original name and the "normalized"
2714 name, in the case that the two are different (such as databases
2715 that like uppercase table names, or preserve your original mixed-case
2716 definitions, or what-have-you).
2720 Returns a hashref of table to class mappings. In some cases it will
2721 contain multiple entries per table for the original and normalized table
2722 names, as above in L</monikers>.
2724 =head1 NON-ENGLISH DATABASES
2726 If you use the loader on a database with table and column names in a language
2727 other than English, you will want to turn off the English language specific
2730 To do so, use something like this in your laoder options:
2732 naming => { monikers => 'v4' },
2733 inflect_singular => sub { "$_[0]_rel" },
2734 inflect_plural => sub { "$_[0]_rel" },
2736 =head1 COLUMN ACCESSOR COLLISIONS
2738 Occasionally you may have a column name that collides with a perl method, such
2739 as C<can>. In such cases, the default action is to set the C<accessor> of the
2740 column spec to C<undef>.
2742 You can then name the accessor yourself by placing code such as the following
2745 __PACKAGE__->add_column('+can' => { accessor => 'my_can' });
2747 Another option is to use the L</col_collision_map> option.
2749 =head1 RELATIONSHIP NAME COLLISIONS
2751 In very rare cases, you may get a collision between a generated relationship
2752 name and a method in your Result class, for example if you have a foreign key
2753 called C<belongs_to>.
2755 This is a problem because relationship names are also relationship accessor
2756 methods in L<DBIx::Class>.
2758 The default behavior is to append C<_rel> to the relationship name and print
2759 out a warning that refers to this text.
2761 You can also control the renaming with the L</rel_collision_map> option.
2765 L<DBIx::Class::Schema::Loader>
2769 See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
2773 This library is free software; you can redistribute it and/or modify it under
2774 the same terms as Perl itself.
2779 # vim:et sts=4 sw=4 tw=0: