lib/SQL/Translator/Parser/DBIx/Class.pm

   1 package SQL::Translator::Parser::DBIx::Class;
   2
   3 # AUTHOR: Jess Robinson
   4
   5 use strict;
   6 use warnings;
   7 use vars qw($DEBUG $VERSION @EXPORT_OK);
   8 $DEBUG = 0 unless defined $DEBUG;
   9 $VERSION = sprintf "%d.%02d", q$Revision 1.0$ =~ /(\d+)\.(\d+)/;
  10
  11 use Exporter;
  12 use Data::Dumper;
  13 use SQL::Translator::Utils qw(debug normalize_name);
  14
  15 use base qw(Exporter);
  16
  17 @EXPORT_OK = qw(parse);
  18
  19 # -------------------------------------------------------------------
  20 # parse($tr, $data)
  21 #
  22 # Note that $data, in the case of this parser, is unuseful.
  23 # We're working with DBIx::Class Schemas, not data streams.
  24 # -------------------------------------------------------------------
  25 sub parse {
  26     my ($tr, $data) = @_;
  27     my $args        = $tr->parser_args;
  28     my $dbixschema  = $args->{'DBIx::Schema'} || $data;
  29
  30     die 'No DBIx::Schema' unless ($dbixschema);
  31     if (!ref $dbixschema) {
  32       eval "use $dbixschema;";
  33       die "Can't load $dbixschema ($@)" if($@);
  34     }
  35
  36     my $schema      = $tr->schema;
  37     my $table_no    = 0;
  38
  39 #    print Dumper($dbixschema->registered_classes);
  40
  41     foreach my $tableclass ($dbixschema->registered_classes)
  42     {
  43         eval "use $tableclass";
  44         print("Can't load $tableclass"), next if($@);
  45         my $source = $tableclass->result_source_instance;
  46
  47         my $table = $schema->add_table(
  48                                        name => $source->name,
  49                                        type => 'TABLE',
  50                                        ) || die $schema->error;
  51         my $colcount = 0;
  52         foreach my $col ($source->columns)
  53         {
  54             # assuming column_info in dbix is the same as DBI (?)
  55             # data_type is a number, column_type is text?
  56             my %colinfo = (
  57               name => $col,
  58               default_value => '',
  59               size => 0,
  60               is_auto_increment => 0,
  61               is_foreign_key => 0,
  62               is_nullable => 0,
  63               %{$source->column_info($col)}
  64             );
  65             my $f = $table->add_field(%colinfo) || die $table->error;
  66         }
  67         $table->primary_key($source->primary_columns);
  68
  69
  70         my @rels = $source->relationships();
  71         foreach my $rel (@rels)
  72         {
  73             my $rel_info = $source->relationship_info($rel);
  74             print "Accessor: $rel_info->{attrs}{accessor}\n";
  75             next if(!exists $rel_info->{attrs}{accessor} ||
  76                     $rel_info->{attrs}{accessor} ne 'filter');
  77             my $rel_table = $source->related_source($rel)->name; # rel_info->{class}->table();
  78             my $cond = (keys (%{$rel_info->{cond}}))[0];
  79             my ($refkey) = $cond =~ /^\w+\.(\w+)$/;
  80             if($rel_table && $refkey)
  81             {
  82                 $table->add_constraint(
  83                             type             => 'foreign_key',
  84                             name             => "fk_${rel}_id",
  85                             fields           => $rel,
  86                             reference_fields => $refkey,
  87                             reference_table  => $rel_table,
  88                                        );
  89             }
  90         }
  91     }
  92
  93 }
  94
  95 1;