X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI.pm;h=f2bbc14f37381d5675ff4ff328a4806e2fb40efb;hb=b187901e0210a67eb8c62404316df5136dd71e14;hp=d3ce9b731699df245804af5e03d115624f43ea01;hpb=fc97257196b3cdd3df97526e2545a05d1e7c2b96;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm
index d3ce9b7..f2bbc14 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI.pm
@@ -194,6 +194,40 @@ sub _tables_list {
     return $self->_filter_tables(\@tables, $opts);
 }
 
+sub _recurse_constraint {
+    my ($constraint, @parts) = @_;
+
+    my $name = shift @parts;
+
+    # If there are any parts left, the constraint must be an arrayref
+    croak "depth of constraint/exclude array does not match length of moniker_parts"
+        unless !!@parts == !!(ref $constraint eq 'ARRAY');
+
+    # if ths is the last part, use the constraint directly
+    return $name =~ $constraint unless @parts;
+
+    # recurse into the first matching subconstraint
+    foreach (@{$constraint}) {
+        my ($re, $sub) = @{$_};
+        return _recurse_constraint($sub, @parts)
+            if $name =~ $re;
+    }
+    return 0;
+}
+
+sub _check_constraint {
+    my ($include, $constraint, @tables) = @_;
+
+    return @tables unless defined $constraint;
+
+    return grep { !$include xor _recurse_constraint($constraint, @{$_}) } @tables
+        if ref $constraint eq 'ARRAY';
+
+    return grep { !$include xor /$constraint/ } @tables;
+}
+
+
+
 # apply constraint/exclude and ignore bad tables and views
 sub _filter_tables {
     my ($self, $tables, $opts) = @_;
@@ -202,11 +236,8 @@ sub _filter_tables {
     my @filtered_tables;
 
     $opts ||= {};
-    my $constraint   = $opts->{constraint};
-    my $exclude      = $opts->{exclude};
-
-    @tables = grep { /$constraint/ } @tables if defined $constraint;
-    @tables = grep { ! /$exclude/  } @tables if defined $exclude;
+    @tables = _check_constraint(1, $opts->{constraint}, @tables);
+    @tables = _check_constraint(0, $opts->{exclude}, @tables);
 
     TABLE: for my $table (@tables) {
         try {