From: Rafael Kitover Date: Thu, 26 May 2011 19:50:56 +0000 (-0400) Subject: become utf8-aware (RT#67920) X-Git-Tag: 0.07011~103 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=af15ea3334eb18d5bdeafbba43c43db007394086;p=dbsrgits%2FDBIx-Class-Schema-Loader.git become utf8-aware (RT#67920) --- diff --git a/Changes b/Changes index 345084b..0258327 100644 --- 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, diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 47dccab..79886cc 100644 --- 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'; @@ -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; } diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm index 0145691..c58f016 100644 --- a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm +++ b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm @@ -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; diff --git a/t/10_03pg_common.t b/t/10_03pg_common.t index 3f21d25..894be67 100644 --- a/t/10_03pg_common.t +++ b/t/10_03pg_common.t @@ -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,