1 package SQL::Translator::Validator;
3 # ----------------------------------------------------------------------
4 # $Id: Validator.pm,v 1.8 2003-04-17 13:42:44 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.8 $ =~ /(\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 next unless ref($index) eq 'HASH';
89 next unless scalar keys %$index;
90 $log .= "\n\t\t" . ($index->{"name"} || "(unnamed)")
92 . join ", ", @{$index->{"fields"} ||= []};
95 $log .= " none defined";
100 unless (defined $table_data->{"fields"} &&
101 UNIVERSAL::isa($table_data->{"fields"}, "HASH")) {
102 return by_context $wa, 0, "Fields is missing or is not a HASH";
104 $log .= "\n\tFields:";
105 my @fields = sort { $table_data->{$a}->{"order"} <=>
106 $table_data->{$b}->{"order"}
107 } keys %{$table_data->{"fields"}};
108 for my $field (@fields) {
109 my $field_data = $table_data->{"fields"}->{$field};
110 $log .= qq|\n\t\t$field_data->{"name"}|
111 . qq| $field_data->{"data_type"} ($field_data->{"size"})|;
112 $log .= qq|\n\t\t\tDefault: $field_data->{"default"}|
113 if length $field_data->{"default"};
114 $log .= sprintf qq|\n\t\t\tNull: %s|,
115 $field_data->{"null"} ? "yes" : "no";
122 return by_context $wa, 1, $log;
131 SQL::Translator::Validate - Validate that a data structure is correct
135 use Test::More plan tests => 1;
137 use SQL::Translator::Validator;
139 my $tr = SQL::Translator->new(parser => "My::Swell::Parser");
141 # Default producer passes the data structure through unchanged
142 my $parsed = $tr->translate($datafile);
144 ok(validate($parsed), "data structure conformance to definition");
148 When writing a parser module for SQL::Translator, it is helpful to
149 have a tool to automatically check the return of your module, to make
150 sure that it is returning the Right Thing. While only a full Producer
151 and the associated database can determine if you are producing valid
152 output, SQL::Translator::Validator can tell you if the basic format of
153 the data structure is correct. While this will not catch many errors,
154 it will catch the basic ones.
156 SQL::Translator::Validator can be used as a development tool, a
157 testing tool (every SQL::Translator install will have this module),
158 or, potentially, even as a runtime assertion for producers you don't
161 $tr->producer(\¶noid_producer, real_producer => "MySQL");
162 sub paranoid_producer {
163 my ($tr, $data) = @_;
164 validate($data) or die "You gave me crap!"
166 # Load real producer, and execute it
167 $tr->producer($tr->producer_args->{'real_producer'});
168 return $tr->produce($data);
171 SQL::Translator::Validator can also be used as a reporting tool. When
172 B<validate> is called in a list context, the second value returned
173 (assuming the data structure is well-formed) is a summary of the
174 table's information. For example, the following table definition
177 CREATE TABLE random (
178 id int(11) not null default 1,
179 seed char(32) not null default 1
182 CREATE TABLE session (
184 id int(11) not null default 1 primary key
187 Produces the following summary:
192 Indices: none defined
212 =head1 EXPORTED FUNCTIONS
214 SQL::Translator::Validator exports a single function, called
215 B<validate>, which expects a data structure as its only argument.
216 When called in scalar context, it returns a 1 (valid data structure)
217 or 0 (not a valid data structure). In list context, B<validate>
218 returns a 2 element list: the first element is a 1 or 0, as in scalar
219 context, and the second value is a reason (for a malformed data
220 structure) or a summary of the data (for a well-formed data
229 color, either via Term::ANSI, or something along those lines, or just
230 plain $RED = "\033[31m" type stuff.
236 darren chamberlain E<lt>darren@cpan.orgE<gt>