From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 1 Aug 2009 23:05:18 +0000 (-0400)
Subject: SELECT statement generation
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-ResultSource-MultipleTableInheritance.git;a=commitdiff_plain;h=487f448916043c532f406e0b5a7fd8846b154d43

SELECT statement generation
---

diff --git a/lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm b/lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm
index 77cfded..8f5fe21 100644
--- a/lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm
+++ b/lib/DBIx/Class/ResultSource/MultipleTableInheritance.pm
@@ -122,4 +122,64 @@ method add_columns (@args) {
   return $ret;
 }
 
+BEGIN {
+
+  # helper routines, constructed as anon subs so autoclean nukes them
+
+  use signatures;
+
+  *argify = sub (@names) {
+    map '_'.$_, @names;
+  };
+
+  *qualify_with = sub ($source, @names) {
+    map join('.', $source->name, $_), @names;
+  };
+
+  *body_cols = sub ($source) {
+    my %pk; @pk{$source->primary_columns} = ();
+    map +{ %{$source->column_info($_)}, name => $_ },
+      grep !exists $pk{$_}, $source->columns;
+  };
+
+  *pk_cols = sub ($source) {
+    map +{ %{$source->column_info($_)}, name => $_ },
+      $source->primary_columns;
+  };
+
+  *names_of = sub (@cols) { map $_->{name}, @cols };
+
+  *arglist = sub (@cols) {
+    map join(' ', @{$_}{qw(name data_type)}), @cols;
+  };
+    
+}
+
+method view_definition () {
+  my $schema = $self->schema;
+  confess "Can't generate view without connected schema, sorry"
+    unless $schema && $schema->storage;
+  my $sqla = $schema->storage->sql_maker;
+  my @sources = my $table = $self->schema->source($self->raw_source_name);
+  my $super_view = $self->parent_source;
+  push(@sources, $super_view) if defined($super_view);
+  my @body_cols = map body_cols($_), @sources;
+  my @pk_cols = pk_cols $self;
+  my $select = $sqla->select(
+    ($super_view
+      ? ([   # FROM _tbl _tbl
+           { $table->name => $table->name },
+           [ # JOIN view view
+             { $super_view->name => $super_view->name },
+             # ON _tbl.id = view.id
+             { map +(qualify_with($super_view, $_), qualify_with($table, $_)),
+                 names_of @pk_cols }
+           ]
+         ])
+      : ($table->name)),
+    [ (qualify_with $table, names_of @pk_cols), names_of @body_cols ],
+  );
+  return $select;
+}
+
 1;
diff --git a/t/02view_def.t b/t/02view_def.t
new file mode 100644
index 0000000..1d82d4e
--- /dev/null
+++ b/t/02view_def.t
@@ -0,0 +1,15 @@
+use strict;
+use warnings;
+use lib 't/lib';
+use Test::More qw(no_plan);
+use Test::Exception;
+use Data::Dumper; $Data::Dumper::Indent = 1;
+
+BEGIN { use_ok 'MTITest'; }
+
+dies_ok { MTITest->source('Foo')->view_definition }
+  "Can't generate view def without connected schema";
+
+my $schema = MTITest->connect('dbi:SQLite::memory:');
+
+warn $schema->source($_)->view_definition for qw(Foo Bar);