From: Darren Chamberlain Date: Thu, 7 Mar 2002 14:11:40 +0000 (+0000) Subject: Reverted to a version 1.1, due to botched branch attempt. X-Git-Tag: v0.01~61 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=dfb4c91563f003b9c4c3ea0323e7962c00861368;p=dbsrgits%2FSQL-Translator.git Reverted to a version 1.1, due to botched branch attempt. --- diff --git a/lib/SQL/Translator.pm b/lib/SQL/Translator.pm index f1c7ed1..97164bf 100644 --- a/lib/SQL/Translator.pm +++ b/lib/SQL/Translator.pm @@ -1,446 +1,199 @@ package SQL::Translator; #----------------------------------------------------- -# $Id: Translator.pm,v 1.2 2002-03-07 14:06:20 dlc Exp $ -#----------------------------------------------------- -# Copyright (C) 2002 Ken Y. Clark , -# darren chamberlain -# -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License as -# published by the Free Software Foundation; version 2. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. +# $Id: Translator.pm,v 1.3 2002-03-07 14:11:40 dlc Exp $ # -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA -# 02111-1307 USA -# ------------------------------------------------------------------- - -=head1 NAME - -SQL::Translator - convert schema from one database to another - -=head1 SYNOPSIS - - use SQL::Translator; - my $translator = SQL::Translator->new; - my $output = $translator->translate( - parser => 'mysql', - producer => 'oracle', - file => $file, - ) or die $translator->error; - print $output; - -=head1 DESCRIPTION - -This module attempts to simplify the task of converting one database -create syntax to another through the use of Parsers and Producers. -The idea is that any Parser can be used with any Producer in the -conversion process. So, if you wanted PostgreSQL-to-Oracle, you could -just write the PostgreSQL parser and use an existing Oracle producer. - -Currently, the existing parsers use Parse::RecDescent, and the -producers are just printing formatted output of the parsed data -structure. New parsers don't necessarily have to use -Parse::RecDescent, however, as long as the data structure conforms to -what the producers are expecting. With this separation of code, it is -hoped that developers will find it easy to add more database dialects -by using what's written, writing only what they need, and then -contributing their parsers or producers back to the project. - -=cut +# File : SQL/Translator.pm +# Programmer : Ken Y. Clark, kclark@logsoft.com +# Created : 2002/02/27 +# Purpose : convert schema from one database to another +#----------------------------------------------------- use strict; -use vars qw($VERSION $DEFAULT_SUB $DEBUG); -$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/; -$DEBUG = 1 unless defined $DEBUG; - -$DEFAULT_SUB = sub { $_[0] } unless defined $DEFAULT_SUB; -*isa = \&UNIVERSAL::isa; +use vars qw( $VERSION ); +$VERSION = (qw$Revision: 1.3 $)[-1]; -=head1 CONSTRUCTOR +use Data::Dumper; -The constructor is called B, and accepts a hash of options. -Valid options are: +use SQL::Translator::Parser::MySQL; +use SQL::Translator::Parser::Sybase; +use SQL::Translator::Producer::Oracle; +use SQL::Translator::Producer::XML; -=over 4 - -=item parser (aka from) - -=item producer (aka to) - -=item filename - -=back - -All options are, well, optional; these attributes can be set via -instance methods. - -=cut +# +# These are the inputs we can parse. +# +my %parsers = ( + mysql => 'MySQL', + sybase => 'Sybase', +); -# {{{ new +# +# These are the formats we can produce. +# +my %producers = ( + oracle => 'Oracle', + xml => 'XML', +); +#----------------------------------------------------- sub new { +# +# Makes a new object. Intentionally made very bare as +# it is used by all subclasses (unless they override, +# of course). +# my $class = shift; - my $args = isa($_[0], 'HASH') ? shift : { @_ }; - my $self = bless { } => $class; - - # - # Set the parser and producer. If a 'parser' or 'from' parameter - # is passed in, use that as the parser; if a 'producer' or 'to' - # parameter is passed in, use that as the producer; both default - # to $DEFAULT_SUB. - # - $self->parser( $args->{'parser'} || $args->{'from'} || $DEFAULT_SUB); - $self->producer($args->{'producer'} || $args->{'to'} || $DEFAULT_SUB); - - # - # Clear the error - # - $self->error_out(""); - - return $self; + my %args = @_; + my $self = { %args }; + return bless $self, $class; } -# }}} - -=head1 METHODS - - -=head2 B - -The B method is an accessor/mutator, used to retrieve or -define what subroutine is called to produce the output. A subroutine -defined as a producer subroutine will be invoked as a function (not a -method) and passed a data structure as its only argument. It is -expected that the function transform the data structure to the output -format, and return a string. - -When defining a producer, one of three things can be passed -in: A full module name (e.g., My::Groovy::Parser), a module name -relative to the SQL::Translator::Producer namespace (e.g., MySQL), or -a reference to an anonymous subroutine. If a full module name is -passed in, it is treated as a package, and a function called -"transform" will be invoked as $modulename::transform. - - my $tr = SQL::Translator->new; - - # This will invoke My::Groovy::Producer::transform($data) - $tr->producer("My::Groovy::Producer"); - - # This will invoke SQL::Translator::Producer::Sybase::transform($data) - $tr->producer("Sybase"); - - # This will inoke the referenced subroutine directly - $tr->producer(\&my_producer); - -=cut -# TODO Make mod_perl-like assumptions about the name being passed in: -# try to load the module; if that fails, pop off the last piece -# (everything after the last ::) and try to load that; if that loads, -# use the popped off piece as the function name, and not transform. - -# {{{ producer -sub producer { - my $self = shift; - if (@_) { - my $producer = shift; - if ($producer =~ /::/) { - load($producer) or die "Can't load $producer: $@"; - $self->{'producer'} = \&{ "$producer\::'producer'" }; - $self->debug("Got 'producer': $producer\::'producer'"); - } elsif (isa($producer, 'CODE')) { - $self->{'producer'} = $producer; - $self->debug("Got 'producer': code ref"); - } else { - my $Pp = sprintf "SQL::Translator::Producer::$producer"; - load($Pp) or die "Can't load $Pp: $@"; - $self->{'producer'} = \&{ "$Pp\::translate" }; - $self->debug("Got producer: $Pp"); - } - # At this point, $self->{'producer'} contains a subroutine - # reference that is ready to run! - } - return $self->{'producer'}; -}; -# }}} -=head2 B - -The B method defines or retrieves a subroutine that will be -called to perform the parsing. The basic idea is the same as that of -B (see above), except the default subroutine name is -"parse", and will be invoked as $module_name::parse. Also, the parser -subroutine will be passed a string containing the entirety of the data -to be parsed. - - # Invokes SQL::Translator::Parser::MySQL::parse() - $tr->parser("MySQL"); - - # Invokes My::Groovy::Parser::parse() - $tr->parser("My::Groovy::Parser"); - - # Invoke an anonymous subroutine directly - $tr->parser(sub { - my $dumper = Data::Dumper->new([ $_[0] ], [ "SQL" ]); - $dumper->Purity(1)->Terse(1)->Deepcopy(1); - return $dumper->Dump; - }); - -=cut +#----------------------------------------------------- +sub error { +# +# Return the last error. +# + return shift()->{'error'} || ''; +} -# {{{ parser -sub parser { +#----------------------------------------------------- +sub error_out { +# +# Record the error and return undef. +# my $self = shift; - if (@_) { - my $parser = shift; - if ($parser =~ /::/) { - load($parser) or die "Can't load $parser: $@"; - $self->{'parser'} = \&{ "$parser\::parse" }; - $self->debug("Got parser: $parser\::parse"); - } elsif (isa($parser, 'CODE')) { - $self->{'parser'} = $parser; - $self->debug("Got parser: code ref"); - } else { - my $Pp = "SQL::Translator::Parser::$parser"; - load($Pp) or die "Can't load $Pp: $@"; - $self->{'parser'} = \&{ "$Pp\::parse" }; - $self->debug("Got parser: $Pp"); - } - # At this point, $self->{$pp} contains a subroutine - # reference that is ready to run! + if ( my $error = shift ) { + $self->{'error'} = $error; } - return $self->{'parser'}; + return; } -# }}} - -=head2 B -The B method calls the subroutines referenced by the -B and B data members (described above). It accepts -as arguments a number of things, in key => value format, including -(potentially) a parser and a producer (they are passed directly to the -B and B methods). - -Here is how the parameter list to B is parsed: - -=over - -=item * - -1 argument means it's the data to be parsed; which could be a string -(filename), a reference to a GLOB (filehandle from which to read a -string), a refernce to a scalar (a string stored in memory), or a -reference to a hash (which means the same thing as below). - - # Parse the file /path/to/datafile - my $output = $tr->translate("/path/to/datafile"); - - # The same thing: - my $fh = IO::File->new("/path/to/datafile"); - my $output = $tr->translate($fh); - - # Again, the same thing: - my $fh = IO::File->new("/path/to/datafile"); - my $data = { local $/; <$fh> }; - my $output = $tr->translate(\$data); - -=item * - -> 1 argument means its a hash of things, and it might be setting a -parser, producer, or datasource (this key is named "filename" or -"file" if it's a file, or "data" for a GLOB or SCALAR reference). - - # As above, parse /path/to/datafile, but with different producers - for my $prod ("MySQL", "XML", "Sybase") { - print $tr->translate( - producer => $prod, - filename => "/path/to/datafile", - ); - } - - # The filename hash key could also be: - datasource => $fh, - - # or - datasource => \$data, - -You get the idea. - -=back - -=cut - -# {{{ translate +#----------------------------------------------------- sub translate { - my $self = shift; - my ($args, $parser, $producer); - - if (@_ == 1) { - if (isa($_[0], 'HASH')) { - # Passed a hashref - $args = $_[0]; - } - elsif (isa($_[0], 'GLOB')) { - # passed a filehandle; slurp it - local $/; - $args = { data => <$_[0]> }; - } - elsif (isa($_[0], 'SCALAR')) { - # passed a ref to a string; deref it - $args = { data => ${$_[0]} }; - } - else { - # Not a ref, it's a filename - $args = { filename => $_[0] }; - } +# +# Translates any number of given files. +# + my ( $self, %args ) = @_; + my $from = $args{'from'} || ''; + my $to = $args{'to'} || ''; + my $input = $args{'input'} || []; + my $verbose = $args{'verbose'} || 0; + my $no_comments = $args{'no_comments'} || 0; + + if ( exists $parsers{ $from } ) { + $self->{'from'} = $from; + warn "Using parser '$from.'\n" if $verbose; } else { - # Should we check if @_ % 2, or just eat the errors if they occur? - $args = { @_ }; + my $msg = "The parsers '$from' is not valid.\n" . + "Please choose from the following list:\n"; + $msg .= " $_\n" for sort keys %parsers; + return $self->error_out( $msg ); } - if ((defined $args->{'filename'} || - defined $args->{'file'} ) && not $args->{'data'}) { - local *FH; - local $/; - - open FH, $args->{'filename'} or die $!; - $args->{'data'} = ; - close FH or die $!; + if ( exists $producers{ $to } ) { + $self->{'to'} = $to; + warn "Using producer '$to.'\n" if $verbose; } - - # - # Last chance to bail out; if there's nothing in the data - # key of %args, back out. - # - return unless defined $args->{'data'}; - - # - # Local reference to the parser subroutine - # - if ($parser = ($args->{'parser'} || $args->{'from'})) { - $self->parser($parser); - } else { - $parser = $self->parser; + else { + my $msg = "The producer '$to' is not valid.\n" . + "Please choose from the following list:\n"; + $msg .= " $_\n" for sort keys %producers; + return $self->error_out( $msg ); } # - # Local reference to the producer subroutine + # Slurp the entire text file we're parsing. # - if ($producer = ($args->{'producer'} || $args->{'to'})) { - $self->producer($producer); - } else { - $producer = $self->producer; + my $parser = $self->parser; + my $producer = $self->producer; + my $data; + for my $file ( @$input ) { + warn "Parsing file '$file.'\n" if $verbose; + open my $fh, $file or return $self->error_out( "Can't read $file: $!" ); + local $/; + $data = $parser->parse( <$fh> ); } - # - # Execute the parser, then execute the producer with that output - # - my $translated = $parser->($args->{'data'}); - - return $producer->($translated); + warn "Data =\n", Dumper( $data ) if $verbose; + my $output = $producer->translate( $data ); } -# }}} - -=head2 B -The error method returns the last error. - -=cut - -# {{{ error #----------------------------------------------------- -sub error { +sub parser { # -# Return the last error. +# Figures out which module to load based on the "from" argument # - return shift()->{'error'} || ''; -} -# }}} - -=head2 B - -Record the error and return undef. The error can be retrieved by -calling programs using $tr->error. - -For Parser or Producer writers, primarily. - -=cut - -# {{{ error_out -sub error_out { my $self = shift; - if ( my $error = shift ) { - $self->{'error'} = $error; + unless ( $self->{'parser'} ) { + my $parser_module = + 'SQL::Translator::Parser::'.$parsers{ $self->{'from'} }; + $self->{'parser'} = $parser_module->new; } - return; + return $self->{'parser'}; } -# }}} - -=head2 B - -If the global variable $SQL::Translator::DEBUG is set to a true value, -then calls to $tr->debug($msg) will be carped to STDERR. If $DEBUG is -not set, then this method does nothing. - -=cut -# {{{ debug -use Carp qw(carp); -sub debug { +#----------------------------------------------------- +sub producer { +# +# Figures out which module to load based on the "to" argument +# my $self = shift; - carp @_ if ($DEBUG); -} -# }}} - -# {{{ load -sub load { - my $module = do { my $m = shift; $m =~ s[::][/]g; "$m.pm" }; - return 1 if $INC{$module}; - - eval { require $module }; - - return if ($@); - return 1; + unless ( $self->{'producer'} ) { + my $from = $parsers{ $self->{'from'} }; + my $producer_module = + 'SQL::Translator::Producer::'.$producers{ $self->{'to'} }; + $self->{'producer'} = $producer_module->new( from => $from ); + } + return $self->{'producer'}; } -# }}} 1; -__END__ #----------------------------------------------------- # Rescue the drowning and tie your shoestrings. # Henry David Thoreau #----------------------------------------------------- -=head1 AUTHOR +=head1 NAME -Ken Y. Clark, Ekclark@logsoft.comE, -darren chamberlain Edarren@cpan.orgE +SQL::Translator - convert schema from one database to another -=head1 COPYRIGHT +=head1 SYNOPSIS -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; version 2. + use SQL::Translator; + my $translator = SQL::Translator->new; + my $output = $translator->translate( + from => 'mysql', + to => 'oracle', + file => $file, + ) or die $translator->error; + print $output; + +=head1 DESCRIPTION -This program is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. +This module attempts to simplify the task of converting one database +create syntax to another through the use of Parsers and Producers. +The idea is that any Parser can be used with any Producer in the +conversion process. So, if you wanted PostgreSQL-to-Oracle, you could +just write the PostgreSQL parser and use an existing Oracle producer. + +Currently, the existing parsers use Parse::RecDescent, and the +producers are just printing formatted output of the parsed data +structure. New parsers don't necessarily have to use +Parse::RecDescent, however, as long as the data structure conforms to +what the producers are expecting. With this separation of code, it is +hoped that developers will find it easy to add more database dialects +by using what's written, writing only what they need, and then +contributing their parsers or producers back to the project. + +=head1 AUTHOR -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -USA +Ken Y. Clark, kclark@logsoft.com =head1 SEE ALSO -L, L +perl(1). =cut