Applying patches from Markus Törnqvis.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator.pm
index 88af530..446fa21 100644 (file)
@@ -1,11 +1,9 @@
 package SQL::Translator;
 
 # ----------------------------------------------------------------------
-# $Id: Translator.pm,v 1.43 2003-08-22 20:35:18 kycl4rk Exp $
+# $Id: Translator.pm,v 1.57 2004-04-22 19:59:46 kycl4rk Exp $
 # ----------------------------------------------------------------------
-# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
-#                    darren chamberlain <darren@cpan.org>,
-#                    Chris Mungall <cjm@fruitfly.org>
+# Copyright (C) 2002-4 The SQLFairy Authors
 #
 # This program is free software; you can redistribute it and/or
 # modify it under the terms of the GNU General Public License as
@@ -28,8 +26,8 @@ use base 'Class::Base';
 
 require 5.004;
 
-$VERSION  = '0.02';
-$REVISION = sprintf "%d.%02d", q$Revision: 1.43 $ =~ /(\d+)\.(\d+)/;
+$VERSION  = '0.06';
+$REVISION = sprintf "%d.%02d", q$Revision: 1.57 $ =~ /(\d+)\.(\d+)/;
 $DEBUG    = 0 unless defined $DEBUG;
 $ERROR    = "";
 
@@ -75,13 +73,13 @@ sub init {
     $self->parser  ($config->{'parser'}   || $config->{'from'} || $DEFAULT_SUB);
     $self->producer($config->{'producer'} || $config->{'to'}   || $DEFAULT_SUB);
 
-       #
-       # Set up callbacks for formatting of pk,fk,table,package names in producer
-       #
-       $self->format_table_name($config->{'format_table_name'});
-       $self->format_package_name($config->{'format_package_name'});
-       $self->format_fk_name($config->{'format_fk_name'});
-       $self->format_pk_name($config->{'format_pk_name'});
+        #
+        # Set up callbacks for formatting of pk,fk,table,package names in producer
+        #
+        $self->format_table_name($config->{'format_table_name'});
+        $self->format_package_name($config->{'format_package_name'});
+        $self->format_fk_name($config->{'format_fk_name'});
+        $self->format_pk_name($config->{'format_pk_name'});
 
     #
     # Set the parser_args and producer_args
@@ -334,9 +332,9 @@ sub filename {
         if (-d $filename) {
             my $msg = "Cannot use directory '$filename' as input source";
             return $self->error($msg);
-       } elsif (ref($filename) eq 'ARRAY') {
-           $self->{'filename'} = $filename;
-           $self->debug("Got array of files: ".join(', ',@$filename)."\n");
+        } elsif (ref($filename) eq 'ARRAY') {
+            $self->{'filename'} = $filename;
+            $self->debug("Got array of files: ".join(', ',@$filename)."\n");
         } elsif (-f _ && -r _) {
             $self->{'filename'} = $filename;
             $self->debug("Got filename: '$self->{'filename'}'\n");
@@ -389,21 +387,21 @@ sub data {
         local $/;
         my $data;
 
-       my @files = ref($filename) eq 'ARRAY' ? @$filename : ($filename);
+        my @files = ref($filename) eq 'ARRAY' ? @$filename : ($filename);
 
-       foreach my $file (@files) {
-               unless (open FH, $file) {
-                   return $self->error("Can't read file '$file': $!");
-               }
+        foreach my $file (@files) {
+            unless (open FH, $file) {
+                return $self->error("Can't read file '$file': $!");
+            }
 
-               $data .= <FH>;
+            $data .= <FH>;
 
-               unless (close FH) {
-                   return $self->error("Can't close file '$file': $!");
-               }
-       }
+            unless (close FH) {
+                return $self->error("Can't close file '$file': $!");
+            }
+        }
 
-       $self->{'data'} = \$data;
+        $self->{'data'} = \$data;
     }
 
     return $self->{'data'};
@@ -528,9 +526,6 @@ sub translate {
     # Get the data.
     # ----------------------------------------------------------------
     my $data = $self->data;
-    unless (ref($data) eq 'SCALAR' and length $$data) {
-        return $self->error("Empty data file!");
-    }
 
     # ----------------------------------------------------------------
     # Local reference to the parser subroutine
@@ -575,8 +570,8 @@ sub translate {
 
     eval { $producer_output = $producer->($self) };
     if ($@ || ! $producer_output) {
-        my $msg = sprintf "translate: Error with producer '%s': %s",
-            $producer_type, ($@) ? $@ : " no results";
+        my $err = $@ || $self->error || "no results";
+        my $msg = "translate: Error with producer '$producer_type': $err";
         return $self->error($msg);
     }
 
@@ -686,7 +681,7 @@ sub _list {
                 my $mod      =  $_;
                    $mod      =~ s/\.pm$//;
                 my $cur_dir  = $File::Find::dir;
-                my $base_dir = catfile 'SQL', 'Translator', $uctype;
+                my $base_dir = quotemeta catfile 'SQL', 'Translator', $uctype;
 
                 #
                 # See if the current directory is below the base directory.
@@ -780,6 +775,16 @@ sub isa($$) {
 }
 
 # ----------------------------------------------------------------------
+# version
+#
+# Returns the $VERSION of the main SQL::Translator package.
+# ----------------------------------------------------------------------
+sub version {
+    my $self = shift;
+    return $VERSION;
+}
+
+# ----------------------------------------------------------------------
 sub validate {
     my ( $self, $arg ) = @_;
     if ( defined $arg ) {
@@ -839,6 +844,10 @@ SQL::Translator - manipulate structured data definitions (SQL and more)
 
 =head1 DESCRIPTION
 
+This documentation covers the API for SQL::Translator.  For a more general
+discussion of how to use the modules and scripts, please see
+L<SQL::Translator::Manual>.
+
 SQL::Translator is a group of Perl modules that converts
 vendor-specific SQL table definitions into other formats, such as
 other vendor-specific SQL, ER diagrams, documentation (POD and HTML),
@@ -926,10 +935,11 @@ value, returns the current value.
 The C<producer> method is an accessor/mutator, used to retrieve or
 define what subroutine is called to produce the output.  A subroutine
 defined as a producer will be invoked as a function (I<not a method>)
-and passed 2 parameters: its container C<SQL::Translator> instance and a
-data structure.  It is expected that the function transform the data
-structure to a string.  The C<SQL::Transformer> instance is provided for
-informational purposes; for example, the type of the parser can be
+and passed its container C<SQL::Translator> instance, which it should
+call the C<schema> method on, to get the C<SQL::Translator::Schema> 
+generated by the parser.  It is expected that the function transform the
+schema structure to a string.  The C<SQL::Translator> instance is also useful 
+for informational purposes; for example, the type of the parser can be
 retrieved using the C<parser_type> method, and the C<error> and
 C<debug> methods can be called when needed.
 
@@ -1104,6 +1114,10 @@ Turns on/off the tracing option of Parse::RecDescent.
 Whether or not to validate the schema object after parsing and before
 producing.
 
+=head2 version
+
+Returns the version of the SQL::Translator release.
+
 =head1 AUTHORS
 
 The following people have contributed to the SQLFairy project:
@@ -1114,6 +1128,8 @@ The following people have contributed to the SQLFairy project:
 
 =item * Sam Angiuoli <angiuoli@users.sourceforge.net>
 
+=item * Dave Cash <dave@gnofn.org>
+
 =item * Darren Chamberlain <dlc@users.sourceforge.net>
 
 =item * Ken Y. Clark <kclark@cpan.org>