become utf8-aware (RT#67920)

[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Base.pm

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 526a19a..79886cc 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -22,6 +22,7 @@ use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_packag
 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
 use Try::Tiny;
 use DBIx::Class ();
+use Encode qw/decode encode/;
 use namespace::clean;
 
 our $VERSION = '0.07010';
@@ -93,6 +94,7 @@ __PACKAGE__->mk_group_accessors('simple', qw/
                                 datetime_undef_if_invalid
                                 _result_class_methods
                                 naming_set
+                                tables
 /);
 
 =head1 NAME
@@ -686,7 +688,8 @@ sub new {
     }
 
     $self->{monikers} = {};
-    $self->{classes} = {};
+    $self->{tables}   = {};
+    $self->{classes}  = {};
     $self->{_upgrading_classes} = {};
 
     $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} );
@@ -1001,7 +1004,7 @@ sub _load_external {
         warn qq/# Loaded external class definition for '$class'\n/
             if $self->debug;
 
-        my $code = $self->_rewrite_old_classnames(scalar slurp $real_inc_path);
+        my $code = $self->_rewrite_old_classnames(decode 'UTF-8', scalar slurp $real_inc_path);
 
         if ($self->dynamic) { # load the class too
             eval_package_without_redefine_warnings($class, $code);
@@ -1024,7 +1027,7 @@ sub _load_external {
     }
 
     if ($old_real_inc_path) {
-        my $code = slurp $old_real_inc_path;
+        my $code = decode 'UTF-8', scalar slurp $old_real_inc_path;
 
         $self->_ext_stmt($class, <<"EOF");
 
@@ -1179,8 +1182,7 @@ sub _load_tables {
         $self->{quiet} = 1;
         local $self->{dump_directory} = $self->{temp_directory};
         $self->_reload_classes(\@tables);
-        $self->_load_relationships($_) for @tables;
-        $self->_relbuilder->cleanup;
+        $self->_load_relationships(\@tables);
         $self->{quiet} = 0;
 
         # Remove that temp dir from INC so it doesn't get reloaded
@@ -1280,7 +1282,7 @@ sub _reload_class {
         eval_package_without_redefine_warnings ($class, "require $class");
     }
     catch {
-        my $source = slurp $self->_get_dump_filename($class);
+        my $source = decode 'UTF-8', scalar slurp $self->_get_dump_filename($class);
         die "Failed to reload class $class: $_.\n\nCLASS SOURCE:\n\n$source";
     };
 }
@@ -1502,7 +1504,7 @@ sub _write_classfile {
     my $compare_to;
     if ($old_md5) {
       $compare_to = $text . $self->_sig_comment($old_ver, $old_ts);
-      if (Digest::MD5::md5_base64($compare_to) eq $old_md5) {
+      if (Digest::MD5::md5_base64(encode 'UTF-8', $compare_to) eq $old_md5) {
         return unless $self->_upgrading_from && $is_schema;
       }
     }
@@ -1512,11 +1514,11 @@ sub _write_classfile {
       POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime)
     );
 
-    open(my $fh, '>', $filename)
+    open(my $fh, '>:encoding(UTF-8)', $filename)
         or croak "Cannot open '$filename' for writing: $!";
 
     # Write the top half and its MD5 sum
-    print $fh $text . Digest::MD5::md5_base64($text) . "\n";
+    print $fh $text . Digest::MD5::md5_base64(encode 'UTF-8', $text) . "\n";
 
     # Write out anything loaded via external partial class file in @INC
     print $fh qq|$_\n|
@@ -1555,7 +1557,7 @@ sub _parse_generated_file {
 
     return unless -f $fn;
 
-    open(my $fh, '<', $fn)
+    open(my $fh, '<:encoding(UTF-8)', $fn)
         or croak "Cannot open '$fn' for reading: $!";
 
     my $mark_re =
@@ -1572,7 +1574,7 @@ sub _parse_generated_file {
 
             $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($gen) ne $md5;
+                if !$self->overwrite_modifications && Digest::MD5::md5_base64(encode 'UTF-8', $gen) ne $md5;
 
             last;
         }
@@ -1688,6 +1690,7 @@ sub _make_src_class {
 
     $self->classes->{$table}  = $table_class;
     $self->monikers->{$table} = $table_moniker;
+    $self->tables->{$table_moniker} = $table;
 
     $self->_pod_class_list($table_class, 'ADDITIONAL CLASSES USED', @{$self->additional_classes});
 
@@ -1721,7 +1724,7 @@ sub _make_src_class {
 sub _is_result_class_method {
     my ($self, $name, $table_name) = @_;
 
-    my $table_moniker = $table_name ? $self->_table2moniker($table_name) : '';
+    my $table_moniker = $table_name ? $self->monikers->{$table_name} : '';
 
     $self->_result_class_methods({})
         if not defined $self->_result_class_methods;
@@ -1885,7 +1888,7 @@ sub _setup_src_meta {
         $info->{accessor} = $self->_make_column_accessor_name( $col, $context );
     }
 
-    $self->_resolve_col_accessor_collisions($full_table_name, $col_info);
+    $self->_resolve_col_accessor_collisions($table, $col_info);
 
     # prune any redundant accessor names
     while (my ($col, $info) = each %$col_info) {
@@ -1994,17 +1997,24 @@ sub _table2moniker {
 }
 
 sub _load_relationships {
-    my ($self, $table) = @_;
+    my ($self, $tables) = @_;
+
+    my @tables;
+
+    foreach my $table (@$tables) {
+        my $tbl_fk_info = $self->_table_fk_info($table);
+        foreach my $fkdef (@$tbl_fk_info) {
+            $fkdef->{remote_source} =
+                $self->monikers->{delete $fkdef->{remote_table}};
+        }
+        my $tbl_uniq_info = $self->_table_uniq_info($table);
+
+        my $local_moniker = $self->monikers->{$table};
 
-    my $tbl_fk_info = $self->_table_fk_info($table);
-    foreach my $fkdef (@$tbl_fk_info) {
-        $fkdef->{remote_source} =
-            $self->monikers->{delete $fkdef->{remote_table}};
+        push @tables, [ $local_moniker, $tbl_fk_info, $tbl_uniq_info ];
     }
-    my $tbl_uniq_info = $self->_table_uniq_info($table);
 
-    my $local_moniker = $self->monikers->{$table};
-    my $rel_stmts = $self->_relbuilder->generate_code($local_moniker, $tbl_fk_info, $tbl_uniq_info);
+    my $rel_stmts = $self->_relbuilder->generate_code(\@tables);
 
     foreach my $src_class (sort keys %$rel_stmts) {
         my $src_stmts = $rel_stmts->{$src_class};