THROWAWAY: Don't load unmodified generated external classes
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Base.pm
index 26d952a..0e3c555 100644 (file)
@@ -29,7 +29,7 @@ use List::Util qw/all any none/;
 use File::Temp 'tempfile';
 use namespace::clean;
 
-our $VERSION = '0.07042';
+our $VERSION = '0.07043';
 
 __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 schema
@@ -84,6 +84,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 moniker_to_table
                                 uniq_to_primary
                                 quiet
+                                allow_extra_m2m_cols
 /);
 
 
@@ -157,6 +158,9 @@ of relationships.
 Skip loading of other classes in @INC. The default is to merge all other classes
 with the same name found in @INC into the schema file we are creating.
 
+Even if this is not set, code generated by this module and not
+subsequently modified is never included.
+
 =head2 naming
 
 Static schemas (ones dumped to disk) will, by default, use the new-style
@@ -399,10 +403,10 @@ override the introspected attributes of the foreign key if any.
 
 For example:
 
-  relationship_attrs => {
-    has_many   => { cascade_delete => 1, cascade_copy => 1 },
-    might_have => { cascade_delete => 1, cascade_copy => 1 },
-  },
+    relationship_attrs => {
+        has_many   => { cascade_delete => 1, cascade_copy => 1 },
+        might_have => { cascade_delete => 1, cascade_copy => 1 },
+    },
 
 use this to turn L<DBIx::Class> cascades to on on your
 L<has_many|DBIx::Class::Relationship/has_many> and
@@ -659,17 +663,17 @@ L</moniker_map> takes precedence over this.
 Same as moniker_map, but for column accessor names.  If a coderef is
 passed, the code is called with arguments of
 
-   the name of the column in the underlying database,
-   default accessor name that DBICSL would ordinarily give this column,
-   {
-      table_class     => name of the DBIC class we are building,
-      table_moniker   => calculated moniker for this table (after moniker_map if present),
-      table           => table object of interface DBIx::Class::Schema::Loader::Table,
-      full_table_name => schema-qualified name of the database table (RDBMS specific),
-      schema_class    => name of the schema class we are building,
-      column_info     => hashref of column info (data_type, is_nullable, etc),
-   }
-   coderef ref that can be called with a hashref map
+    the name of the column in the underlying database,
+    default accessor name that DBICSL would ordinarily give this column,
+    {
+        table_class     => name of the DBIC class we are building,
+        table_moniker   => calculated moniker for this table (after moniker_map if present),
+        table           => table object of interface DBIx::Class::Schema::Loader::Table,
+        full_table_name => schema-qualified name of the database table (RDBMS specific),
+        schema_class    => name of the schema class we are building,
+        column_info     => hashref of column info (data_type, is_nullable, etc),
+    }
+    coderef ref that can be called with a hashref map
 
 the L<table object|DBIx::Class::Schema::Loader::Table> stringifies to the
 unqualified table name.
@@ -767,13 +771,13 @@ A hashref of moniker keys and component values.  Unlike L</components>, which
 loads the given components into every Result class, this option allows you to
 load certain components for specified Result classes. For example:
 
-  result_components_map => {
-      StationVisited => '+YourApp::Schema::Component::StationVisited',
-      RouteChange    => [
-                            '+YourApp::Schema::Component::RouteChange',
-                            'InflateColumn::DateTime',
-                        ],
-  }
+    result_components_map => {
+        StationVisited => '+YourApp::Schema::Component::StationVisited',
+        RouteChange    => [
+                              '+YourApp::Schema::Component::RouteChange',
+                              'InflateColumn::DateTime',
+                          ],
+    }
 
 You may use this in conjunction with L</components>.
 
@@ -787,13 +791,13 @@ A hashref of moniker keys and role values.  Unlike L</result_roles>, which
 applies the given roles to every Result class, this option allows you to apply
 certain roles for specified Result classes. For example:
 
