use DBIx::Class::Schema::Loader::Optional::Dependencies ();
use Try::Tiny;
use DBIx::Class ();
-use Encode qw/encode/;
+use Encode qw/encode decode/;
use List::MoreUtils 'all';
+use IPC::Open2;
+use Symbol 'gensym';
use namespace::clean;
our $VERSION = '0.07010';
class_to_table
uniq_to_primary
quiet
-
- filter_generated_text
/);
datetime_undef_if_invalid
_result_class_methods
naming_set
+ filter_generated_code
/);
my $CURRENT_V = 'v7';
result_roles
);
+my $CR = "\x0d";
my $LF = "\x0a";
my $CRLF = "\x0d\x0a";
on tables to primary keys, assuming there is only one largest unique
constraint.
-=head2 filter_generated_text
+=head2 filter_generated_code
+
+An optional hook that lets you filter the generated text for various classes
+through a function that change it in any way that you want. The function will
+receive the type of file, C<schema> or C<result>, class and code; and returns
+the new code to use instead. For instance you could add custom comments, or do
+anything else that you want.
-An optional hook that lets you filter the generated text for various classes through
-a function that change it in any way that you want. The function will receive the class
-and text, and returns the new text to use instead. For instance you could add
-custom comment, run C<perltidy>, or do anything else that you want.
+The option can also be set to a string, which is then used as a filter program,
+e.g. C<perltidy>.
-If this exists but fails to return text matching C</package/>, no file will be generated.
+If this exists but fails to return text matching C</\bpackage\b/>, no file will
+be generated.
- filter_generated_base => sub {
- my ($class, $text) = @_;
+ filter_generated_code => sub {
+ my ($type, $class, $text) = @_;
...
- return $new_text;
+ return $new_code;
}
=head1 METHODS
}
}
+ if (defined(my $filter = $self->filter_generated_code)) {
+ my $reftype = ref $filter;
+ if ($reftype && $reftype ne 'CODE') {
+ croak "Invalid type $reftype for option 'filter_generated_code, must be a scalar or a CODE reference";
+ }
+ }
+
$self;
}
$text .= qq|$_\n|
for @{$self->{_dump_storage}->{$class} || []};
- if ($self->{filter_generated_text}) {
- $text = $self->{filter_generated_text}->($class, $text);
- if (not $text or not $text =~ /package/) {
+ if ($self->filter_generated_code) {
+ my $filter = $self->filter_generated_code;
+
+ if (ref $filter eq 'CODE') {
+ $text = $filter->(
+ ($is_schema ? 'schema' : 'result'),
+ $class,
+ $text
+ );
+ }
+ else {
+ my ($out, $in) = (gensym, gensym);
+
+ my $pid = open2($out, $in, $filter)
+ or croak "Could not open pipe to $filter: $!";
+
+ print $in $text;
+
+ close $in;
+
+ $text = decode('UTF-8', do { local $/; <$out> });
+
+ $text =~ s/$CR?$LF/\n/g;
+
+ waitpid $pid, 0;
+
+ my $exit_code = $? >> 8;
+
+ 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;
}
use strict;
-use File::Slurp qw(slurp);
+use DBIx::Class::Schema::Loader;
+use DBIx::Class::Schema::Loader::Utils 'slurp_file';
use File::Path;
-use Test::More tests => 4;
+use Test::More tests => 19;
use Test::Exception;
use lib qw(t/lib);
use make_dbictest_db;
use dbixcsl_test_dir qw/$tdir/;
-use DBIx::Class::Schema::Loader;
-
my $dump_path = "$tdir/dump";
my %original_class_data;
+my ($schema_file_count, $result_file_count);
+
{
package DBICTest::Schema::1;
- use base qw/ DBIx::Class::Schema::Loader /;
+ use Test::More;
+ use base 'DBIx::Class::Schema::Loader';
__PACKAGE__->loader_options(
dump_directory => $dump_path,
- filter_generated_text => sub {
- my ($class, $text) = @_;
+ quiet => 1,
+ filter_generated_code => 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';
+ }
+
$original_class_data{$class} = $text;
if ($class =~ /::1$/) {
$text = "No Gotcha!";
}
else {
- $text .= q{"Kilroy was here";};
+ $text .= q{my $foo = "Kilroy was here";};
}
return $text;
},
);
}
+{
+ package DBICTest::Schema::2;
+ use base 'DBIx::Class::Schema::Loader';
+ __PACKAGE__->loader_options(
+ dump_directory => $dump_path,
+ quiet => 1,
+ filter_generated_code => "$^X t/bin/simple_filter",
+ );
+}
+
DBICTest::Schema::1->connect($make_dbictest_db::dsn);
-my $foo = slurp("$dump_path/DBICTest/Schema/1/Result/Foo.pm");
+# 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";
ok(! -e "$dump_path/DBICTest/Schema/1.pm",
"No package means no file written");
ok($original_class_data{"DBICTest::Schema::1"},
"We get the whole autogenerated text");
like($foo, qr/Kilroy was here/, "Can insert text");
+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";
+
END { rmtree($dump_path, 1, 1); }
projects / dbsrgits/DBIx-Class-Schema-Loader.git / commitdiff