From: Darren Chamberlain Date: Tue, 23 Jul 2002 19:21:16 +0000 (+0000) Subject: Subclasses Class::Base. Removed error_out, error, in favor Class::Base::error. X-Git-Tag: v0.01~47 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c2d3a526263c0948d03e0b2922773eb7db00b0ed;hp=7a8e1f51386b011bde842a9117afc4fb04f98e41;p=dbsrgits%2FSQL-Translator.git Subclasses Class::Base. Removed error_out, error, in favor Class::Base::error. --- diff --git a/lib/SQL/Translator.pm b/lib/SQL/Translator.pm index 1c0bcc7..02cbc94 100644 --- a/lib/SQL/Translator.pm +++ b/lib/SQL/Translator.pm @@ -1,7 +1,7 @@ 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 , # darren chamberlain @@ -49,9 +49,14 @@ would use the PostgreSQL parser and the Oracle producer. =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 @@ -60,10 +65,6 @@ $DEBUG = 1 unless defined $DEBUG; # ---------------------------------------------------------------------- $DEFAULT_SUB = sub { $_[1] } unless defined $DEFAULT_SUB; -*isa = \&UNIVERSAL::isa; - -use Carp qw(carp); - =head1 CONSTRUCTOR The constructor is called B, and accepts a optional hash of options. @@ -94,7 +95,7 @@ advantage is gained by passing options to the constructor. =cut # ---------------------------------------------------------------------- -# new([ARGS]) +# init([ARGS]) # The constructor. # # new takes an optional hash of arguments. These arguments may @@ -106,10 +107,8 @@ advantage is gained by passing options to the constructor. # 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. @@ -118,37 +117,32 @@ sub new { # 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; } @@ -494,16 +488,14 @@ sub filename { 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); } } @@ -536,16 +528,14 @@ sub data { 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 = ; $self->{'data'} = \$data; unless (close FH) { - $self->error_out("Can't close $filename: $!"); - return; + return $self->error("Can't close $filename: $!"); } } @@ -617,8 +607,7 @@ sub translate { # ---------------------------------------------------------------- my $data = $self->data; unless (length $$data) { - $self->error_out("Empty data file!"); - return ""; + return $self->error("Empty data file!"); } # ---------------------------------------------------------------- @@ -650,75 +639,19 @@ sub translate { 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 - -The error method returns the last error. - -=cut - -#----------------------------------------------------- -sub error { -# -# Return the last error. -# - return shift()->{'error'} || ''; -} - -=head2 B - -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 - -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}; @@ -729,6 +662,8 @@ sub load { return 1; } +sub isa { UNIVERSAL::isa($_[0], $_[1]) } + 1; __END__