Added Utils package with debug method, shared between MySQL and SQLite producers.

diff --git a/lib/SQL/Translator/Producer/MySQL.pm b/lib/SQL/Translator/Producer/MySQL.pm
index 54e0b71..3b80731 100644 (file)
--- a/lib/SQL/Translator/Producer/MySQL.pm
+++ b/lib/SQL/Translator/Producer/MySQL.pm
@@ -1,7 +1,7 @@
 package SQL::Translator::Producer::MySQL;
 
 # -------------------------------------------------------------------
-# $Id: MySQL.pm,v 1.8 2003-03-04 21:24:12 kycl4rk Exp $
+# $Id: MySQL.pm,v 1.9 2003-03-12 14:17:11 dlc Exp $
 # -------------------------------------------------------------------
 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
 #                    darren chamberlain <darren@cpan.org>,
@@ -24,10 +24,11 @@ package SQL::Translator::Producer::MySQL;
 
 use strict;
 use vars qw[ $VERSION $DEBUG ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/;
 $DEBUG   = 1 unless defined $DEBUG;
 
 use Data::Dumper;
+use SQL::Translator::Utils qw(debug);
 
 sub import {
     warn "loading " . __PACKAGE__ . "...\n";
@@ -39,7 +40,7 @@ sub produce {
     my $no_comments         = $translator->no_comments;
     my $add_drop_table      = $translator->add_drop_table;
 
-    debug("Beginning production\n");
+    debug("PKG: Beginning production\n");
 
     my $create; 
     unless ( $no_comments ) {
@@ -48,7 +49,7 @@ sub produce {
     }
 
     for my $table ( keys %{ $data } ) {
-        debug("Looking at table '$table'\n");
+        debug("PKG: Looking at table '$table'\n");
         my $table_data = $data->{$table};
         my @fields = sort { 
             $table_data->{'fields'}->{$a}->{'order'} 
@@ -68,7 +69,7 @@ sub produce {
         #
         for (my $i = 0; $i <= $#fields; $i++) {
             my $field = $fields[$i];
-            debug("Looking at field '$field'\n");
+            debug("PKG: Looking at field '$field'\n");
             my $field_data = $table_data->{'fields'}->{$field};
             my @fdata = ("", $field);
             $create .= "\n";
@@ -191,12 +192,6 @@ sub produce {
     return $create;
 }
 
-sub debug {
-    if ($DEBUG) {
-        map { warn "[" . __PACKAGE__ . "] $_" } @_;
-    }
-}
-
 1;
 __END__
 

diff --git a/lib/SQL/Translator/Producer/SQLite.pm b/lib/SQL/Translator/Producer/SQLite.pm
index e2013c0..774892f 100644 (file)
--- a/lib/SQL/Translator/Producer/SQLite.pm
+++ b/lib/SQL/Translator/Producer/SQLite.pm
@@ -1,7 +1,7 @@
 package SQL::Translator::Producer::SQLite;
 
 # -------------------------------------------------------------------
-# $Id: SQLite.pm,v 1.1 2003-03-04 21:24:13 kycl4rk Exp $
+# $Id: SQLite.pm,v 1.2 2003-03-12 14:17:11 dlc Exp $
 # -------------------------------------------------------------------
 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
 #                    darren chamberlain <darren@cpan.org>,
@@ -24,9 +24,10 @@ package SQL::Translator::Producer::SQLite;
 
 use strict;
 use Data::Dumper;
+use SQL::Translator::Utils qw(debug);
 
 use vars qw[ $VERSION $DEBUG $WARN ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
 
 my %used_identifiers = ();
 my $max_id_length    = 30;
@@ -44,7 +45,7 @@ sub produce {
     my $no_comments         = $translator->no_comments;
     my $add_drop_table      = $translator->add_drop_table;
 
-    debug("Beginning production\n");
+    debug("PKG: Beginning production\n");
 
     my $create; 
     unless ( $no_comments ) {
@@ -53,7 +54,7 @@ sub produce {
     }
 
     for my $table ( keys %{ $data } ) {
-        debug("Looking at table '$table'\n");
+        debug("PKG: Looking at table '$table'\n");
         my $table_data = $data->{$table};
         my @fields = sort { 
             $table_data->{'fields'}->{$a}->{'order'} 
@@ -73,7 +74,7 @@ sub produce {
         #
         for (my $i = 0; $i <= $#fields; $i++) {
             my $field = $fields[$i];
-            debug("Looking at field '$field'\n");
+            debug("PKG: Looking at field '$field'\n");
             my $field_data = $table_data->{'fields'}->{$field};
             my @fdata = ("", $field);
             $create .= "\n";
@@ -163,12 +164,6 @@ sub produce {
     return $create;
 }
 
-# -------------------------------------------------------------------
-sub debug {
-    if ($DEBUG) {
-        map { warn "[" . __PACKAGE__ . "] $_" } @_;
-    }
-}
 
 # -------------------------------------------------------------------
 sub mk_name {

diff --git a/lib/SQL/Translator/Utils.pm b/lib/SQL/Translator/Utils.pm
new file mode 100644 (file)
index 0000000..1832a5d
--- /dev/null
+++ b/lib/SQL/Translator/Utils.pm
@@ -0,0 +1,108 @@
+package SQL::Translator::Utils;
+
+# ----------------------------------------------------------------------
+# $Id: Utils.pm,v 1.1 2003-03-12 14:17:11 dlc Exp $
+# ----------------------------------------------------------------------
+# Copyright (C) 2003 darren chamberlain <darren@cpan.org>
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License as
+# published by the Free Software Foundation; version 2.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+# 02111-1307  USA
+# -------------------------------------------------------------------
+
+use strict;
+use base qw(Exporter);
+use vars qw($VERSION @EXPORT_OK);
+
+use Exporter;
+
+$VERSION = 1.00;
+@EXPORT_OK = ('debug');
+
+# ----------------------------------------------------------------------
+# debug(@msg)
+#
+# Will send debugging messages to STDERR, if the caller's $DEBUG global
+# is set.
+#
+# This debug() function has a neat feature: Occurances of the strings
+# PKG, LINE, and SUB in each message will be replaced with elements
+# from caller():
+#
+#   debug("PKG: Bad things happened on line LINE!");
+#
+# Will be warned as:
+#
+#   [SQL::Translator: Bad things happened on line 643]
+#
+# If called from Translator.pm, on line 643.
+# ----------------------------------------------------------------------
+sub debug {
+    my ($pkg, $file, $line, $sub) = caller(1);
+    {
+        no strict qw(refs);
+        return unless ${"$pkg\::DEBUG"};
+    }
+
+    $sub =~ s/^$pkg\:://;
+
+    while (@_) {
+        my $x = shift;
+        chomp $x;
+        $x =~ s/\bPKG\b/$pkg/g;
+        $x =~ s/\bLINE\b/$line/g;
+        $x =~ s/\bSUB\b/$sub/g;
+        #warn '[' . $x . "]\n";
+        print STDERR '[' . $x . "]\n";
+    }
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+SQL::Translator::Utils - SQL::Translator Utility functions
+
+=head1 SYNOPSIS
+
+  use SQL::Translator::Utils qw(debug);
+  debug("PKG: Bad things happened");
+
+=head1 DESCSIPTION
+
+C<SQL::Translator::Utils> contains utility functions designed to be
+used from the other modules within the C<SQL::Translator> modules.
+
+No functions are exported by default.
+
+=head1 EXPORTED FUNCTIONS
+
+=head2 debug
+
+C<debug> takes 0 or more messages, which will be sent to STDERR using
+C<warn>.  Occurances of the strings I<PKG>, I<SUB>, and I<LINE>
+will be replaced by the calling package, subroutine, and line number,
+respectively, as reported by C<caller(1)>.  
+
+For example, from within C<foo> in F<SQL/Translator.pm>, at line 666:
+
+  debug("PKG: Error reading file at SUB/LINE");
+
+Will warn
+
+  [SQL::Translator: Error reading file at foo/666]
+
+The entire message is enclosed within C<[> and C<]> for visual clarity
+when STDERR is intermixed with STDOUT.