package SQL::Translator;
# ----------------------------------------------------------------------
-# $Id: Translator.pm,v 1.25 2003-05-06 12:44:54 dlc Exp $
+# $Id: Translator.pm,v 1.37 2003-07-31 20:49:42 dlc Exp $
# ----------------------------------------------------------------------
# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
# darren chamberlain <darren@cpan.org>,
use vars qw( $VERSION $REVISION $DEFAULT_SUB $DEBUG $ERROR );
use base 'Class::Base';
-$VERSION = '0.01';
-$REVISION = sprintf "%d.%02d", q$Revision: 1.25 $ =~ /(\d+)\.(\d+)/;
+require 5.004;
+
+$VERSION = '0.02';
+$REVISION = sprintf "%d.%02d", q$Revision: 1.37 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 0 unless defined $DEBUG;
$ERROR = "";
use Carp qw(carp);
+use Class::Base;
use File::Spec::Functions qw(catfile);
use File::Basename qw(dirname);
use IO::Dir;
+use SQL::Translator::Schema;
# ----------------------------------------------------------------------
# The default behavior is to "pass through" values (note that the
# SQL::Translator instance is the first value ($_[0]), and the stuff
# to be parsed is the second value ($_[1])
# ----------------------------------------------------------------------
-$DEFAULT_SUB = sub { $_[1] } unless defined $DEFAULT_SUB;
+$DEFAULT_SUB = sub { $_[0]->schema } unless defined $DEFAULT_SUB;
# ----------------------------------------------------------------------
# init([ARGS])
# ----------------------------------------------------------------------
sub init {
my ( $self, $config ) = @_;
-
#
# Set the parser and producer.
#
$self->add_drop_table( $config->{'add_drop_table'} );
- $self->custom_translate( $config->{'xlate'} );
-
$self->no_comments( $config->{'no_comments'} );
$self->show_warnings( $config->{'show_warnings'} );
$self->trace( $config->{'trace'} );
+ $self->validate( $config->{'validate'} );
+
return $self;
}
return $self->{'add_drop_table'} || 0;
}
-
-# ----------------------------------------------------------------------
-# custom_translate([$bool])
-# ----------------------------------------------------------------------
-sub custom_translate {
- my $self = shift;
- $self->{'custom_translate'} = shift if @_;
- return $self->{'custom_translate'} || {};
-}
-
# ----------------------------------------------------------------------
# no_comments([$bool])
# ----------------------------------------------------------------------
return $self->{'data'};
}
+# ----------------------------------------------------------------------
+sub schema {
+#
+# Returns the SQL::Translator::Schema object
+#
+ my $self = shift;
+ unless ( defined $self->{'schema'} ) {
+ $self->{'schema'} = SQL::Translator::Schema->new;
+ }
+
+ return $self->{'schema'};
+}
+
+# ----------------------------------------------------------------------
sub trace {
my $self = shift;
my $arg = shift;
return $self->error($msg);
}
- eval { $producer_output = $producer->($self, $parser_output) };
+ if ($self->validate) {
+ my $schema = $self->schema;
+ return $self->error('Invalid schema') unless $schema->is_valid;
+ }
+
+ eval { $producer_output = $producer->($self) };
if ($@ || ! $producer_output) {
my $msg = sprintf "translate: Error with producer '%s': %s",
$producer_type, ($@) ? $@ : " no results";
$self->{$type};
}
-
# ----------------------------------------------------------------------
# _list($type)
# ----------------------------------------------------------------------
my $path = catfile "SQL", "Translator", $uctype;
for (@INC) {
my $dir = catfile $_, $path;
- $self->debug("_list_${type}s searching $dir");
+ $self->debug("_list_${type}s searching $dir\n");
next unless -d $dir;
my $dh = IO::Dir->new($dir);
return 1;
}
+# ----------------------------------------------------------------------
sub format_table_name {
my $self = shift;
my $sub = shift;
return $sub;
}
+# ----------------------------------------------------------------------
sub format_package_name {
my $self = shift;
my $sub = shift;
return $sub;
}
+# ----------------------------------------------------------------------
sub format_fk_name {
my $self = shift;
- my $sub = shift;
- $self->{'_format_fk_name'} = $sub if ref $sub eq 'CODE';
- return $self->{'_format_fk_name'}->( $sub, @_ )
- if defined $self->{'_format_fk_name'};
- return $sub;
+
+ if ( ref $_[0] eq 'CODE' ) {
+ $self->{'_format_pk_name'} = shift;
+ }
+
+ if ( @_ ) {
+ if ( defined $self->{'_format_pk_name'} ) {
+ return $self->{'_format_pk_name'}->( @_ );
+ }
+ else {
+ return '';
+ }
+ }
+
+ return $self->{'_format_pk_name'};
+# my $sub = shift;
+# $self->{'_format_fk_name'} = $sub if ref $sub eq 'CODE';
+# return $self->{'_format_fk_name'}->( $sub, @_ )
+# if defined $self->{'_format_fk_name'};
+# return $sub;
}
+# ----------------------------------------------------------------------
sub format_pk_name {
my $self = shift;
- my $sub = shift;
- $self->{'_format_pk_name'} = $sub if ref $sub eq 'CODE';
- return $self->{'_format_pk_name'}->( $sub, @_ )
- if defined $self->{'_format_pk_name'};
- return $sub;
+
+ if ( ref $_[0] eq 'CODE' ) {
+ $self->{'_format_pk_name'} = shift;
+ }
+
+ if ( @_ ) {
+ if ( defined $self->{'_format_pk_name'} ) {
+ return $self->{'_format_pk_name'}->( @_ );
+ }
+ else {
+ return '';
+ }
+ }
+
+ return $self->{'_format_pk_name'};
}
# ----------------------------------------------------------------------
return UNIVERSAL::isa($ref, $type);
}
+# ----------------------------------------------------------------------
+sub validate {
+ my ( $self, $arg ) = @_;
+ if ( defined $arg ) {
+ $self->{'validate'} = $arg ? 1 : 0;
+ }
+ return $self->{'validate'} || 0;
+}
+
1;
-#-----------------------------------------------------
-# Rescue the drowning and tie your shoestrings.
-# Henry David Thoreau
-#-----------------------------------------------------
-__END__
+# ----------------------------------------------------------------------
+# Who killed the pork chops?
+# What price bananas?
+# Are you my Angel?
+# Allen Ginsberg
+# ----------------------------------------------------------------------
+
+=pod
=head1 NAME
-SQL::Translator - convert schema from one database to another
+SQL::Translator - manipulate structured data definitions (SQL and more)
=head1 SYNOPSIS
use SQL::Translator;
- my $translator = SQL::Translator->new(
- debug => 1, # Print debug info
- trace => 0, # Print Parse::RecDescent trace
- no_comments => 0, # Don't include comments in output
- show_warnings => 0, # Print name mutations, conflicts
- add_drop_table => 1, # Add "drop table" statements
-
+ my $translator = SQL::Translator->new(
+ # Print debug info
+ debug => 1,
+ # Print Parse::RecDescent trace
+ trace => 0,
+ # Don't include comments in output
+ no_comments => 0,
+ # Print name mutations, conflicts
+ show_warnings => 0,
+ # Add "drop table" statements
+ add_drop_table => 1,
+ # Validate schema object
+ validate => 1,
# Make all table names CAPS in producers which support this option
- format_table_name => sub {my $tablename = shift; return uc($tablename)},
-
+ format_table_name => sub {my $tablename = shift; return uc($tablename)},
# Null-op formatting, only here for documentation's sake
format_package_name => sub {return shift},
format_fk_name => sub {return shift},
);
my $output = $translator->translate(
- from => "MySQL",
- to => "Oracle",
+ from => 'MySQL',
+ to => 'Oracle',
# Or an arrayref of filenames, i.e. [ $file1, $file2, $file3 ]
filename => $file,
) or die $translator->error;
=head1 DESCRIPTION
-This module attempts to simplify the task of converting one database
-create syntax to another through the use of Parsers (which understand
-the source format) and Producers (which understand the destination
-format). The idea is that any Parser can be used with any Producer in
-the conversion process. So, if you wanted Postgres-to-Oracle, you
-would use the Postgres parser and the Oracle producer.
+SQL::Translator is a group of Perl modules that converts
+vendor-specific SQL table definitions into other formats, such as
+other vendor-specific SQL, ER diagrams, documentation (POD and HTML),
+XML, and Class::DBI classes. The main focus of SQL::Translator is
+SQL, but parsers exist for other structured data formats, including
+Excel spreadsheets and arbitrarily delimited text files. Through the
+separation of the code into parsers and producers with an object model
+in between, it's possible to combine any parser with any producer, to
+plug in custom parsers or producers, or to manipulate the parsed data
+via the built-in object model. Presently only the definition parts of
+SQL are handled (CREATE, ALTER), not the manipulation of data (INSERT,
+UPDATE, DELETE).
=head1 CONSTRUCTOR
debug
+=item *
+
+add_drop_table
+
+=item *
+
+no_comments
+
+=item *
+
+trace
+
+=item *
+
+validate
+
=back
All options are, well, optional; these attributes can be set via
Toggles whether or not to add "DROP TABLE" statements just before the
create definitions.
-=head2 custom_translate
-
-Allows the user to override default translation of fields. For example,
-if a MySQL "text" field would normally be converted to a "long" for Oracle,
-the user could specify to change it to a "CLOB." Accepts a hashref where
-keys are the "from" value and values are the "to," returns the current
-value of the field.
-
=head2 no_comments
Toggles whether to print comments in the output. Accepts a true or false
the C<translate> method is called, as long as the data instance
variable is not set.
-=pod
+=head2 schema
+
+Returns the SQL::Translator::Schema object.
=head2 trace
Turns on/off the tracing option of Parse::RecDescent.
-=pod
+=head2 validate
+
+Whether or not to validate the schema object after parsing and before
+producing.
=head1 AUTHORS
Ken Y. Clark, E<lt>kclark@cpan.orgE<gt>,
darren chamberlain E<lt>darren@cpan.orgE<gt>,
Chris Mungall E<lt>cjm@fruitfly.orgE<gt>,
-Allen Day E<lt>allenday@users.sourceforge.netE<gt>
+Allen Day E<lt>allenday@users.sourceforge.netE<gt>,
+Sam Angiuoli E<lt>angiuoli@users.sourceforge.netE<gt>,
+Ying Zhang E<lt>zyolive@yahoo.comE<gt>,
+Mike Mellilo <mmelillo@users.sourceforge.net>.
=head1 COPYRIGHT
L<perl>,
L<SQL::Translator::Parser>,
L<SQL::Translator::Producer>,
-L<Parse::RecDescent>
-
+L<Parse::RecDescent>,
+L<GD>,
+L<GraphViz>,
+L<Text::RecordParser>,
+L<Class::DBI>
+L<XML::Writer>.
projects / dbsrgits/SQL-Translator.git / blobdiff