From 57038d70d872fe25f8cb87232288b0a125ed0b31 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 25 Jul 2016 15:52:13 +0100 Subject: [PATCH] Added hook to filter the custom content part --- lib/DBIx/Class/Schema/Loader/Base.pm | 93 ++++++++++++++++++---------- t/28filter_custom.t | 86 +++++++++++++++++++++++++ 2 files changed, 147 insertions(+), 32 deletions(-) create mode 100644 t/28filter_custom.t diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 07be607a0..07cd65f90 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -112,6 +112,7 @@ __PACKAGE__->mk_group_accessors('simple', qw/ _result_class_methods naming_set filter_generated_code + filter_custom_content db_schema qualify_objects moniker_parts @@ -1036,6 +1037,20 @@ ignore all text between the markers. return "#<<<\n$_[2]\n#>>>"; } +=head2 filter_custom_content + +An optional hook that lets you filter the custom content, or the ungenerated +portion of the file. This can be useful when managing a large schema. + + filter_custom_content => sub { + my ($type, $class, $text) = @_; + ... + return $new_code; + } + +The option can also be set to a string, which is then used as a filter program, +e.g. C. + =head1 METHODS None of these methods are intended for direct invocation by regular @@ -2131,39 +2146,8 @@ sub _write_classfile { if ($self->filter_generated_code) { my $filter = $self->filter_generated_code; + $text = _apply_filter( $filter, $text, $is_schema, $class ); - if (ref $filter eq 'CODE') { - $text = $filter->( - ($is_schema ? 'schema' : 'result'), - $class, - $text - ); - } - else { - my ($fh, $temp_file) = tempfile(); - - binmode $fh, ':encoding(UTF-8)'; - print $fh $text; - close $fh; - - open my $out, qq{$filter < "$temp_file"|} - or croak "Could not open pipe to $filter: $!"; - - $text = decode('UTF-8', do { local $/; <$out> }); - - $text =~ s/$CR?$LF/\n/g; - - close $out; - - my $exit_code = $? >> 8; - - unlink $temp_file - or croak "Could not remove temporary file '$temp_file': $!"; - - if ($exit_code != 0) { - croak "filter '$filter' exited non-zero: $exit_code"; - } - } if (not $text or not $text =~ /\bpackage\b/) { warn("$class skipped due to filter") if $self->debug; return; @@ -2199,6 +2183,13 @@ sub _write_classfile { print $fh qq|$_\n| for @{$self->{_ext_storage}->{$class} || []}; + # apply any custom content filter: + if ($self->filter_custom_content) { + my $filter = $self->filter_custom_content; + $custom_content = _apply_filter( $filter, $custom_content, $is_schema, $class ); + } + + # Write out any custom content the user has added print $fh $custom_content; @@ -2206,6 +2197,44 @@ sub _write_classfile { or croak "Error closing '$filename': $!"; } +sub _apply_filter{ + my( $filter, $text, $is_schema, $class ) = @_; + + if (ref $filter eq 'CODE') { + $text = $filter->( + ($is_schema ? 'schema' : 'result'), + $class, + $text + ); + } + else { + my ($fh, $temp_file) = tempfile(); + + binmode $fh, ':encoding(UTF-8)'; + print $fh $text; + close $fh; + + open my $out, qq{$filter < "$temp_file"|} + or croak "Could not open pipe to $filter: $!"; + + $text = decode('UTF-8', do { local $/; <$out> }); + + $text =~ s/$CR?$LF/\n/g; + + close $out; + + my $exit_code = $? >> 8; + + unlink $temp_file + or croak "Could not remove temporary file '$temp_file': $!"; + + if ($exit_code != 0) { + croak "filter '$filter' exited non-zero: $exit_code"; + } + } + return $text; +} + sub _default_moose_custom_content { my ($self, $is_schema) = @_; diff --git a/t/28filter_custom.t b/t/28filter_custom.t new file mode 100644 index 000000000..b89bdcf7e --- /dev/null +++ b/t/28filter_custom.t @@ -0,0 +1,86 @@ +use strict; +use warnings; +use DBIx::Class::Schema::Loader; +use DBIx::Class::Schema::Loader::Utils 'slurp_file'; +use File::Path; +use Test::More tests => 19; +use Test::Exception; +use lib qw(t/lib); +use make_dbictest_db; +use dbixcsl_test_dir qw/$tdir/; + +my $dump_path = "$tdir/dump"; + +my %original_class_data; + +my ($schema_file_count, $result_file_count); + +{ + package DBICTest::Schema::1; + use Test::More; + use base 'DBIx::Class::Schema::Loader'; + __PACKAGE__->loader_options( + dump_directory => $dump_path, + quiet => 1, + filter_custom_content => sub{ + my ($type, $class, $text) = @_; + like $type, qr/^(?:schema|result)\z/, + 'got correct file type'; + + if ($type eq 'schema') { + $schema_file_count++; + is $class, 'DBICTest::Schema::1', + 'correct class for schema type file passed to filter'; + } + elsif ($type eq 'result') { + $result_file_count++; + like $class, qr/^DBICTest::Schema::1::Result::(?:Foo|Bar)\z/, +# 'correct class for result type file passed to filter'; + } + else { + die 'invalid file type passed to filter'; + } + + unless( $text =~ /sub foo/ ){ + $text =~ s/1;\n/sub foo{ "x" }\n1;/; + } + + return $text; + }, + ); +} + +{ + package DBICTest::Schema::2; + use base 'DBIx::Class::Schema::Loader'; + __PACKAGE__->loader_options( + dump_directory => $dump_path, + quiet => 1, + filter_custom_content => "$^X t/bin/simple_filter", + ); +} + + + +DBICTest::Schema::1->connect($make_dbictest_db::dsn); + +# schema is generated in 2 passes + +is $schema_file_count, 2, + 'correct number of schema files passed to filter'; + +is $result_file_count, 4, + 'correct number of result files passed to filter'; +my $foo = slurp_file "$dump_path/DBICTest/Schema/1/Result/Foo.pm"; +like $foo, qr/package DBICTest::Schema::1::Result::Foo/, 'package statement intact'; +like $foo, qr/# Created by DBIx::Class::Schema::Loader/, 'end of generated comment seems to be there'; +like $foo, qr/# You can replace this text/, 'Comment in the custom text shows we haven\'t eradicated it'; +like $foo, qr/sub foo{ "x" }/, 'Can insert a sub'; + +DBICTest::Schema::2->connect($make_dbictest_db::dsn); + +$foo = slurp_file "$dump_path/DBICTest/Schema/2/Result/Foo.pm"; + +like $foo, qr/Kilroy was here/, + "Can insert text via command filter"; +