From: Darren Chamberlain Date: Wed, 27 Mar 2002 12:41:53 +0000 (+0000) Subject: Added MySQL producer (still in a pretty alpha stage, only barely functional). X-Git-Tag: v0.01~51 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9398955f2e1d829c624c84b59012f5ada40db594;p=dbsrgits%2FSQL-Translator.git Added MySQL producer (still in a pretty alpha stage, only barely functional). Updated Validator.pm. Added a few new bugs to BUGS. Added file, filename, and data methods to Translator.pm. Silly change to Makefile.PL that will most likely come out. --- diff --git a/BUGS b/BUGS index 7d5a614..4f59eb6 100644 --- a/BUGS +++ b/BUGS @@ -1,2 +1,7 @@ MySQL parser chokes on DEFAULT x NOT NULL, but works with NOT NULL DEFAULT x MySQL parser chokes on FULLTEXT index creation. +Oracle producer produces duplicate sequences occasionally; need demonstrative tests +datatype text needs default size in ::Parser::MySQL (comes out as size 0) +SQL Comments (technically) begin with '-- ', not '#' +MySQL parser misses double-quoted strings in DEFAULT sections (I think) +MySQL parser misses primary key declarations that don't occur as part of a field definition line (I think) diff --git a/Makefile.PL b/Makefile.PL index 629e9c7..c2c0e97 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -2,6 +2,7 @@ package SQL::Translator; use strict; use ExtUtils::MakeMaker; +use Config; WriteMakefile( 'NAME' => __PACKAGE__, @@ -15,3 +16,5 @@ WriteMakefile( 'Pod::Usage' => 0, }, ); + + diff --git a/TODO b/TODO index 11c7317..87bafa0 100644 --- a/TODO +++ b/TODO @@ -3,6 +3,8 @@ Define structure of the data returned by parsers: o For testing purposes, we need to know if parsers are returning something reasonable -cvs rm t/data/mysql/Apache-Session-MySQL.sql -cvs add TODO -cvs add t/01load.t +Modules to be written/finished + SQL::Translator::Validator + SQL::Translator::Parser::xSV + SQL::Translator::Producer::MySQL + diff --git a/bin/validator_test.pl b/bin/validator_test.pl index 92893ba..676a618 100755 --- a/bin/validator_test.pl +++ b/bin/validator_test.pl @@ -29,7 +29,7 @@ my $data = { type => "HEAP", indeces => [ { - name => "main_idx", + name => undef, primary_key => 1, fields => [ "id" ], } @@ -58,7 +58,7 @@ use SQL::Translator; my $tr = SQL::Translator->new(parser => "MySQL"); -$data = $tr->translate("t/data/mysql/BGEP-RE-create.sql"); +#$data = $tr->translate("t/data/mysql/BGEP-RE-create.sql"); my @r = validate($data); diff --git a/lib/SQL/Translator.pm b/lib/SQL/Translator.pm index 7cf4179..d50ffcf 100644 --- a/lib/SQL/Translator.pm +++ b/lib/SQL/Translator.pm @@ -1,7 +1,7 @@ package SQL::Translator; # ---------------------------------------------------------------------- -# $Id: Translator.pm,v 1.5 2002-03-26 12:46:54 dlc Exp $ +# $Id: Translator.pm,v 1.6 2002-03-27 12:41:52 dlc Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2002 Ken Y. Clark , # darren chamberlain @@ -57,7 +57,7 @@ contributing their parsers or producers back to the project. use strict; use vars qw($VERSION $DEFAULT_SUB $DEBUG); -$VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/; $DEBUG = 1 unless defined $DEBUG; # ---------------------------------------------------------------------- @@ -80,9 +80,17 @@ Valid options are: =item parser (aka from) +=item parser_args + =item producer (aka to) -=item filename +=item producer_args + +=item filename (aka file) + +=item data + +=item debug =back @@ -105,10 +113,6 @@ advantage is gained by passing options to the constructor. # given directly to the parser or producer methods, respectively. # See the appropriate method description below for details about # what each expects/accepts. -# -# TODO -# * Support passing an input (filename or string) as with -# translate # ---------------------------------------------------------------------- sub new { my $class = shift; @@ -133,6 +137,23 @@ sub new { } # ------------------------------------------------------------------ + # Set the data source, if 'filename' or 'file' is provided. + # ------------------------------------------------------------------ + $args->{'filename'} ||= $args->{'file'} || ""; + $self->filename($args->{'filename'}) if $args->{'filename'}; + + # ------------------------------------------------------------------ + # Finally, if there is a 'data' parameter, use that in preference + # to filename and file + # ------------------------------------------------------------------ + if (my $data = $args->{'data'}) { + $self->data($data); + } + + $self->{'debug'} = $DEBUG; + $self->{'debug'} = $args->{'debug'} if (defined $args->{'debug'}); + + # ------------------------------------------------------------------ # Clear the error # ------------------------------------------------------------------ $self->error_out(""); @@ -255,7 +276,7 @@ sub producer { elsif (isa($producer, 'CODE')) { $self->{'producer'} = $producer; $self->{'producer_type'} = "CODE"; - $self->debug("Got 'producer': code ref"); + $self->debug("Got producer: code ref"); } # }}} # {{{ passed a string containing no "::"; relative package name @@ -369,7 +390,7 @@ sub parser { elsif (isa($parser, 'CODE')) { $self->{'parser'} = $parser; $self->{'parser_type'} = "CODE"; - $self->debug("Got 'parser': code ref"); + $self->debug("Got parser: code ref"); } # }}} # {{{ passed a string containing no "::"; relative package name @@ -449,79 +470,173 @@ You get the idea. =back +=head2 B, B + +Using the B method, the filename of the data to be parsed +can be set. This method can be used in conjunction with the B +method, below. If both the B and B methods are +invoked as mutators, the data set in the B method is used. + + $tr->filename("/my/data/files/create.sql"); + +or: + + my $create_script = do { + local $/; + open CREATE, "/my/data/files/create.sql" or die $!; + ; + }; + $tr->data(\$create_script); + +B takes a string, which is interpreted as a filename. +B takes a reference to a string, which is used as the data o be +parsed. If a filename is set, then that file is opened and read when +the B method is called, as long as the data instance +variable is not set. + =cut +# {{{ filename - get or set the filename +sub filename { + my $self = shift; + if (@_) { + $self->{'filename'} = shift; + $self->debug("Got filename: $self->{'filename'}"); + } + $self->{'filename'}; +} # }}} + +# {{{ data - get or set the data +# if $self->{'data'} is not set, but $self->{'filename'} is, then +# $self->{'filename'} is opened and read, whith the results put into +# $self->{'data'}. +sub data { + my $self = shift; + + # {{{ Set $self->{'data'} to $_[0], if it is provided. + if (@_) { + my $data = shift; + if (isa($data, "SCALAR")) { + $self->{'data'} = $data; + } + elsif (! ref $data) { + $self->{'data'} = \$data; + } + } + # }}} + + # {{{ If we have a filename but no data yet, populate. + if (not $self->{'data'} and my $filename = $self->filename) { + $self->debug("Opening '$filename' to get contents..."); + local *FH; + local $/; + my $data; + + unless (open FH, $filename) { + $self->error_out("Can't open $filename for reading: $!"); + return; + } + + $data = ; + $self->{'data'} = \$data; + + unless (close FH) { + $self->error_out("Can't close $filename: $!"); + return; + } + } + # }}} + + return $self->{'data'}; +} # }}} + # {{{ translate sub translate { my $self = shift; my ($args, $parser, $producer); - if (@_ == 1) { + # {{{ Parse arguments + if (@_ == 1) { + # {{{ Passed a reference to a hash if (isa($_[0], 'HASH')) { # Passed a hashref $self->debug("translate: Got a hashref"); $args = $_[0]; } + # }}} + + # {{{ Passed a reference to a string containing the data elsif (isa($_[0], 'SCALAR')) { - # passed a ref to a string; deref it + # passed a ref to a string $self->debug("translate: Got a SCALAR reference (string)"); - $args = { data => ${$_[0]} }; + $self->data($_[0]); } + # }}} + + # {{{ Not a reference; treat it as a filename elsif (! ref $_[0]) { # Not a ref, it's a filename $self->debug("translate: Got a filename"); - $args = { filename => $_[0] }; + $self->filename($_[0]); } + # }}} + + # {{{ Passed something else entirely. else { # We're not impressed. Take your empty string and leave. return ""; } + # }}} } else { # You must pass in a hash, or you get nothing. return "" if @_ % 2; $args = { @_ }; - } + } # }}} - if ((defined $args->{'filename'} || defined $args->{'file'}) && - not $args->{'data'}) { - local *FH; - local $/; + # ---------------------------------------------------------------------- + # Can specify the data to be transformed using "filename", "file", + # or "data" + # ---------------------------------------------------------------------- + if (my $filename = $args->{'filename'} || $args->{'file'}) { + $self->filename($filename); + } - open FH, $args->{'filename'} - or die "Can't open $args->{'filename'} for reading: $!"; - $args->{'data'} = ; - close FH or die "Can't close $args->{'filename'}: $!"; + if (my $data = $self->{'data'}) { + $self->data($data); } - # - # Last chance to bail out; if there's nothing in the data - # key of %args, back out. - # - return "" unless defined $args->{'data'}; + # ---------------------------------------------------------------- + # Get the data. + # ---------------------------------------------------------------- + my $data = $self->data; + unless (defined $$data) { + $self->error_out("Empty data file!"); + return ""; + } - # + # ---------------------------------------------------------------- # Local reference to the parser subroutine - # + # ---------------------------------------------------------------- if ($parser = ($args->{'parser'} || $args->{'from'})) { $self->parser($parser); } else { $parser = $self->parser; } - # + # ---------------------------------------------------------------- # Local reference to the producer subroutine - # + # ---------------------------------------------------------------- if ($producer = ($args->{'producer'} || $args->{'to'})) { $self->producer($producer); } else { $producer = $self->producer; } - # + # ---------------------------------------------------------------- # Execute the parser, then execute the producer with that output - # - return $producer->($self, $parser->($self, $args->{'data'})); + # ---------------------------------------------------------------- + return $producer->($self, $parser->($self, $$data)); } # }}} @@ -571,7 +686,15 @@ not set, then this method does nothing. # {{{ debug sub debug { my $self = shift; - carp @_ if ($DEBUG); +# if (ref $self) { +# carp @_ if $self->{'debug'}; +# } +# else { + if ($DEBUG) { + my $class = ref $self || $self; + carp "[$class] $_" for @_; + } +# } } # }}} diff --git a/lib/SQL/Translator/Producer/MySQL.pm b/lib/SQL/Translator/Producer/MySQL.pm new file mode 100644 index 0000000..0faf96e --- /dev/null +++ b/lib/SQL/Translator/Producer/MySQL.pm @@ -0,0 +1,134 @@ +package SQL::Translator::Producer::MySQL; + +#----------------------------------------------------- +# $Id: MySQL.pm,v 1.1 2002-03-27 12:41:53 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. +# +# 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 +# ------------------------------------------------------------------- + +use strict; +use vars qw($VERSION $DEBUG); +$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/; +$DEBUG = 1 unless defined $DEBUG; + +use Data::Dumper; + +sub import { + warn "loading " . __PACKAGE__ . "...\n"; +} + +sub produce { + my ($translator, $data) = @_; + debug("Beginning"); + my $create = sprintf +"# ---------------------------------------------------------------------- +# Created by %s +# Created on %s +# ----------------------------------------------------------------------\n\n", + __PACKAGE__, scalar localtime; + + for my $table (keys %{$data}) { + debug("Looking a '$table'"); + my $table_data = $data->{$table}; + my @fields = sort { $table_data->{'fields'}->{$a}->{'order'} <=> + $table_data->{'fields'}->{$b}->{'order'} + } keys %{$table_data->{'fields'}}; + + # -------------------------------------------------------------- + # Header. Should this look like what mysqldump produces? + # -------------------------------------------------------------- + $create .= +"# ---------------------------------------------------------------------- +# Table: $table +# ----------------------------------------------------------------------\n"; + $create .= "CREATE TABLE $table (\n"; + + # -------------------------------------------------------------- + # Fields + # -------------------------------------------------------------- + for (my $i = 0; $i <= $#fields; $i++) { + my $field = $fields[$i]; + debug("Looking at field: $field"); + my $field_data = $table_data->{'fields'}->{$field}; + my @fdata = ("", $field); + + # data type and size + push @fdata, sprintf "%s(%d)", $field_data->{'data_type'}, + $field_data->{'size'}; + + # Null? + push @fdata, "NOT NULL" unless $field_data->{'null'}; + + # Default? XXX Need better quoting! + if (my $default = $field_data->{'default'}) { + if (int $default eq "$default") { + push @fdata, "DEFAULT $default"; + } else { + push @fdata, "DEFAULT '$default'"; + } + } + + # auto_increment? + push @fdata, "auto_increment" if $field_data->{'is_auto_inc'}; + + # primary key? + push @fdata, "PRIMARY KEY" if $field_data->{'is_primary_key'}; + + + $create .= (join "\t", @fdata); + $create .= "," unless ($i == $#fields); + $create .= "\n"; + } + + # -------------------------------------------------------------- + # Other keys + # -------------------------------------------------------------- + + + # -------------------------------------------------------------- + # Footer + # -------------------------------------------------------------- + $create .= ")"; + $create .= " TYPE=$table_data->{'type'}" + if defined $table_data->{'type'}; + $create .= ";\n\n"; + } + + $create .= "#\n"; + + return $create; +} + +use Carp; +sub debug { + if ($DEBUG) { + map { carp "[" . __PACKAGE__ . "] $_" } @_; + } +} + +1; +__END__ + +=head1 NAME + +SQL::Translator::Producer::MySQL - mysql-specific producer for SQL::Translator + + +=head1 AUTHOR + +darren chamberlain Edarren@cpan.orgE diff --git a/lib/SQL/Translator/Validator.pm b/lib/SQL/Translator/Validator.pm index 9b14928..ea63a43 100644 --- a/lib/SQL/Translator/Validator.pm +++ b/lib/SQL/Translator/Validator.pm @@ -1,7 +1,7 @@ package SQL::Translator::Validator; # ---------------------------------------------------------------------- -# $Id: Validator.pm,v 1.1 2002-03-26 12:46:54 dlc Exp $ +# $Id: Validator.pm,v 1.2 2002-03-27 12:41:53 dlc Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2002 Ken Y. Clark , # darren chamberlain @@ -23,7 +23,7 @@ package SQL::Translator::Validator; use strict; use vars qw($VERSION @EXPORT); -$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/; use Exporter; use base qw(Exporter); @@ -33,6 +33,9 @@ use Data::Dumper; sub by_context($$$) { ($_[0]) ? ($_[1], $_[2]) : $_[1]; } +# XXX If called in scalar context, then validate should *not* +# genertate or return $log. It's a lot of extra work if we know we +# are not going to use it. sub validate { my $data = shift; my $wa = wantarray; @@ -161,6 +164,47 @@ trust: # continue... +SQL::Translator::Validator can also be used as a reporting tool. When +B is called in a list context, the second value returned +(assuming the data structure is well-formed) is a summary of the +table's information. For example, the following table definition +(MySQL format): + + CREATE TABLE random ( + id int(11) not null default 1, + seed char(32) not null default 1 + ); + + CREATE TABLE session ( + foo char(255), + id int(11) not null default 1 primary key + ) TYPE=HEAP; + +Produces the following summary: + + Contains 2 tables. + Table 1: random + Type: not defined + Indeces: none defined + Fields: + id int (11) + Default: 1 + Null: no + seed char (32) + Default: 1 + Null: no + Table 2: session + Type: HEAP + Indeces: + (unnamed) on id + Fields: + foo char (255) + Null: yes + id int (11) + Default: 1 + Null: no + + =head1 EXPORTED FUNCTIONS SQL::Translator::Validator exports a single function, called