-  result_roles_map => {
-      StationVisited => [
-                            'YourApp::Role::Building',
-                            'YourApp::Role::Destination',
-                        ],
-      RouteChange    => 'YourApp::Role::TripEvent',
-  }
+    result_roles_map => {
+        StationVisited => [
+                              'YourApp::Role::Building',
+                              'YourApp::Role::Destination',
+                          ],
+        RouteChange    => 'YourApp::Role::TripEvent',
+    }
 
 You may use this in conjunction with L</result_roles>.
 
@@ -882,13 +886,13 @@ stringifies to the unqualified table name), column name and column_info.
 
 For example:
 
-  custom_column_info => sub {
-      my ($table, $column_name, $column_info) = @_;
+    custom_column_info => sub {
+        my ($table, $column_name, $column_info) = @_;
 
-      if ($column_name eq 'dog' && $column_info->{default_value} eq 'snoopy') {
-          return { is_snoopy => 1 };
-      }
-  },
+        if ($column_name eq 'dog' && $column_info->{default_value} eq 'snoopy') {
+            return { is_snoopy => 1 };
+        }
+    },
 
 This attribute can also be used to set C<inflate_datetime> on a non-datetime
 column so it also receives the L</datetime_timezone> and/or L</datetime_locale>.
@@ -993,6 +997,13 @@ Automatically promotes the largest unique constraints with non-nullable columns
 on tables to primary keys, assuming there is only one largest unique
 constraint.
 
+=head2 allow_extra_m2m_cols
+
+Generate C<many_to_many> relationship bridges even if the link table has
+extra columns other than the foreign keys.  The primary key must still
+equal the union of the foreign keys.
+
+
 =head2 filter_generated_code
 
 An optional hook that lets you filter the generated text for various classes
@@ -1344,7 +1355,7 @@ EOF
     return unless -e $filename;
 
     my ($old_gen, $old_md5, $old_ver, $old_ts, $old_custom) =
-      $self->_parse_generated_file($filename);
+        $self->_parse_generated_file($filename);
 
     return unless $old_ver;
 
@@ -1553,24 +1564,34 @@ sub _load_external {
 
         my $code = $self->_rewrite_old_classnames(slurp_file $real_inc_path);
 
-        if ($self->dynamic) { # load the class too
-            eval_package_without_redefine_warnings($class, $code);
+        if (my ($gen, $real_md5, $ver, $ts, $custom) = try {
+            local $self->{overwrite_modifications} = 0;
+            $self->_parse_generated_code($real_inc_path, $code);
+        }) {
+            # Ignore unmodified generated code.
+            $code = $custom eq $self->_default_custom_content ? '' : $custom;
         }
 
-        $self->_ext_stmt($class,
-          qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
-         .qq|# They are now part of the custom portion of this file\n|
-         .qq|# for you to hand-edit.  If you do not either delete\n|
-         .qq|# this section or remove that file from \@INC, this section\n|
-         .qq|# will be repeated redundantly when you re-create this\n|
-         .qq|# file again via Loader!  See skip_load_external to disable\n|
-         .qq|# this feature.\n|
-        );
-        chomp $code;
-        $self->_ext_stmt($class, $code);
-        $self->_ext_stmt($class,
-            qq|# End of lines loaded from '$real_inc_path' |
-        );
+        if ($code) {
+            if ($self->dynamic) { # load the class too
+                eval_package_without_redefine_warnings($class, $code);
+            }
+
+            $self->_ext_stmt($class,
+                qq|# These lines were loaded from '$real_inc_path' found in \@INC.\n|
+               .qq|# They are now part of the custom portion of this file\n|
+               .qq|# for you to hand-edit.  If you do not either delete\n|
+               .qq|# this section or remove that file from \@INC, this section\n|
+               .qq|# will be repeated redundantly when you re-create this\n|
+               .qq|# file again via Loader!  See skip_load_external to disable\n|
+               .qq|# this feature.\n|
+            );
+            chomp $code;
+            $self->_ext_stmt($class, $code);
+            $self->_ext_stmt($class,
+                qq|# End of lines loaded from '$real_inc_path'|
+            );
+        }
     }
 
     if ($old_real_inc_path) {
@@ -1601,7 +1622,7 @@ EOF
         chomp $code;
         $self->_ext_stmt($class, $code);
         $self->_ext_stmt($class,
-            qq|# End of lines loaded from '$old_real_inc_path' |
+            qq|# End of lines loaded from '$old_real_inc_path'|
         );
     }
 }
