support alternate line endings

Adds a utility method slurp_file to ::Utils for reading files in UTF-8
and converting the CRLFs or LFs inside to the platform \n. Changes all
uses of File::Slurp::read_file to slurp_file and changes some regexes to
match \r? at line ends.

diff --git a/Changes b/Changes
index f8d667e..fc30cf2 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - support DOS line endings on *nix and *nix line ending on Win32
         - add quiet option
         - $schema->loader is now a public method
         - add schema_components option

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 6b27f3e..5634bc6 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -17,8 +17,7 @@ use File::Temp qw//;
 use Class::Unload;
 use Class::Inspector ();
 use Scalar::Util 'looks_like_number';
-use File::Slurp 'read_file';
-use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path/;
+use DBIx::Class::Schema::Loader::Utils qw/split_name dumper_squashed eval_package_without_redefine_warnings class_path slurp_file/;
 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
 use Try::Tiny;
 use DBIx::Class ();
@@ -103,6 +102,17 @@ __PACKAGE__->mk_group_accessors('simple', qw/
                                 naming_set
 /);
 
+my $CURRENT_V = 'v7';
+
+my @CLASS_ARGS = qw(
+    schema_components schema_base_class result_base_class
+    additional_base_classes left_base_classes additional_classes components
+    result_roles
+);
+
+my $LF   = "\x0a";
+my $CRLF = "\x0d\x0a";
+
 =head1 NAME
 
 DBIx::Class::Schema::Loader::Base - Base DBIx::Class::Schema::Loader Implementation.
@@ -652,14 +662,6 @@ L<DBIx::Class::Schema::Loader>.
 
 =cut
 
