1 package SQL::Translator::Validator;
3 # ----------------------------------------------------------------------
4 # $Id: Validator.pm,v 1.2 2002-03-27 12:41:53 dlc Exp $
5 # ----------------------------------------------------------------------
6 # Copyright (C) 2002 Ken Y. Clark <kycl4rk@users.sourceforge.net>,
7 # darren chamberlain <darren@cpan.org>
9 # This program is free software; you can redistribute it and/or
10 # modify it under the terms of the GNU General Public License as
11 # published by the Free Software Foundation; version 2.
13 # This program is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 # General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with this program; if not, write to the Free Software
20 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
22 # ----------------------------------------------------------------------
25 use vars qw($VERSION @EXPORT);
26 $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
29 use base qw(Exporter);
30 @EXPORT = qw(validate);
34 sub by_context($$$) { ($_[0]) ? ($_[1], $_[2]) : $_[1]; }
36 # XXX If called in scalar context, then validate should *not*
37 # genertate or return $log. It's a lot of extra work if we know we
38 # are not going to use it.
45 return by_context $wa, 0, "Not a reference";
48 unless (UNIVERSAL::isa($data, "HASH")) {
49 return by_context $wa, 0, "Not a HASH reference";
51 my $num = scalar keys %{$data};
52 $log = sprintf "Contains %d table%s.", $num, ($num == 1 ? "" : "s");
55 my @tables = sort keys %{$data};
56 for (my $i = 0; $i < @tables; $i++) {
57 my $table = $tables[$i];
58 my $table_num = $i + 1;
60 $log .= "\nTable $table_num: $table";
61 my $table_data = $data->{$table};
63 # Table must be a hashref
64 unless (UNIVERSAL::isa($table_data, "HASH")) {
65 return by_context $wa, 0,
66 "Table `$table' is not a HASH reference";
69 # Table must contain three elements: type, indeces, and fields
70 # XXX If there are other keys, is this an error?
71 unless (exists $table_data->{"type"}) {
72 return by_context $wa, 0, "Missing type for table `$table'";
74 $log .= sprintf "\n\tType: %s", $table_data->{"type"} ||
78 # Indeces: array of hashes
79 unless (defined $table_data->{"indeces"} &&
80 UNIVERSAL::isa($table_data->{"indeces"}, "ARRAY")) {
81 return by_context $wa, 0, "Indeces is missing or is not an ARRAY";
83 my @indeces = @{$table_data->{"indeces"}};
84 $log .= "\n\tIndeces:";
86 for my $index (@indeces) {
87 $log .= "\n\t\t" . ($index->{"name"} || "(unnamed)")
89 . join ", ", @{$index->{"fields"}};
92 $log .= " none defined";
97 unless (defined $table_data->{"fields"} &&
98 UNIVERSAL::isa($table_data->{"fields"}, "HASH")) {
99 return by_context $wa, 0, "Fields is missing or is not a HASH";
101 $log .= "\n\tFields:";
102 my @fields = sort { $table_data->{$a}->{"order"} <=>
103 $table_data->{$b}->{"order"}
104 } keys %{$table_data->{"fields"}};
105 for my $field (@fields) {
106 my $field_data = $table_data->{"fields"}->{$field};
107 $log .= qq|\n\t\t$field_data->{"name"}|
108 . qq| $field_data->{"data_type"} ($field_data->{"size"})|;
109 $log .= qq|\n\t\t\tDefault: $field_data->{"default"}|
110 if length $field_data->{"default"};
111 $log .= sprintf qq|\n\t\t\tNull: %s|,
112 $field_data->{"null"} ? "yes" : "no";
119 return by_context $wa, 1, $log;
128 SQL::Translator::Validate - Validate that a data structure is correct
135 use SQL::Translator::Validator;
137 my $tr = SQL::Translator->new(parser => "My::Swell::Parser");
139 # Default producer passes the data structure through unchanged
140 my $parsed = $tr->translate($datafile);
142 print "not " unless validate($parsed);
143 print "ok 1 # data structure looks OK\n";
147 When writing a parser module for SQL::Translator, it is helpful to
148 have a tool to automatically check the return of your module, to make
149 sure that it is returning the Right Thing. While only a full Producer
150 and the associated database can determine if you are producing valud
151 output, SQL::Translator::Validator can tell you if the basic format of
152 the data structure is correct. While this will not catch many errors,
153 it will catch the basic ones.
155 SQL::Translator::Validator can be used as a development tool, a
156 testing tool (every SQL::Translator install will have this module),
157 or, potentially, even as a runtime assertion for producers you don't
160 $tr->producer(\¶noid_producer);
161 sub paranoid_producer {
162 my ($tr, $data) = @_;
163 return unless validate($data);
167 SQL::Translator::Validator can also be used as a reporting tool. When
168 B<validate> is called in a list context, the second value returned
169 (assuming the data structure is well-formed) is a summary of the
170 table's information. For example, the following table definition
173 CREATE TABLE random (
174 id int(11) not null default 1,
175 seed char(32) not null default 1
178 CREATE TABLE session (
180 id int(11) not null default 1 primary key
183 Produces the following summary:
188 Indeces: none defined
208 =head1 EXPORTED FUNCTIONS
210 SQL::Translator::Validator exports a single function, called
211 B<validate>, which expects a data structure as its only argument.
212 When called in scalar context, it returns a 1 (valid data structure)
213 or 0 (not a valid data structure). In list context, B<validate>
214 returns a 2 element list: the first element is a 1 or 0, as in scalar
215 context, and the second value is a reason (for a malformed data
216 structure) or a summary of the data (for a well-formed data
225 color, either via Term::ANSI, or something along those lines, or just
226 plain $RED = "\033[31m" type stuff.
232 darren chamberlain E<lt>darren@cpan.orgE<gt>