@@ -1615,9 +1636,7 @@ Does the actual schema-construction work.
 sub load {
     my $self = shift;
 
-    $self->_load_tables(
-        $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude })
-    );
+    $self->_load_tables($self->_tables_list);
 }
 
 =head2 rescan
@@ -1639,7 +1658,7 @@ sub rescan {
     $self->_relbuilder->{schema} = $schema;
 
     my @created;
-    my @current = $self->_tables_list({ constraint => $self->constraint, exclude => $self->exclude });
+    my @current = $self->_tables_list;
 
     foreach my $table (@current) {
         if(!exists $self->_tables->{$table->sql_name}) {
@@ -1861,14 +1880,14 @@ sub _reload_classes {
 }
 
 sub _moose_metaclass {
-  return undef unless $INC{'Class/MOP.pm'};   # if CMOP is not loaded the class could not have loaded in the 1st place
+    return undef unless $INC{'Class/MOP.pm'}; # if CMOP is not loaded the class could not have loaded in the 1st place
 
-  my $class = $_[1];
+    my $class = $_[1];
 
-  my $mc = try { Class::MOP::class_of($class) }
-    or return undef;
+    my $mc = try { Class::MOP::class_of($class) }
+        or return undef;
 
-  return $mc->isa('Moose::Meta::Class') ? $mc : undef;
+    return $mc->isa('Moose::Meta::Class') ? $mc : undef;
 }
 
 # We use this instead of ensure_class_loaded when there are package symbols we
@@ -2023,7 +2042,7 @@ sub _dump_to_dir {
             }
         }
         else {
-             $src_text .= qq|use base '$result_base_class';\n|;
+            $src_text .= qq|use base '$result_base_class';\n|;
         }
 
         $self->_write_classfile($src_class, $src_text);
@@ -2164,10 +2183,10 @@ sub _write_classfile {
 
     my $compare_to;
     if ($old_md5) {
-      $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
-      if (Digest::MD5::md5_base64(encode 'UTF-8', $compare_to) eq $old_md5) {
-        return unless $self->_upgrading_from && $is_schema;
-      }
+        $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
+        if (Digest::MD5::md5_base64(encode 'UTF-8', $compare_to) eq $old_md5) {
+            return unless $self->_upgrading_from && $is_schema;
+        }
     }
 
     push @{$self->generated_classes}, $class;
@@ -2175,11 +2194,11 @@ sub _write_classfile {
     return if $self->dry_run;
 
     $text .= $self->_sig_comment(
-      $self->omit_version ? undef : $self->version_to_dump,
-      $self->omit_timestamp ? undef : POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
+        $self->omit_version ? undef : $self->version_to_dump,
+        $self->omit_timestamp ? undef : POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
     );
 
-    open(my $fh, '>:encoding(UTF-8)', $filename)
+    open(my $fh, '>:raw:encoding(UTF-8)', $filename)
         or croak "Cannot open '$filename' for writing: $!";
 
     # Write the top half and its MD5 sum
@@ -2222,44 +2241,35 @@ sub _parse_generated_file {
 
     return unless -f $fn;
 
-    open(my $fh, '<:encoding(UTF-8)', $fn)
-        or croak "Cannot open '$fn' for reading: $!";
-
-    my $mark_re =
-        qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\r?\n};
-
-    my ($md5, $ts, $ver, $gen);
-    local $_;
-    while(<$fh>) {
-        if(/$mark_re/) {
-            my $pre_md5 = $1;
-            $md5 = $2;
+    return $self->_parse_generated_code($fn, slurp_file $fn);
+}
 
-            # Pull out the version and timestamp from the line above
-            ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader( v[\d.]+)?( @ [\d-]+ [\d:]+)?\r?\Z/m;
-            $ver =~ s/^ v// if $ver;
-            $ts =~ s/^ @ // if $ts;
+sub _parse_generated_code {
+    my ($self, $fn, $code) = @_;
 
-            $gen .= $pre_md5;
-            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"
-                if !$self->overwrite_modifications && Digest::MD5::md5_base64(encode 'UTF-8', $gen) ne $md5;
+    my ($gen, $ver, $ts, $mark_md5, $custom) = (
+        $code =~ m{
+            \A
+            (
+                .*                   # generated code
+                ^\# \Q Created by DBIx::Class::Schema::Loader\E
+                (\ v [\d.]+ )? (\ @\ [\d-]+\ [\d:]+)?\r?\n # verison/time stamp
+                ^\# \Q DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:\E
+            )
+            ([A-Za-z0-9/+]{22})\r?\n # checksum
+            (.*)                     # custom code
+            \z
+        }xms
+    ) or return;
 
-            last;
-        }
-        else {
-            $gen .= $_;
-        }
-    }
+    $ver =~ s/^ v// if $ver;
+    $ts =~ s/^ @ // if $ts;
 
-    my $custom = do { local $/; <$fh> }
-        if $md5;
+    my $real_md5 = Digest::MD5::md5_base64(encode 'UTF-8', $gen);
+    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"
+        if !$self->overwrite_modifications && $real_md5 ne $mark_md5;
 
-    $custom ||= '';
-    $custom =~ s/$CRLF|$LF/\n/g;
-
-    close $fh;
-
-    return ($gen, $md5, $ver, $ts, $custom);
+    return ($gen, $real_md5, $ver, $ts, $custom);
 }
 
 sub _use {
@@ -2424,8 +2434,10 @@ sub _is_result_class_method {
         push @roles, @{ $self->result_roles_map->{$table_moniker} }
             if exists $self->result_roles_map->{$table_moniker};
 
-        for my $class ($base, @components,
-                       ($self->use_moose ? 'Moose::Object' : ()), @roles) {
+        for my $class (
+            $base, @components, @roles,
+            ($self->use_moose ? 'Moose::Object' : ()),
+        ) {
             $self->ensure_class_loaded($class);
 
             push @methods, @{ Class::Inspector->methods($class) || [] };
@@ -2547,7 +2559,7 @@ sub _make_column_accessor_name {
         sub { $self->_default_column_accessor_name( shift ) },
         $column_name,
         $column_context_info,
-       );
+    );
 
     return $accessor;
 }
@@ -2787,7 +2799,7 @@ sub _table2moniker {
         $self->moniker_map,
         sub { $self->_default_table2moniker( shift ) },
         $table
-       );
+    );
 }
 
 sub _load_relationships {
@@ -2946,7 +2958,7 @@ sub _make_pod {
                         looks_like_number($s) ? $s                  : qq{'$s'};
 
                     "  $_: $s"
-                 } sort keys %$attrs,
+                } sort keys %$attrs,
             );
             if (my $comment = $self->__column_comment($self->class_to_table->{$class}, $col_counter, $name)) {
                 $self->_pod( $class, $comment );
@@ -3193,9 +3205,9 @@ You can also control the renaming with the L</rel_collision_map> option.
 
 L<DBIx::Class::Schema::Loader>, L<dbicdump>
 
-=head1 AUTHOR
+=head1 AUTHORS
 
-See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHORS>.
 
 =head1 LICENSE