From: Jess Robinson <castaway@desert-island.me.uk>
Date: Sun, 22 Jan 2006 16:47:01 +0000 (+0000)
Subject: CRayz-foo SQLT->DBIC schema creation
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c990f24a62ea542d2452d1d7d64b542df3d88a75;p=dbsrgits%2FDBIx-Class-Historic.git

CRayz-foo SQLT->DBIC schema creation
---

diff --git a/lib/SQL/Translator/Producer/DBIx/Class/File.pm b/lib/SQL/Translator/Producer/DBIx/Class/File.pm
new file mode 100644
index 0000000..e0702c0
--- /dev/null
+++ b/lib/SQL/Translator/Producer/DBIx/Class/File.pm
@@ -0,0 +1,145 @@
+package SQL::Translator::Producer::DBIx::Class::File;
+
+=head1 NAME
+
+SQL::Translator::Producer::DBIx::Class::File - DBIx::Class file producer
+
+=head1 SYNOPSIS
+
+  use SQL::Translator;
+
+  my $t = SQL::Translator->new( parser => '...', 
+                                producer => 'DBIx::Class::File' );
+  print $translator->translate( $file );
+
+=head1 DESCRIPTION
+
+Creates a DBIx::Class::Schema for use with DBIx::Class
+
+=cut
+
+use strict;
+use vars qw[ $VERSION $DEBUG $WARN ];
+$VERSION = '0.1';
+$DEBUG   = 0 unless defined $DEBUG;
+
+use SQL::Translator::Schema::Constants;
+use SQL::Translator::Utils qw(header_comment);
+
+## Skip all column type translation, as we want to use whatever the parser got.
+
+## Translate parsers -> PK::Auto::Foo, however
+
+my %parser2PK = (
+                 MySQL       => 'PK::Auto::MySQL',
+                 PostgreSQL  => 'PK::Auto::Pg',
+                 DB2         => 'PK::Auto::DB2',
+                 Oracle      => 'PK::Auto::Oracle',
+                 );
+
+sub produce
+{
+    my ($translator) = @_;
+    $DEBUG             = $translator->debug;
+    $WARN              = $translator->show_warnings;
+    my $no_comments    = $translator->no_comments;
+    my $add_drop_table = $translator->add_drop_table;
+    my $schema         = $translator->schema;
+    my $output         = '';
+
+    # Steal the XML producers "prefix" arg for our namespace?
+    my $dbixschema     = $translator->producer_args()->{prefix} || 
+        $schema->name || 'My::Schema';
+    my $pkclass = $parser2PK{$translator->parser_type} || '';
+
+    my %tt_vars = ();
+    $tt_vars{dbixschema} = $dbixschema;
+    $tt_vars{pkclass} = $pkclass;
+
+    my $schemaoutput .= << "DATA";
+package ${dbixschema};
+use base 'DBIx::Class::Schema';
+DATA
+
+    my %tableoutput = ();
+    my %tableextras = ();
+    foreach my $table ($schema->get_tables)
+    {
+        my $tname = $table->name;
+        my $output .= qq{
+package ${dbixschema}::${tname};
+use base 'DBIx::Class';
+
+__PACKAGE__->load_components(qw/${pkclass} Core/);
+__PACKAGE__->table('${tname}');
+
+};
+
+        my @fields = map 
+        { { $_->name  => {
+            name              => $_->name,
+            is_auto_increment => $_->is_auto_increment,
+            is_foreign_key    => $_->is_foreign_key,
+            is_nullable       => $_->is_nullable,
+            default_value     => $_->default_value,
+            data_type         => $_->data_type,
+            size              => $_->size,
+        } }
+         } ($table->get_fields);
+
+        $output .= "\n__PACKAGE__->add_columns(";
+        foreach my $f (@fields)
+        {
+            local $Data::Dumper::Terse = 1;
+            $output .= "\n    '" . (keys %$f)[0] . "' => " ;
+            my $colinfo = 
+                Data::Dumper->Dump([values %$f],
+                                   [''] # keys   %$f]
+                                   );
+            chomp($colinfo);
+            $output .= $colinfo . ",";
+        }
+        $output .= "\n);\n";
+
+        my $pk = $table->primary_key;
+        if($pk)
+        {
+            my @pk = map { $_->name } ($pk->fields);
+            $output .= "__PACKAGE__->set_primary_key(";
+            $output .= "'" . join("', '", @pk) . "');";
+        }
+
+        foreach my $cont ($table->get_constraints)
+        {
+#            print Data::Dumper::Dumper($cont->type);
+            if($cont->type =~ /foreign key/i)
+            {
+                $output .= "\n__PACKAGE__->belongs_to('" . 
+                    $cont->fields->[0]->name . "', '" .
+                    "${dbixschema}::" . $cont->reference_table . "');\n";
+                
+                my $other = "\n__PACKAGE__->has_many('" .
+                    "get_" . $table->name. "', '" .
+                    "${dbixschema}::" . $table->name. "', '" .
+                    $cont->fields->[0]->name . "');";
+                $tableextras{$cont->reference_table} .= $other;
+            }
+        }
+
+        $tableoutput{$table->name} = $output;
+    }
+
+    foreach my $te (keys %tableextras)
+    {
+        $tableoutput{$te} .= $tableextras{$te} . "\n";
+    }
+
+
+    foreach my $to (keys %tableoutput)
+    {
+        $output .= $tableoutput{$to};
+    }
+
+    print "$output\n";
+    return $output;
+}