package SQL::Translator;
# ----------------------------------------------------------------------
-# $Id: Translator.pm,v 1.8 2002-07-08 14:42:56 dlc Exp $
+# $Id: Translator.pm,v 1.9 2002-07-23 19:21:16 dlc Exp $
# ----------------------------------------------------------------------
# Copyright (C) 2002 Ken Y. Clark <kycl4rk@users.sourceforge.net>,
# darren chamberlain <darren@cpan.org>
=cut
use strict;
-use vars qw($VERSION $DEFAULT_SUB $DEBUG);
-$VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/;
+use vars qw($VERSION $DEFAULT_SUB $DEBUG $ERROR);
+use base qw(Class::Base);
+
+$VERSION = sprintf "%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 1 unless defined $DEBUG;
+$ERROR = "";
+
+use Carp qw(carp);
# ----------------------------------------------------------------------
# The default behavior is to "pass through" values (note that the
# ----------------------------------------------------------------------
$DEFAULT_SUB = sub { $_[1] } unless defined $DEFAULT_SUB;
-*isa = \&UNIVERSAL::isa;
-
-use Carp qw(carp);
-
=head1 CONSTRUCTOR
The constructor is called B<new>, and accepts a optional hash of options.
=cut
# ----------------------------------------------------------------------
-# new([ARGS])
+# init([ARGS])
# The constructor.
#
# new takes an optional hash of arguments. These arguments may
# See the appropriate method description below for details about
# what each expects/accepts.
# ----------------------------------------------------------------------
-sub new {
- my $class = shift;
- my $args = $_[0] && isa($_[0], 'HASH') ? shift : { @_ };
- my $self = bless { } => $class;
+sub init {
+ my ($self, $config) = @_;
# ------------------------------------------------------------------
# Set the parser and producer.
# 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);
+ $self->parser( $config->{'parser'} || $config->{'from'} || $DEFAULT_SUB);
+ $self->producer($config->{'producer'} || $config->{'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};
+ $self->$pargs($config->{$pargs}) if defined $config->{$pargs};
}
# ------------------------------------------------------------------
# Set the data source, if 'filename' or 'file' is provided.
# ------------------------------------------------------------------
- $args->{'filename'} ||= $args->{'file'} || "";
- $self->filename($args->{'filename'}) if $args->{'filename'};
+ $config->{'filename'} ||= $config->{'file'} || "";
+ $self->filename($config->{'filename'}) if $config->{'filename'};
# ------------------------------------------------------------------
# Finally, if there is a 'data' parameter, use that in preference
# to filename and file
# ------------------------------------------------------------------
- if (my $data = $args->{'data'}) {
+ if (my $data = $config->{'data'}) {
$self->data($data);
}
$self->{'debug'} = $DEBUG;
- $self->{'debug'} = $args->{'debug'} if (defined $args->{'debug'});
-
- # ------------------------------------------------------------------
- # Clear the error
- # ------------------------------------------------------------------
- $self->error_out("");
+ $self->{'debug'} = $config->{'debug'} if (defined $config->{'debug'});
return $self;
}
my $filename = shift;
if (-d $filename) {
my $msg = "Cannot use directory '$filename' as input source";
- $self->error_out($msg);
- return;
+ return $self->error($msg);
} elsif (-f _ && -r _) {
$self->{'filename'} = $filename;
$self->debug("Got filename: $self->{'filename'}");
} else {
my $msg = "Cannot use '$filename' as input source: ".
"file does not exist or is not readable.";
- $self->error_out($msg);
- return;
+ return $self->error($msg);
}
}
my $data;
unless (open FH, $filename) {
- $self->error_out("Can't open $filename for reading: $!");
- return;
+ return $self->error("Can't open $filename for reading: $!");
}
$data = <FH>;
$self->{'data'} = \$data;
unless (close FH) {
- $self->error_out("Can't close $filename: $!");
- return;
+ return $self->error("Can't close $filename: $!");
}
}
# ----------------------------------------------------------------
my $data = $self->data;
unless (length $$data) {
- $self->error_out("Empty data file!");
- return "";
+ return $self->error("Empty data file!");
}
# ----------------------------------------------------------------
if ($@ || ! $parser_output) {
my $msg = sprintf "translate: Error with parser '%s': %s",
$parser_type, ($@) ? $@ : " no results";
- $self->error_out($msg);
- return;
+ return $self->error($msg);
}
eval { $producer_output = $producer->($self, $parser_output) };
if ($@ || ! $producer_output) {
my $msg = sprintf "translate: Error with producer '%s': %s",
$producer_type, ($@) ? $@ : " no results";
- $self->error_out($msg);
- return;
+ return $self->error($msg);
}
return $producer_output;
}
-=head2 B<error>
-
-The error method returns the last error.
-
-=cut
-
-#-----------------------------------------------------
-sub error {
-#
-# Return the last error.
-#
- return shift()->{'error'} || '';
-}
-
-=head2 B<error_out>
-
-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;
- }
- return;
-}
-
-=head2 B<debug>
-
-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
-sub debug {
- my $self = shift;
-# if (ref $self) {
-# carp @_ if $self->{'debug'};
-# }
-# else {
- if ($DEBUG) {
- my $class = ref $self || $self;
- carp "[$class] $_" for @_;
- }
-# }
-}
-
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;
__END__