lib/SQL/Translator/Validator.pm

   1 package SQL::Translator::Validator;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Validator.pm,v 1.3 2002-06-11 12:09:13 dlc Exp $
   5 # ----------------------------------------------------------------------
   6 # Copyright (C) 2002 Ken Y. Clark <kycl4rk@users.sourceforge.net>,
   7 #                    darren chamberlain <darren@cpan.org>
   8 #
   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.
  12 #
  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.
  17 #
  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
  21 # 02111-1307  USA
  22 # ----------------------------------------------------------------------
  23
  24 use strict;
  25 use vars qw($VERSION @EXPORT);
  26 $VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
  27
  28 use Exporter;
  29 use base qw(Exporter);
  30 @EXPORT = qw(validate);
  31
  32 use Data::Dumper;
  33
  34 sub by_context($$$) { ($_[0]) ? ($_[1], $_[2]) : $_[1]; }
  35
  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.
  39 sub validate {
  40     my $data = shift;
  41     my $wa = wantarray;
  42     my ($ok, $log);
  43
  44     unless (ref $data) {
  45         return by_context $wa, 0, "Not a reference";
  46     }
  47
  48     unless (UNIVERSAL::isa($data, "HASH")) {
  49         return by_context $wa, 0, "Not a HASH reference";
  50     } else {
  51         my $num = scalar keys %{$data};
  52         $log = sprintf "Contains %d table%s.", $num, ($num == 1 ? "" : "s");
  53     }
  54
  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;
  59
  60         $log .= "\nTable $table_num: $table";
  61         my $table_data = $data->{$table};
  62
  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";
  67         }
  68
  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'";
  73         } else {
  74             $log .= sprintf "\n\tType: %s", $table_data->{"type"} ||
  75                 "not defined";
  76         }
  77
  78         # Indices: array of hashes
  79         unless (defined $table_data->{"indeces"} &&
  80                 UNIVERSAL::isa($table_data->{"indeces"}, "ARRAY")) {
  81             return by_context $wa, 0, "Indices is missing or is not an ARRAY";
  82         } else {
  83             my @indeces = @{$table_data->{"indeces"}};
  84             $log .= "\n\tIndices:";
  85             if (@indeces) {
  86                 for my $index (@indeces) {
  87                     $log .= "\n\t\t" . ($index->{"name"} || "(unnamed)")
  88                          .  " on "
  89                          .  join ", ", @{$index->{"fields"}};
  90                 }
  91             } else {
  92                 $log .= " none defined";
  93             }
  94         }
  95
  96         # Fields
  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";
 100         } else {
 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";
 113             }
 114         }
 115     }
 116
 117     $log .= "\n";
 118
 119     return by_context $wa, 1, $log;
 120 }
 121
 122
 123 1;
 124 __END__
 125
 126 =head1 NAME
 127
 128 SQL::Translator::Validate - Validate that a data structure is correct
 129
 130 =head1 SYNOPSIS
 131
 132   print "1..1\n";
 133
 134   use SQL::Translator;
 135   use SQL::Translator::Validator;
 136
 137   my $tr = SQL::Translator->new(parser => "My::Swell::Parser");
 138
 139   # Default producer passes the data structure through unchanged
 140   my $parsed = $tr->translate($datafile);
 141
 142   print "not " unless validate($parsed);
 143   print "ok 1 # data structure looks OK\n";
 144
 145 =head1 DESCRIPTION
 146
 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 valid
 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.
 154
 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
 158 trust:
 159
 160   $tr->producer(\&paranoid_producer);
 161   sub paranoid_producer {
 162       my ($tr, $data) = @_;
 163       return unless validate($data);
 164
 165       # continue...
 166
 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
 171 (MySQL format):
 172
 173   CREATE TABLE random (
 174     id  int(11) not null default 1,
 175     seed char(32) not null default 1
 176   );
 177
 178   CREATE TABLE session (
 179     foo char(255),
 180     id int(11) not null default 1 primary key
 181   ) TYPE=HEAP;
 182
 183 Produces the following summary:
 184
 185     Contains 2 tables.
 186     Table 1: random
 187             Type: not defined
 188             Indices: none defined
 189             Fields:
 190                     id int (11)
 191                             Default: 1
 192                             Null: no
 193                     seed char (32)
 194                             Default: 1
 195                             Null: no
 196     Table 2: session
 197             Type: HEAP
 198             Indices:
 199                     (unnamed) on id
 200             Fields:
 201                     foo char (255)
 202                             Null: yes
 203                     id int (11)
 204                             Default: 1
 205                             Null: no
 206
 207
 208 =head1 EXPORTED FUNCTIONS
 209
 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
 217 structure).
 218
 219 =head1 TODO
 220
 221 =over 4
 222
 223 =item *
 224
 225 color, either via Term::ANSI, or something along those lines, or just
 226 plain $RED = "\033[31m" type stuff.
 227
 228 =back
 229
 230 =head1 AUTHOR
 231
 232 darren chamberlain E<lt>darren@cpan.orgE<gt>