From: Darren Chamberlain Date: Wed, 12 Mar 2003 14:17:11 +0000 (+0000) Subject: Added Utils package with debug method, shared between MySQL and SQLite producers. X-Git-Tag: v0.02~219 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1a24938d1a2b06fe79ad196d8d60e248fc04570f;p=dbsrgits%2FSQL-Translator.git 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 --- 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 , # darren chamberlain , @@ -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 --- 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 , # darren chamberlain , @@ -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 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 +# +# 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 contains utility functions designed to be +used from the other modules within the C modules. + +No functions are exported by default. + +=head1 EXPORTED FUNCTIONS + +=head2 debug + +C takes 0 or more messages, which will be sent to STDERR using +C. Occurances of the strings I, I, and I +will be replaced by the calling package, subroutine, and line number, +respectively, as reported by C. + +For example, from within C in F, 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.