1 package SQL::Translator::Validator;
3 # ----------------------------------------------------------------------
4 # $Id: Validator.pm,v 1.7 2003-01-27 17:04:45 dlc Exp $
5 # ----------------------------------------------------------------------
6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>,
7 # darren chamberlain <darren@cpan.org>,
8 # Chris Mungall <cjm@fruitfly.org>
10 # This program is free software; you can redistribute it and/or
11 # modify it under the terms of the GNU General Public License as
12 # published by the Free Software Foundation; version 2.
14 # This program is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 # General Public License for more details.
19 # You should have received a copy of the GNU General Public License
20 # along with this program; if not, write to the Free Software
21 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
23 # ----------------------------------------------------------------------
26 use vars qw($VERSION @EXPORT);
27 $VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/;
30 use base qw(Exporter);
31 @EXPORT = qw(validate);
35 sub by_context($$$) { ($_[0]) ? ($_[1], $_[2]) : $_[1]; }
37 # XXX If called in scalar context, then validate should *not*
38 # genertate or return $log. It's a lot of extra work if we know we
39 # are not going to use it.
46 return by_context $wa, 0, "Not a reference";
49 unless (UNIVERSAL::isa($data, "HASH")) {
50 return by_context $wa, 0, "Not a HASH reference";
52 my $num = scalar keys %{$data};
53 $log = sprintf "Contains %d table%s.", $num, ($num == 1 ? "" : "s");
56 my @tables = sort keys %{$data};
57 for (my $i = 0; $i < @tables; $i++) {
58 my $table = $tables[$i];
59 my $table_num = $i + 1;
61 $log .= "\nTable $table_num: $table";
62 my $table_data = $data->{$table};
64 # Table must be a hashref
65 unless (UNIVERSAL::isa($table_data, "HASH")) {
66 return by_context $wa, 0,
67 "Table `$table' is not a HASH reference";
70 # Table must contain three elements: type, indices, and fields
71 # XXX If there are other keys, is this an error?
72 unless (exists $table_data->{"type"}) {
73 return by_context $wa, 0, "Missing type for table `$table'";
75 $log .= sprintf "\n\tType: %s", $table_data->{"type"} ||
79 # Indices: array of hashes
80 unless (defined $table_data->{"indices"} &&
81 UNIVERSAL::isa($table_data->{"indices"}, "ARRAY")) {
82 return by_context $wa, 0, "Indices is missing or is not an ARRAY";
84 my @indices = @{$table_data->{"indices"}};
85 $log .= "\n\tIndices:";
87 for my $index (@indices) {
88 $log .= "\n\t\t" . ($index->{"name"} || "(unnamed)")
90 . join ", ", @{$index->{"fields"}};
93 $log .= " none defined";
98 unless (defined $table_data->{"fields"} &&
99 UNIVERSAL::isa($table_data->{"fields"}, "HASH")) {
100 return by_context $wa, 0, "Fields is missing or is not a HASH";
102 $log .= "\n\tFields:";
103 my @fields = sort { $table_data->{$a}->{"order"} <=>
104 $table_data->{$b}->{"order"}
105 } keys %{$table_data->{"fields"}};
106 for my $field (@fields) {
107 my $field_data = $table_data->{"fields"}->{$field};
108 $log .= qq|\n\t\t$field_data->{"name"}|
109 . qq| $field_data->{"data_type"} ($field_data->{"size"})|;
110 $log .= qq|\n\t\t\tDefault: $field_data->{"default"}|
111 if length $field_data->{"default"};
112 $log .= sprintf qq|\n\t\t\tNull: %s|,
113 $field_data->{"null"} ? "yes" : "no";
120 return by_context $wa, 1, $log;
129 SQL::Translator::Validate - Validate that a data structure is correct
133 use Test::More plan tests => 1;
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 ok(validate($parsed), "data structure conformance to definition");
146 When writing a parser module for SQL::Translator, it is helpful to
147 have a tool to automatically check the return of your module, to make
148 sure that it is returning the Right Thing. While only a full Producer
149 and the associated database can determine if you are producing valid
150 output, SQL::Translator::Validator can tell you if the basic format of
151 the data structure is correct. While this will not catch many errors,
152 it will catch the basic ones.
154 SQL::Translator::Validator can be used as a development tool, a
155 testing tool (every SQL::Translator install will have this module),
156 or, potentially, even as a runtime assertion for producers you don't
159 $tr->producer(\¶noid_producer, real_producer => "MySQL");
160 sub paranoid_producer {
161 my ($tr, $data) = @_;
162 validate($data) or die "You gave me crap!"
164 # Load real producer, and execute it
165 $tr->producer($tr->producer_args->{'real_producer'});
166 return $tr->produce($data);
169 SQL::Translator::Validator can also be used as a reporting tool. When
170 B<validate> is called in a list context, the second value returned
171 (assuming the data structure is well-formed) is a summary of the
172 table's information. For example, the following table definition
175 CREATE TABLE random (
176 id int(11) not null default 1,
177 seed char(32) not null default 1
180 CREATE TABLE session (
182 id int(11) not null default 1 primary key
185 Produces the following summary:
190 Indices: none defined
210 =head1 EXPORTED FUNCTIONS
212 SQL::Translator::Validator exports a single function, called
213 B<validate>, which expects a data structure as its only argument.
214 When called in scalar context, it returns a 1 (valid data structure)
215 or 0 (not a valid data structure). In list context, B<validate>
216 returns a 2 element list: the first element is a 1 or 0, as in scalar
217 context, and the second value is a reason (for a malformed data
218 structure) or a summary of the data (for a well-formed data
227 color, either via Term::ANSI, or something along those lines, or just
228 plain $RED = "\033[31m" type stuff.
234 darren chamberlain E<lt>darren@cpan.orgE<gt>