become utf8-aware (RT#67920)
Rafael Kitover [Thu, 26 May 2011 19:50:56 +0000 (15:50 -0400)]
Changes
lib/DBIx/Class/Schema/Loader/Base.pm
lib/DBIx/Class/Schema/Loader/RelBuilder.pm
t/10_03pg_common.t

diff --git a/Changes b/Changes
index 345084b..0258327 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - become utf8-aware (RT#67920)
         - handle duplicate relationship names (RT#64041)
         - fix a bug in Sybase ASE foreign key detection
         - generate POD for result_base_class, additional_classes,
index 47dccab..79886cc 100644 (file)
@@ -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';
@@ -1003,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);
@@ -1026,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");
 
@@ -1281,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";
     };
 }
@@ -1503,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;
       }
     }
@@ -1513,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|
@@ -1556,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 =
@@ -1573,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;
         }
index 0145691..c58f016 100644 (file)
@@ -14,6 +14,7 @@ use Try::Tiny;
 use Class::Unload ();
 use Class::Inspector ();
 use List::MoreUtils 'apply';
+use Encode 'decode';
 use namespace::clean;
 
 our $VERSION = '0.07010';
@@ -597,7 +598,7 @@ sub _relnames_and_method {
             my $class = "${remote_class}Temporary";
 
             if (not Class::Inspector->loaded($class)) {
-                my $code = slurp $existing_remote_file;
+                my $code = decode 'UTF-8', scalar slurp $existing_remote_file;
 
                 $code =~ s/(?<=package $remote_class)/Temporary/g;
 
index 3f21d25..894be67 100644 (file)
@@ -3,6 +3,8 @@ use lib qw(t/lib);
 use dbixcsl_common_tests;
 use Test::More;
 use File::Slurp 'slurp';
+use utf8;
+use Encode 'decode';
 
 my $dsn      = $ENV{DBICTEST_PG_DSN} || '';
 my $user     = $ENV{DBICTEST_PG_USER} || '';
@@ -16,7 +18,8 @@ my $tester = dbixcsl_common_tests->new(
     password    => $password,
     loader_options  => { preserve_case => 1 },
     connect_info_opts => {
-        on_connect_do => [ 'SET client_min_messages=WARNING' ],
+        pg_enable_utf8 => 1,
+        on_connect_do  => [ 'SET client_min_messages=WARNING' ],
     },
     quote_char  => '"',
     data_types  => {
@@ -139,7 +142,7 @@ my $tester = dbixcsl_common_tests->new(
                 )
             },
             qq{
-                COMMENT ON TABLE pg_loader_test1 IS 'The\15\12Table'
+                COMMENT ON TABLE pg_loader_test1 IS 'The\15\12Table ∑'
             },
             qq{
                 COMMENT ON COLUMN pg_loader_test1.value IS 'The\15\12Column'
@@ -170,9 +173,9 @@ my $tester = dbixcsl_common_tests->new(
             my $class    = $classes->{pg_loader_test1};
             my $filename = $schema->_loader->get_dump_filename($class);
 
-            my $code = slurp $filename;
+            my $code = decode('UTF-8', scalar slurp $filename);
 
-            like $code, qr/^=head1 NAME\n\n^$class - The\nTable\n\n^=cut\n/m,
+            like $code, qr/^=head1 NAME\n\n^$class - The\nTable ∑\n\n^=cut\n/m,
                 'table comment';
 
             like $code, qr/^=head2 value\n\n(.+:.+\n)+\nThe\nColumn\n\n/m,