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 <kycl4rk@users.sourceforge.net>,
# darren chamberlain <darren@cpan.org>
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;
# ----------------------------------------------------------------------
=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
# 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;
}
# ------------------------------------------------------------------
+ # 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("");
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
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
=back
+=head2 B<filename>, B<data>
+
+Using the B<filename> method, the filename of the data to be parsed
+can be set. This method can be used in conjunction with the B<data>
+method, below. If both the B<filename> and B<data> methods are
+invoked as mutators, the data set in the B<data> 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 $!;
+ <CREATE>;
+ };
+ $tr->data(\$create_script);
+
+B<filename> takes a string, which is interpreted as a filename.
+B<data> 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<translate> 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 = <FH>;
+ $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'} = <FH>;
- 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));
}
# }}}
# {{{ 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 @_;
+ }
+# }
}
# }}}
--- /dev/null
+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 <kycl4rk@users.sourceforge.net>,
+# darren chamberlain <darren@cpan.org>
+#
+# 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 E<lt>darren@cpan.orgE<gt>
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 <kycl4rk@users.sourceforge.net>,
# darren chamberlain <darren@cpan.org>
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);
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;
# continue...
+SQL::Translator::Validator can also be used as a reporting tool. When
+B<validate> 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
projects / dbsrgits/SQL-Translator.git / commitdiff