package SQL::Translator;
# ----------------------------------------------------------------------
-# $Id: Translator.pm,v 1.3.2.3 2002-03-18 20:35:51 dlc Exp $
+# $Id: Translator.pm,v 1.7 2002-06-11 12:09:13 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.3.2.3 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\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;
- my $args = isa($_[0], 'HASH') ? shift : { @_ };
+ my $args = $_[0] && isa($_[0], 'HASH') ? shift : { @_ };
my $self = bless { } => $class;
# ------------------------------------------------------------------
$self->producer($args->{'producer'} || $args->{'to'} || $DEFAULT_SUB);
# ------------------------------------------------------------------
+ # Set the parser_args and producer_args
+ # ------------------------------------------------------------------
+ for my $pargs (qw(parser_args producer_args)) {
+ $self->$pargs($args->{$pargs}) if defined $args->{$pargs};
+ }
+
+ # ------------------------------------------------------------------
+ # 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("");
# This will invoke My::Groovy::Producer::transmogrify($tr, $data),
# assuming that My::Groovy::Producer::transmogrify is not a module
# on disk.
- # $tr->producer("My::Groovy::Producer::transmogrify);
+ $tr->producer("My::Groovy::Producer::transmogrify");
# This will invoke the referenced subroutine directly, as
# $subref->($tr, $data);
belongs. In the case of anonymous subroutines, this method returns
the string "CODE".
+Finally, there is a method named B<producer_args>, which is both an
+accessor and a mutator. Arbitrary data may be stored in name => value
+pairs for the producer subroutine to access:
+
+ sub My::Random::producer {
+ my ($tr, $data) = @_;
+ my $pr_args = $tr->producer_args();
+
+ # $pr_args is a hashref.
+
+Extra data passed to the B<producer> method is passed to
+B<producer_args>:
+
+ $tr->producer("xSV", delimiter => ',\s*');
+
+ # In SQL::Translator::Producer::xSV:
+ my $args = $tr->producer_args;
+ my $delimiter = $args->{'delimiter'}; # value is => ,\s*
+
=cut
# {{{ producer and producer_type
# {{{ get code reference and assign
$self->{'producer'} = \&{ "$producer\::$func_name" };
$self->{'producer_type'} = $producer;
- $self->debug("Got 'producer': $producer\::$func_name");
+ $self->debug("Got producer: $producer\::$func_name");
# }}}
} # }}}
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
# At this point, $self->{'producer'} contains a subroutine
# reference that is ready to run
+
+ # {{{ Anything left? If so, it's producer_args
+ $self->produser_args(@_) if (@_);
+ # }}}
} # }}}
return $self->{'producer'};
};
-sub producer_type { $_[0]->{'producer_type'} }
+# {{{ producer_type
+# producer_type is an accessor that allows producer subs to get
+# information about their origin. This is poptentially important;
+# since all producer subs are called as subroutine refernces, there is
+# no way for a producer to find out which package the sub lives in
+# originally, for example.
+sub producer_type { $_[0]->{'producer_type'} } # }}}
+
+# {{{ producer_args
+# Arbitrary name => value pairs of paramters can be passed to a
+# producer using this method.
+sub producer_args {
+ my $self = shift;
+ if (@_) {
+ my $args = isa($_[0], 'HASH') ? shift : { @_ };
+ $self->{'producer_args'} = $args;
+ }
+ $self->{'producer_args'};
+} # }}}
# }}}
=head2 B<parser>
return $dumper->Dump;
});
+There is also B<parser_type> and B<parser_args>, which perform
+analogously to B<producer_type> and B<producer_args>
+
=cut
-# {{{ parser and parser_type
+# {{{ parser, parser_type, and parser_args
sub parser {
my $self = shift;
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
# At this point, $self->{'parser'} contains a subroutine
# reference that is ready to run
- } # }}}
+ $self->parser_args(@_) if (@_);
+ } # }}}
return $self->{'parser'};
}
sub parser_type { $_[0]->{'parser_type'} }
+
+# {{{ parser_args
+sub parser_args {
+ my $self = shift;
+ if (@_) {
+ my $args = isa($_[0], 'HASH') ? shift : { @_ };
+ $self->{'parser_args'} = $args;
+ }
+ $self->{'parser_args'};
+} # }}}
# }}}
=head2 B<translate>
=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 to 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 "";
+ # return "";
+
+ # Actually, if data, parser, and producer are set, then be can
+ # continue. Too bad, because I like my comment (above)...
+ return "" unless ($self->data &&
+ $self->producer &&
+ $self->parser);
}
+ # }}}
}
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;
}
+ $parser = $self->parser;
- #
+ # ----------------------------------------------------------------
# Local reference to the producer subroutine
- #
+ # ----------------------------------------------------------------
if ($producer = ($args->{'producer'} || $args->{'to'})) {
$self->producer($producer);
- } else {
- $producer = $self->producer;
}
+ $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 @_;
+ }
+# }
}
# }}}
projects / dbsrgits/SQL-Translator.git / blobdiff