ground work. still to do is tests, docs, better code

diff --git a/lib/DBIx/Class/Core/View.pm b/lib/DBIx/Class/Core/View.pm
new file mode 100644 (file)
index 0000000..cec9da5
--- /dev/null
+++ b/lib/DBIx/Class/Core/View.pm
@@ -0,0 +1,65 @@
+package DBIx::Class::Core::View;
+
+use strict;
+use warnings;
+no warnings 'qw';
+
+use base qw/DBIx::Class/;
+
+__PACKAGE__->load_components(qw/
+  Relationship
+  InflateColumn
+  PK::Auto
+  PK
+  Row
+  ResultSourceProxy::View/);
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Core - Core set of DBIx::Class modules
+
+=head1 SYNOPSIS
+
+  # In your result classes
+  __PACKAGE__->load_components(qw/Core::View/);
+
+=head1 DESCRIPTION
+
+This class just inherits from the various modules that make up the
+L<DBIx::Class> core features.  You almost certainly want these.
+
+The core modules currently are:
+
+=over 4
+
+=item L<DBIx::Class::Serialize::Storable>
+
+=item L<DBIx::Class::InflateColumn>
+
+=item L<DBIx::Class::Relationship>
+
+=item L<DBIx::Class::PK::Auto>
+
+=item L<DBIx::Class::PK>
+
+=item L<DBIx::Class::Row>
+
+=item L<DBIx::Class::ResultSourceProxy::View>
+
+=back
+
+=head1 AUTHORS
+
+Matt S. Trout <mst@shadowcatsystems.co.uk>
+
+With Contributions from:
+
+Guillermo Roditi E<lt>groditi@cpan.orgE<gt>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut

diff --git a/lib/DBIx/Class/ResultSource/View.pm b/lib/DBIx/Class/ResultSource/View.pm
new file mode 100644 (file)
index 0000000..7d6ec12
--- /dev/null
+++ b/lib/DBIx/Class/ResultSource/View.pm
@@ -0,0 +1,52 @@
+package DBIx::Class::ResultSource::View;
+
+use strict;
+use warnings;
+
+use DBIx::Class::ResultSet;
+
+use base qw/DBIx::Class/;
+__PACKAGE__->load_components(qw/ResultSource/);
+
+
+  _columns _primaries _unique_constraints name resultset_attributes
+  schema from _relationships column_info_from_storage source_info
+  source_name/);
+
+
+=head1 NAME
+
+DBIx::Class::ResultSource::Table - Table object
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+Table object that inherits from L<DBIx::Class::ResultSource>
+
+=head1 METHODS
+
+=head2 from
+
+Returns the FROM entry for the table (i.e. the view name)
+
+=cut
+
+sub from { shift->name; }
+
+1;
+
+=head1 AUTHORS
+
+Matt S. Trout <mst@shadowcatsystems.co.uk>
+
+With Contributions from:
+
+Guillermo Roditi E<lt>groditi@cpan.orgE<gt>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+