-my $CURRENT_V = 'v7';
-
-my @CLASS_ARGS = qw(
-    schema_components schema_base_class result_base_class
-    additional_base_classes left_base_classes additional_classes components
-    result_roles
-);
-
 # ensure that a peice of object data is a valid arrayref, creating
 # an empty one or encapsulating whatever's there.
 sub _ensure_arrayref {
@@ -1116,7 +1118,7 @@ sub _load_external {
         warn qq/# Loaded external class definition for '$class'\n/
             if $self->debug;
 
-        my $code = $self->_rewrite_old_classnames(scalar read_file($real_inc_path, binmode => ':encoding(UTF-8)'));
+        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);
@@ -1139,7 +1141,7 @@ sub _load_external {
     }
 
     if ($old_real_inc_path) {
-        my $code = read_file($old_real_inc_path, binmode => ':encoding(UTF-8)');
+        my $code = slurp_file $old_real_inc_path;
 
         $self->_ext_stmt($class, <<"EOF");
 
@@ -1392,7 +1394,7 @@ sub _reload_class {
         eval_package_without_redefine_warnings ($class, "require $class");
     }
     catch {
-        my $source = read_file($self->_get_dump_filename($class), binmode => ':encoding(UTF-8)');
+        my $source = slurp_file $self->_get_dump_filename($class);
         die "Failed to reload class $class: $_.\n\nCLASS SOURCE:\n\n$source";
     };
 }
@@ -1685,7 +1687,7 @@ sub _parse_generated_file {
         or croak "Cannot open '$fn' for reading: $!";
 
     my $mark_re =
-        qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\n};
+        qr{^(# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:)([A-Za-z0-9/+]{22})\r?\n};
 
     my ($md5, $ts, $ver, $gen);
     while(<$fh>) {
@@ -1694,7 +1696,7 @@ sub _parse_generated_file {
             $md5 = $2;
 
             # Pull out the version and timestamp from the line above
-            ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)\Z/m;
+            ($ver, $ts) = $gen =~ m/^# Created by DBIx::Class::Schema::Loader v(.*?) @ (.*?)\r?\Z/m;
 
             $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"
@@ -1710,7 +1712,10 @@ sub _parse_generated_file {
     my $custom = do { local $/; <$fh> }
         if $md5;
 
-    close ($fh);
+    $custom ||= '';
+    $custom =~ s/$CRLF|$LF/\n/g;
+
+    close $fh;
 
     return ($gen, $md5, $ver, $ts, $custom);
 }

diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
index 7a48c73..4dee45e 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
+++ b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm
@@ -8,8 +8,7 @@ use Carp::Clan qw/^DBIx::Class/;
 use Scalar::Util 'weaken';
 use Lingua::EN::Inflect::Phrase ();
 use Lingua::EN::Tagger ();
-use DBIx::Class::Schema::Loader::Utils 'split_name';
-use File::Slurp 'read_file';
+use DBIx::Class::Schema::Loader::Utils qw/split_name slurp_file/;
 use Try::Tiny;
 use Class::Unload ();
 use Class::Inspector ();
@@ -646,7 +645,7 @@ sub _relnames_and_method {
             my $class = "${remote_class}Temporary";
 
             if (not Class::Inspector->loaded($class)) {
-                my $code = read_file($existing_remote_file, binmode => ':encoding(UTF-8)');
+                my $code = slurp_file $existing_remote_file;
 
                 $code =~ s/(?<=package $remote_class)/Temporary/g;
 

diff --git a/lib/DBIx/Class/Schema/Loader/Utils.pm b/lib/DBIx/Class/Schema/Loader/Utils.pm
index 667caee..a920890 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Utils.pm
+++ b/lib/DBIx/Class/Schema/Loader/Utils.pm
@@ -5,10 +5,11 @@ use strict;
 use warnings;
 use Data::Dumper ();
 use Test::More;
+use File::Slurp 'read_file';
 use namespace::clean;
 use Exporter 'import';
 
-our @EXPORT_OK = qw/split_name dumper dumper_squashed eval_package_without_redefine_warnings class_path no_warnings warnings_exist warnings_exist_silent/;
+our @EXPORT_OK = qw/split_name dumper dumper_squashed eval_package_without_redefine_warnings class_path no_warnings warnings_exist warnings_exist_silent slurp_file/;
 
 use constant BY_CASE_TRANSITION =>
     qr/(?<=[[:lower:]\d])[\W_]*(?=[[:upper:]])|[\W_]+/;
@@ -16,6 +17,9 @@ use constant BY_CASE_TRANSITION =>
 use constant BY_NON_ALPHANUM =>
     qr/[\W_]+/;
 
+my $LF   = "\x0a";
+my $CRLF = "\x0d\x0a";
+
 sub split_name($) {
     my $name = shift;
 
@@ -132,6 +136,13 @@ sub warnings_exist_silent(&$$) {
     ok $matched, $test_name;
 }
 
+sub slurp_file($) {
+    my $data = read_file(shift, binmode => ':encoding(UTF-8)');
+
+    $data =~ s/$CRLF|$LF/\n/g;
+
+    return $data;
+}
 
 1;
 # vim:et sts=4 sw=4 tw=0:

diff --git a/t/10_03pg_common.t b/t/10_03pg_common.t
index cbf0645..02f4683 100644 (file)
--- a/t/10_03pg_common.t
+++ b/t/10_03pg_common.t
@@ -1,14 +1,14 @@
 use strict;
-use lib qw(t/lib);
+use warnings;
+use utf8;
 use DBIx::Class::Schema::Loader 'make_schema_at';
-use DBIx::Class::Schema::Loader::Utils 'no_warnings';
-use dbixcsl_common_tests;
+use DBIx::Class::Schema::Loader::Utils qw/no_warnings slurp_file/;
 use Test::More;
 use Test::Exception;
-use File::Slurp 'slurp';
-use utf8;
-use Encode 'decode';
 use Try::Tiny;
+use namespace::clean;
+use lib qw(t/lib);
+use dbixcsl_common_tests ();
 
 my $dsn      = $ENV{DBICTEST_PG_DSN} || '';
 my $user     = $ENV{DBICTEST_PG_USER} || '';
@@ -211,7 +211,7 @@ my $tester = dbixcsl_common_tests->new(
             my $class    = $classes->{pg_loader_test1};
             my $filename = $schema->_loader->get_dump_filename($class);
 
-            my $code = decode('UTF-8', scalar slurp $filename);
+            my $code = slurp_file $filename;
 
             like $code, qr/^=head1 NAME\n\n^$class - The\nTable ∑\n\n^=cut\n/m,
                 'table comment';
@@ -222,7 +222,7 @@ my $tester = dbixcsl_common_tests->new(
             $class    = $classes->{pg_loader_test2};
             $filename = $schema->_loader->get_dump_filename($class);
 
-            $code = decode('UTF-8', scalar slurp $filename);
+            $code = slurp_file $filename;
 
             like $code, qr/^=head1 NAME\n\n^$class\n\n=head1 DESCRIPTION\n\n^very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very long comment\n\n^=cut\n/m,
                 'long table comment is in DESCRIPTION';

diff --git a/t/10_05ora_common.t b/t/10_05ora_common.t
index 25805e1..3eb59f5 100644 (file)
--- a/t/10_05ora_common.t
+++ b/t/10_05ora_common.t
@@ -1,9 +1,11 @@
 use strict;
-use lib qw(t/lib);
-use dbixcsl_common_tests;
+use warnings;
 use Test::More;
 use Test::Exception;
-use File::Slurp ();
+use DBIx::Class::Schema::Loader::Utils 'slurp_file';
+use namespace::clean;
+use lib qw(t/lib);
+use dbixcsl_common_tests;
 
 my $dsn      = $ENV{DBICTEST_ORA_DSN} || '';
 my $user     = $ENV{DBICTEST_ORA_USER} || '';
@@ -160,7 +162,7 @@ my $tester = dbixcsl_common_tests->new(
 
             my $class = $classes->{oracle_loader_test1};
             my $filename = $schema->_loader->get_dump_filename($class);
-            my $code = File::Slurp::slurp $filename;
+            my $code = slurp_file $filename;
 
             like $code, qr/^=head1 NAME\n\n^$class - oracle_loader_test1 table comment\n\n^=cut\n/m,
                 'table comment';

diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index 7fa48b4..4ee6d78 100644 (file)
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -12,11 +12,10 @@ use DBI;
 use Digest::MD5;
 use File::Find 'find';
 use Class::Unload ();
-use DBIx::Class::Schema::Loader::Utils 'dumper_squashed';
+use DBIx::Class::Schema::Loader::Utils qw/dumper_squashed slurp_file/;
 use List::MoreUtils 'apply';
 use DBIx::Class::Schema::Loader::Optional::Dependencies ();
 use Try::Tiny;
-use File::Slurp 'read_file';
 use File::Spec::Functions 'catfile';
 use File::Basename 'basename';
 use namespace::clean;
@@ -383,7 +382,7 @@ sub test_schema {
         'Result files dumped to first entry in result_namespace';
 
     # parse out the resultset_namespace
-    my $schema_code = read_file($conn->_loader->get_dump_filename(SCHEMA_CLASS), binmode => ':encoding(UTF-8)');
+    my $schema_code = slurp_file $conn->_loader->get_dump_filename(SCHEMA_CLASS);
 
     my ($schema_resultset_namespace) = $schema_code =~ /\bresultset_namespace => (.*)/;
     $schema_resultset_namespace = eval $schema_resultset_namespace;
@@ -824,7 +823,7 @@ qr/\n__PACKAGE__->load_components\("TestSchemaComponent", "\+TestSchemaComponent
                        $class6->column_info('Id2');
         ok($id2_info->{is_foreign_key}, 'Foreign key detected');
 
-        unlike read_file($conn->_loader->get_dump_filename($class6), binmode => ':encoding(UTF-8)'),
+        unlike slurp_file $conn->_loader->get_dump_filename($class6),
 qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
     \s+ "(\w+?)"
     .*?
@@ -832,7 +831,7 @@ qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
     \s+ "\1"/xs,
 'did not create two relationships with the same name';
 
-        unlike read_file($conn->_loader->get_dump_filename($class8), binmode => ':encoding(UTF-8)'),
+        unlike slurp_file $conn->_loader->get_dump_filename($class8),
 qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
     \s+ "(\w+?)"
     .*?