package SQL::Translator;
# ----------------------------------------------------------------------
-# $Id: Translator.pm,v 1.10 2002-11-20 04:03:03 kycl4rk Exp $
+# $Id: Translator.pm,v 1.13 2002-11-25 14:48:34 dlc Exp $
# ----------------------------------------------------------------------
-# Copyright (C) 2002 Ken Y. Clark <kycl4rk@users.sourceforge.net>,
+# Copyright (C) 2002 Ken Y. Clark <kclark@cpan.org>,
# darren chamberlain <darren@cpan.org>
#
# This program is free software; you can redistribute it and/or
=head1 SYNOPSIS
use SQL::Translator;
- my $translator = SQL::Translator->new;
+
+ my $translator = SQL::Translator->new(
+ xlate => $xlate || {}, # Overrides for field translation
+ debug => $debug, # Print debug info
+ trace => $trace, # Print Parse::RecDescent trace
+ no_comments => $no_comments, # Don't include comments in output
+ );
+
my $output = $translator->translate(
from => "MySQL",
to => "Oracle",
filename => $file,
) or die $translator->error;
+
print $output;
=head1 DESCRIPTION
=cut
use strict;
-use vars qw( $VERSION $DEFAULT_SUB $DEBUG $ERROR );
+use vars qw( $VERSION $REVISION $DEFAULT_SUB $DEBUG $ERROR );
use base 'Class::Base';
-$VERSION = sprintf "%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/;
-$DEBUG = 0 unless defined $DEBUG;
-$ERROR = "";
+$VERSION = '0.01';
+$REVISION = sprintf "%d.%02d", q$Revision: 1.13 $ =~ /(\d+)\.(\d+)/;
+$DEBUG = 0 unless defined $DEBUG;
+$ERROR = "";
use Carp qw(carp);
+use File::Spec::Functions qw(catfile);
+use File::Basename qw(dirname);
+use IO::Dir;
+
# ----------------------------------------------------------------------
# The default behavior is to "pass through" values (note that the
# SQL::Translator instance is the first value ($_[0]), and the stuff
$self->data( $data );
}
+ #
+ # Set various other options.
+ #
$self->{'debug'} = defined $config->{'debug'} ? $config->{'debug'} : $DEBUG;
+ $self->trace( $config->{'trace'} );
+
+ $self->custom_translate( $config->{'xlate'} );
+
+ $self->no_comments( $config->{'no_comments'} );
+
return $self;
}
=head1 METHODS
+# ----------------------------------------------------------------------
+=head2 B<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.
+
+=cut
+
+sub custom_translate {
+ my $self = shift;
+ $self->{'custom_translate'} = shift if @_;
+ return $self->{'custom_translate'} || {};
+}
+
+# ----------------------------------------------------------------------
+=head2 B<no_comments>
+
+Toggles whether to print comments in the output. Accepts a true or false
+value, returns the current value.
+
+=cut
+
+sub no_comments {
+ my $self = shift;
+ my $arg = shift;
+ if ( defined $arg ) {
+ $self->{'no_comments'} = $arg ? 1 : 0;
+ }
+ return $self->{'no_comments'} || 0;
+}
+
+# ----------------------------------------------------------------------
=head2 B<producer>
The B<producer> method is an accessor/mutator, used to retrieve or
#
# Arbitrary name => value pairs of paramters can be passed to a
# producer using this method.
+#
+# XXX All calls to producer_args with a value clobbers old values!
+# Should probably check if $_[0] is undef, and delete stored
+# args if it is:
+#
+# if (@_) {
+# unless (defined $_[0]) {
+# %{ $self->{'producer_args'} } = ();
+# }
+# my $args = isa($_[0], 'HASH') ? shift : { @_ };
+# %{ $self->{'producer_args'} } = (
+# %{ $self->{'producer_args'} },
+# %{ $args }
+# );
+# }
# ----------------------------------------------------------------------
sub producer_args {
my $self = shift;
$self->{'producer_args'};
}
+# ----------------------------------------------------------------------
=head2 B<parser>
The B<parser> method defines or retrieves a subroutine that will be
B<producer> (see above), except the default subroutine name is
"parse", and will be invoked as $module_name::parse($tr, $data).
Also, the parser subroutine will be passed a string containing the
-entirety of the data to be parsed (or possibly a reference to a string?).
+entirety of the data to be parsed.
# Invokes SQL::Translator::Parser::MySQL::parse()
$tr->parser("MySQL");
return $self->{'parser'};
}
+# ----------------------------------------------------------------------
sub parser_type { $_[0]->{'parser_type'} }
-# parser_args
+# ----------------------------------------------------------------------
+# XXX See notes on producer_args, above
sub parser_args {
my $self = shift;
if (@_) {
$self->{'parser_args'};
}
+# ----------------------------------------------------------------------
=head2 B<translate>
The B<translate> method calls the subroutines referenced by the
=back
+# ----------------------------------------------------------------------
=head2 B<filename>, B<data>
Using the B<filename> method, the filename of the data to be parsed
$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
return $self->{'data'};
}
-# translate
+# ----------------------------------------------------------------------
+=pod
+
+=head2 B<trace>
+
+Turns on/off the tracing option of Parse::RecDescent.
+
+=cut
+
+sub trace {
+ my $self = shift;
+ my $arg = shift;
+ if ( defined $arg ) {
+ $self->{'trace'} = $arg ? 1 : 0;
+ }
+ return $self->{'trace'} || 0;
+}
+
+# ----------------------------------------------------------------------
sub translate {
my $self = shift;
my ($args, $parser, $parser_type, $producer, $producer_type);
return $producer_output;
}
+# ----------------------------------------------------------------------
+sub list_producers {
+ require SQL::Translator::Producer;
+ my $path = catfile(dirname($INC{'SQL/Translator/Producer.pm'}), "Producer");
+ my $dh = IO::Dir->new($path);
+
+ my @available = map { join "::", "SQL::Translator::Producer", $_ }
+ grep /\.pm$/, $dh->read;
+
+ return @available;
+}
+
+# ----------------------------------------------------------------------
+sub list_parsers {
+ require SQL::Translator::Parser;
+ my $path = catfile(dirname($INC{'SQL/Translator/Parser.pm'}), "Parser");
+ my $dh = IO::Dir->new($path);
+
+ my @available = map { join "::", "SQL::Translator::Parser", $_ }
+ grep /\.pm$/, $dh->read;
+
+ return @available;
+}
+
+# ----------------------------------------------------------------------
sub load {
my $module = do { my $m = shift; $m =~ s[::][/]g; "$m.pm" };
return 1 if $INC{$module};
return 1;
}
+# ----------------------------------------------------------------------
sub isa { UNIVERSAL::isa($_[0], $_[1]) }
1;
=head1 AUTHORS
-Ken Y. Clark, E<lt>kclark@logsoft.comE<gt>,
-darren chamberlain E<lt>darren@cpan.orgE<gt>
+Ken Y. Clark, E<lt>kclark@cpan.org<gt>,
+darren chamberlain E<lt>darren@cpan.orgE<gt>,
+Chris Mungall E<lt>cjm@fruitfly.orgE<gt>
=head1 COPYRIGHT
projects / dbsrgits/SQL-Translator.git / blobdiff