diff --git a/lib/DBIx/Class/ResultSourceProxy/View.pm b/lib/DBIx/Class/ResultSourceProxy/View.pm
new file mode 100644 (file)
index 0000000..bbcd80c
--- /dev/null
+++ b/lib/DBIx/Class/ResultSourceProxy/View.pm
@@ -0,0 +1,144 @@
+package DBIx::Class::ResultSourceProxy::View;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::ResultSourceProxy/;
+
+use DBIx::Class::ResultSource::View;
+
+__PACKAGE__->mk_classdata(view_class => 'DBIx::Class::ResultSource::View');
+
+__PACKAGE__->mk_classdata('view_definition');
+__PACKAGE__->mk_classdata('view_alias'); # FIXME: Doesn't actually do
+                                          # anything yet!
+
+sub _init_result_source_instance {
+    my $class = shift;
+
+    $class->mk_classdata('result_source_instance')
+        unless $class->can('result_source_instance');
+
+    my $view = $class->result_source_instance;
+    my $class_has_view_instance = ($view and $view->result_class eq $class);
+    return $view if $class_has_view_instance;
+
+    if( $view ) {
+        $view = $class->view_class->new({
+            %$view,
+            result_class => $class,
+            source_name => undef,
+            schema => undef
+        });
+    }
+    else {
+        $view = $class->view_class->new({
+            name            => undef,
+            result_class    => $class,
+            source_name     => undef,
+        });
+    }
+
+    $class->result_source_instance($view);
+
+    if ($class->can('schema_instance')) {
+        $class =~ m/([^:]+)$/;
+        $class->schema_instance->register_class($class, $class);
+    }
+
+    return $view;
+}
+
+=head1 NAME
+
+DBIx::Class::ResultSourceProxy::View - provides a classdata view
+object and method proxies
+
+=head1 SYNOPSIS
+
+  #optional, for deploy support
+  __PACKAGE__->view_definition('SELECT cdid, artist, title, year FROM foo');
+
+  __PACKAGE__->view('cd');
+  __PACKAGE__->add_columns(qw/cdid artist title year/);
+  __PACKAGE__->set_primary_key('cdid');
+
+=head1 METHODS
+
+=head2 add_columns
+
+  __PACKAGE__->add_columns(qw/cdid artist title year/);
+
+Adds columns to the current class and creates accessors for them.
+
+=cut
+
+=head2 view
+
+  __PACKAGE__->view('view_name');
+  
+Gets or sets the view name.
+
+=cut
+
+sub view {
+  my ($class, $view) = @_;
+  return $class->result_source_instance->name unless $view;
+  unless (ref $view) {
+    $view = $class->view_class->new({
+        $class->can('result_source_instance') ?
+          %{$class->result_source_instance||{}} : (),
+        name => $view,
+        result_class => $class,
+        source_name => undef,
+    });
+  }
+
+  $class->mk_classdata('result_source_instance')
+    unless $class->can('result_source_instance');
+
+  $class->result_source_instance($view);
+
+  if ($class->can('schema_instance')) {
+    $class =~ m/([^:]+)$/;
+    $class->schema_instance->register_class($class, $class);
+  }
+  return $class->result_source_instance->name;
+}
+
+=head2 has_column
+
+  if ($obj->has_column($col)) { ... }
+
+Returns 1 if the class has a column of this name, 0 otherwise.
+
+=cut
+
+=head2 column_info
+
+  my $info = $obj->column_info($col);
+
+Returns the column metadata hashref for a column. For a description of
+the various types of column data in this hashref, see
+L<DBIx::Class::ResultSource/add_column>
+
+=cut
+
+=head2 columns
+
+  my @column_names = $obj->columns;
+
+=cut
+
+1;
+
+=head1 AUTHORS
+
+Matt S. Trout <mst@shadowcatsystems.co.uk>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+

diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm
index ce6e7e3..6d15bb9 100644 (file)
--- a/lib/SQL/Translator/Parser/DBIx/Class.pm
+++ b/lib/SQL/Translator/Parser/DBIx/Class.pm
@@ -65,8 +65,19 @@ sub parse {
         @monikers = grep { $sources->{$_} } @monikers;
     }
 
+    my(@table_monikers, @view_monikers);
+    for my $moniker (@monikers){
+      my $source = $dbicschema->source($moniker);
+       if ( $source->isa('DBIx::Class::ResultSource::Table') ||
+              $source->isa('DBIx::Class::ResultSourceProxy::Table') ) {
+         push(@table_monikers, $moniker);
+      } elsif( $source->isa('DBIx::Class::ResultSource::View') ||
+            $source->isa('DBIx::Class::ResultSourceProxy::View') ){
+         push(@view_monikers, $moniker);
+      }
+    }
 
-    foreach my $moniker (sort @monikers)
+    foreach my $moniker (sort @table_monikers)
     {
         my $source = $dbicschema->source($moniker);
         
@@ -219,6 +230,26 @@ sub parse {
         }
     }
 
+    foreach my $moniker (sort @view_monikers)
+    {
+        my $source = $dbicschema->source($moniker);
+        # Skip custom query sources
+        next if ref($source->name);
+
+        # Its possible to have multiple DBIC source using same table
+        next if $seen_tables{$source->name}++;
+
+        my $view = $sqlt->add_view(
+          name => $source->name,
+          fields => [ $source->columns ],
+          ($source->view_definition ? $source->view_definition : ())
+        );
+        if ($source->result_class->can('sqlt_deploy_hook')) {
+          $source->result_class->sqlt_deploy_hook($table);
+        }
+    }
+
+
     if ($dbicschema->can('sqlt_deploy_hook')) {
       $dbicschema->sqlt_deploy_hook($schema);
     }