Producer::Turnkey obsolete. now rely on TTSchema parser (see concommitant

turnkey commit).

modified TTschema to accept 'ttargs' in addition to already present 'ttfile'
so arbitrary template args can be interpolated.

added Schema::Graph unit test (!).  minimal.

introduced Log::Log4perl dependency.

modified Schema to have translator() slot to hold parent ref.  needed to
get at producer_args(), parser_args(), and _format_name() from Graph.pm

diff --git a/Build.PL b/Build.PL
index 4ced506..c1aa962 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -1,4 +1,4 @@
-# $Id: Build.PL,v 1.1 2004-07-30 15:27:36 kycl4rk Exp $
+# $Id: Build.PL,v 1.2 2004-10-15 03:52:50 allenday Exp $
 
 use strict;
 use Module::Build;
@@ -21,6 +21,7 @@ my $builder           =  Module::Build->new(
     requires          => {
         'Class::Base'             => 0,
         'IO::Dir'                 => 0,
+        'Log::Log4perl'           => 0,
         'Template'                => 2.10,
         'Parse::RecDescent'       => 1.94,
         'Pod::Usage'              => 0,

diff --git a/lib/SQL/Translator.pm b/lib/SQL/Translator.pm
index 74cc734..8326ac4 100644 (file)
--- a/lib/SQL/Translator.pm
+++ b/lib/SQL/Translator.pm
@@ -1,7 +1,7 @@
 package SQL::Translator;
 
 # ----------------------------------------------------------------------
-# $Id: Translator.pm,v 1.58 2004-10-15 02:23:29 allenday Exp $
+# $Id: Translator.pm,v 1.59 2004-10-15 03:52:50 allenday Exp $
 # ----------------------------------------------------------------------
 # Copyright (C) 2002-4 The SQLFairy Authors
 #
@@ -27,7 +27,7 @@ use base 'Class::Base';
 require 5.004;
 
 $VERSION  = '0.06';
-$REVISION = sprintf "%d.%02d", q$Revision: 1.58 $ =~ /(\d+)\.(\d+)/;
+$REVISION = sprintf "%d.%02d", q$Revision: 1.59 $ =~ /(\d+)\.(\d+)/;
 $DEBUG    = 0 unless defined $DEBUG;
 $ERROR    = "";
 
@@ -73,13 +73,14 @@ sub init {
     $self->parser  ($config->{'parser'}   || $config->{'from'} || $DEFAULT_SUB);
     $self->producer($config->{'producer'} || $config->{'to'}   || $DEFAULT_SUB);
 
-        #
-        # Set up callbacks for formatting of pk,fk,table,package names in producer
-        #
-        $self->format_table_name($config->{'format_table_name'});
-        $self->format_package_name($config->{'format_package_name'});
-        $self->format_fk_name($config->{'format_fk_name'});
-        $self->format_pk_name($config->{'format_pk_name'});
+    #
+    # Set up callbacks for formatting of pk,fk,table,package names in producer
+    # MOVED TO PRODUCER ARGS
+    #
+    #$self->format_table_name($config->{'format_table_name'});
+    #$self->format_package_name($config->{'format_package_name'});
+    #$self->format_fk_name($config->{'format_fk_name'});
+    #$self->format_pk_name($config->{'format_pk_name'});
 
     #
     # Set the parser_args and producer_args
@@ -427,8 +428,7 @@ sub schema {
 
     unless ( defined $self->{'schema'} ) {
         $self->{'schema'} = SQL::Translator::Schema->new(
-            parser_args     => $self->parser_args,
-            producer_args   => $self->producer_args,
+            translator      => $self,
         );
     }
 

diff --git a/lib/SQL/Translator/Producer/TTSchema.pm b/lib/SQL/Translator/Producer/TTSchema.pm
index d236b96..5c5b719 100644 (file)
--- a/lib/SQL/Translator/Producer/TTSchema.pm
+++ b/lib/SQL/Translator/Producer/TTSchema.pm
@@ -1,7 +1,7 @@
 package SQL::Translator::Producer::TTSchema;
 
 # -------------------------------------------------------------------
-# $Id: TTSchema.pm,v 1.4 2004-02-09 23:02:17 kycl4rk Exp $
+# $Id: TTSchema.pm,v 1.5 2004-10-15 03:52:50 allenday Exp $
 # -------------------------------------------------------------------
 # Copyright (C) 2002-4 SQLFairy Authors
 #
@@ -35,6 +35,7 @@ SQL::Translator::Producer::TTSchema -
       filename       => 'foo_schema.sql',
       to             => 'TTSchema',
       producer_args  => {
+          ttargs     => {},
           ttfile     => 'foo_template.tt',
       },
   );
@@ -72,6 +73,7 @@ the options.
       to               => 'TT',
       producer_args    => {
           ttfile       => 'foo_template.tt',
+          ttargs       => {},
           INCLUDE_PATH => '/foo/templates/tt',
           INTERPOLATE  => 1,
       },
@@ -91,7 +93,7 @@ limitless!
 use strict;
 
 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/;
 $DEBUG   = 0 unless defined $DEBUG;
 
 use Template;
@@ -118,7 +120,7 @@ sub produce {
         %$args,        # Allow any TT opts to be passed in the producer_args
     ) || die "Failed to initialize Template object: ".Template->error;
 
-    $tt->process( $file, { schema => $scma }, \$out ) 
+    $tt->process( $file, { schema => $scma , %{ $args->{ttargs} } }, \$out ) 
         or die "Error processing template '$file': ".$tt->error;
 
     return $out;

diff --git a/lib/SQL/Translator/Schema.pm b/lib/SQL/Translator/Schema.pm
index d2f9ba4..6f4ddfa 100644 (file)
--- a/lib/SQL/Translator/Schema.pm
+++ b/lib/SQL/Translator/Schema.pm
@@ -1,7 +1,7 @@
 package SQL::Translator::Schema;
 
 # ----------------------------------------------------------------------
-# $Id: Schema.pm,v 1.17 2004-10-15 02:23:30 allenday Exp $
+# $Id: Schema.pm,v 1.18 2004-10-15 03:52:50 allenday Exp $
 # ----------------------------------------------------------------------
 # Copyright (C) 2002-4 SQLFairy Authors
 #
@@ -55,7 +55,7 @@ use SQL::Translator::Utils 'parse_list_arg';
 use base 'Class::Base';
 use vars qw[ $VERSION $TABLE_ORDER $VIEW_ORDER $TRIGGER_ORDER $PROC_ORDER ];
 
-$VERSION = sprintf "%d.%02d", q$Revision: 1.17 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.18 $ =~ /(\d+)\.(\d+)/;
 
 # ----------------------------------------------------------------------
 sub init {
@@ -74,11 +74,16 @@ Object constructor.
 =cut
 
     my ( $self, $config ) = @_;
-    $self->params( $config, qw[ name database parser_args producer_args ] )
+    $self->params( $config, qw[ name database translator ] )
       || return undef;
     return $self;
 }
 
+sub as_graph {
+  my($self) = @_;
+  return SQL::Translator::Schema::Graph->new(translator => $self->translator);
+}
+
 # ----------------------------------------------------------------------
 sub add_table {
 
@@ -599,22 +604,16 @@ Get or set the schema's name.  (optional)
     return $self->{'name'} || '';
 }
 
-=head2 parser_args
-
-=cut
-
-sub parser_args {
-    my $self = shift;
-    return $self->{'parser_args'};
-}
+=head2 translator
 
-=head2 producer_args
+get the SQL::Translator instance that instatiated me
 
 =cut
 
-sub producer_args {
+sub translator {
     my $self = shift;
-    return $self->{'producer_args'};
+    $self->{'translator'} = shift if @_;
+    return $self->{'translator'};
 }
 
 # ----------------------------------------------------------------------

diff --git a/lib/SQL/Translator/Schema/Graph.pm b/lib/SQL/Translator/Schema/Graph.pm
index 097be2b..50b703b 100644 (file)
--- a/lib/SQL/Translator/Schema/Graph.pm
+++ b/lib/SQL/Translator/Schema/Graph.pm
@@ -5,6 +5,8 @@ use strict;
 use Data::Dumper;
 $Data::Dumper::Maxdepth = 3;
 
+use Log::Log4perl qw(:easy);
+Log::Log4perl->easy_init($ERROR);
 use SQL::Translator::Schema::Graph::Node;
 use SQL::Translator::Schema::Graph::Edge;
 use SQL::Translator::Schema::Graph::Port;
@@ -22,12 +24,13 @@ use Class::MakeMethods::Template::Hash (
   object => [
                         'translator' => {class => 'SQL::Translator'},
                        ],
-  'hash' => [ qw( node ) ],
+  'hash' => [ qw( node translator) ],
   'number --counter' => [ qw( order ) ],
 );
 
 sub init {
   my $self = shift;
+
   #
   # build package objects
   #
@@ -80,7 +83,7 @@ sub init {
 
          $that->edgecount($node->name, $that->edgecount($node->name)+1);
 
-      #warn "\t" . $node->name . "\t" . $node->edgecount($that->name);
+          #warn "\t" . $node->name . "\t" . $node->edgecount($that->name);
          $node->push_edges( $edge );
          $that->push_edges( $edge->flip );
       }
@@ -249,4 +252,16 @@ sub init {
 
 }
 
+=head2 translator
+
+get the SQL::Translator instance that instatiated me
+
+=cut
+
+sub translator {
+    my $self = shift;
+    $self->{'translator'} = shift if @_;
+    return $self->{'translator'};
+}
+
 1;

diff --git a/t/13schema.t b/t/13schema.t
index 8f787f3..1c776e6 100644 (file)
--- a/t/13schema.t
+++ b/t/13schema.t
@@ -4,9 +4,10 @@
 $| = 1;
 
 use strict;
-use Test::More tests => 202;
+use Test::More tests => 206;
 use SQL::Translator::Schema::Constants;
 
+require_ok( 'SQL::Translator' );
 require_ok( 'SQL::Translator::Schema' );
 
 {
@@ -339,6 +340,20 @@ require_ok( 'SQL::Translator::Schema' );
 
     my @views = $schema->get_views;
     is( scalar @views, 2, 'Found 1 view' );
+
+}
+
+#
+# Graph
+#
+{
+    my $tr = SQL::Translator->new(
+        parser   => "PostgreSQL",
+    );
+
+    ok( $tr->translate('t/data/pgsql/wiki.sql'), 'Translate PG' );
+    ok( my $schema = $tr->schema, 'Got Schema' );
+    ok( my $graph = $schema->as_graph, 'Graph made');
 }
 
 #