From: Christian Walde <walde.christian@googlemail.com>
Date: Tue, 5 May 2015 01:34:47 +0000 (+0200)
Subject: Ensure schema files are generated as binary files on Windows
X-Git-Tag: 0.07043~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=160b07c52696f02de5573349e70c9892e71479ce;hp=f05f6b69889a40f4d882b4e93d1c443105609229;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

Ensure schema files are generated as binary files on Windows

Otherwise they'll be generated with \r newlines in them, which breaks
checksumming and portability of schemas to other OSes.
---

diff --git a/Changes b/Changes
index f8363ac..d5ccd94 100644
--- a/Changes
+++ b/Changes
@@ -5,6 +5,7 @@ Revision history for Perl extension DBIx::Class::Schema::Loader
         - Document how to add perltidy markers via filter_generated_code
         - Fix DB2 foreign-key introspection
         - Remove dependency on List::MoreUtils and Sub::Name
+        - Ensure schema files are generated as binary files on Windows
 
 0.07042  2014-08-20
         - Fix unescaped left braces in regexes in tests
diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 3cd33f1..da4f91b 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -2187,7 +2187,7 @@ sub _write_classfile {
       $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
diff --git a/t/lib/dbixcsl_dumper_tests.pm b/t/lib/dbixcsl_dumper_tests.pm
index d16a3bb..0382c0c 100644
--- a/t/lib/dbixcsl_dumper_tests.pm
+++ b/t/lib/dbixcsl_dumper_tests.pm
@@ -210,19 +210,21 @@ sub _test_dumps {
     }
 }
 
-sub _dump_file_like {
+sub _slurp {
     my $path = shift;
-    open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
+    open(my $dumpfh, '<:raw', $path) or die "Failed to open '$path': $!";
     my $contents = do { local $/; <$dumpfh>; };
     close($dumpfh);
+    return ($path, $contents);
+}
+
+sub _dump_file_like {
+    my ($path, $contents) = _slurp shift;
     like($contents, $_, "$path matches $_") for @_;
 }
 
 sub _dump_file_not_like {
-    my $path = shift;
-    open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
-    my $contents = do { local $/; <$dumpfh>; };
-    close($dumpfh);
+    my ($path, $contents) = _slurp shift;
     unlike($contents, $_, "$path does not match $_") for @_;
 }