lib/SQL/Translator/Validator.pm

   1 package SQL::Translator::Validator;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Validator.pm,v 1.6 2002-11-25 14:49:44 dlc Exp $
   5 # ----------------------------------------------------------------------
   6 # Copyright (C) 2002 Ken Y. Clark <kclark@cpan.org>,
   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.6 $ =~ /(\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, indices, 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->{"indices"} &&
  80                 UNIVERSAL::isa($table_data->{"indices"}, "ARRAY")) {
  81             return by_context $wa, 0, "Indices is missing or is not an ARRAY";
  82         } else {
  83             my @indices = @{$table_data->{"indices"}};
  84             $log .= "\n\tIndices:";
  85             if (@indices) {
  86                 for my $index (@indices) {
  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       validate($data) or die "You gave me crap!"
 164
 165       # Load real producer, and execute it
 166       $tr->producer("MySQL");
 167       return $tr->produce($data);
 168   }
 169
 170 SQL::Translator::Validator can also be used as a reporting tool.  When
 171 B<validate> is called in a list context, the second value returned
 172 (assuming the data structure is well-formed) is a summary of the
 173 table's information.  For example, the following table definition
 174 (MySQL format):
 175
 176   CREATE TABLE random (
 177     id  int(11) not null default 1,
 178     seed char(32) not null default 1
 179   );
 180
 181   CREATE TABLE session (
 182     foo char(255),
 183     id int(11) not null default 1 primary key
 184   ) TYPE=HEAP;
 185
 186 Produces the following summary:
 187
 188     Contains 2 tables.
 189     Table 1: random
 190             Type: not defined
 191             Indices: none defined
 192             Fields:
 193                     id int (11)
 194                             Default: 1
 195                             Null: no
 196                     seed char (32)
 197                             Default: 1
 198                             Null: no
 199     Table 2: session
 200             Type: HEAP
 201             Indices:
 202                     (unnamed) on id
 203             Fields:
 204                     foo char (255)
 205                             Null: yes
 206                     id int (11)
 207                             Default: 1
 208                             Null: no
 209
 210
 211 =head1 EXPORTED FUNCTIONS
 212
 213 SQL::Translator::Validator exports a single function, called
 214 B<validate>, which expects a data structure as its only argument.
 215 When called in scalar context, it returns a 1 (valid data structure)
 216 or 0 (not a valid data structure).  In list context, B<validate>
 217 returns a 2 element list: the first element is a 1 or 0, as in scalar
 218 context, and the second value is a reason (for a malformed data
 219 structure) or a summary of the data (for a well-formed data
 220 structure).
 221
 222 =head1 TODO
 223
 224 =over 4
 225
 226 =item *
 227
 228 color, either via Term::ANSI, or something along those lines, or just
 229 plain $RED = "\033[31m" type stuff.
 230
 231 =back
 232
 233 =head1 AUTHOR
 234
 235 darren chamberlain E<lt>darren@cpan.orgE<gt>