lib/SQL/Translator/Validator.pm

   1 package SQL::Translator::Validator;
   2
   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>
   9 #
  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.
  13 #
  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.
  18 #
  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
  22 # 02111-1307  USA
  23 # ----------------------------------------------------------------------
  24
  25 use strict;
  26 use vars qw($VERSION @EXPORT);
  27 $VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/;
  28
  29 use Exporter;
  30 use base qw(Exporter);
  31 @EXPORT = qw(validate);
  32
  33 use Data::Dumper;
  34
  35 sub by_context($$$) { ($_[0]) ? ($_[1], $_[2]) : $_[1]; }
  36
  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.
  40 sub validate {
  41     my $data = shift;
  42     my $wa = wantarray;
  43     my ($ok, $log);
  44
  45     unless (ref $data) {
  46         return by_context $wa, 0, "Not a reference";
  47     }
  48
  49     unless (UNIVERSAL::isa($data, "HASH")) {
  50         return by_context $wa, 0, "Not a HASH reference";
  51     } else {
  52         my $num = scalar keys %{$data};
  53         $log = sprintf "Contains %d table%s.", $num, ($num == 1 ? "" : "s");
  54     }
  55
  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;
  60
  61         $log .= "\nTable $table_num: $table";
  62         my $table_data = $data->{$table};
  63
  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";
  68         }
  69
  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'";
  74         } else {
  75             $log .= sprintf "\n\tType: %s", $table_data->{"type"} ||
  76                 "not defined";
  77         }
  78
  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";
  83         } else {
  84             my @indices = @{$table_data->{"indices"}};
  85             $log .= "\n\tIndices:";
  86             if (@indices) {
  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)")
  91                          .  " on "
  92                          .  join ", ", @{$index->{"fields"} ||= []};
  93                 }
  94             } else {
  95                 $log .= " none defined";
  96             }
  97         }
  98
  99         # Fields
 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";
 103         } else {
 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";
 116             }
 117         }
 118     }
 119
 120     $log .= "\n";
 121
 122     return by_context $wa, 1, $log;
 123 }
 124
 125
 126 1;
 127 __END__
 128
 129 =head1 NAME
 130
 131 SQL::Translator::Validate - Validate that a data structure is correct
 132
 133 =head1 SYNOPSIS
 134
 135   use Test::More plan tests => 1;
 136   use SQL::Translator;
 137   use SQL::Translator::Validator;
 138
 139   my $tr = SQL::Translator->new(parser => "My::Swell::Parser");
 140
 141   # Default producer passes the data structure through unchanged
 142   my $parsed = $tr->translate($datafile);
 143
 144   ok(validate($parsed), "data structure conformance to definition");
 145
 146 =head1 DESCRIPTION
 147
 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.
 155
 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
 159 trust:
 160
 161   $tr->producer(\&paranoid_producer, real_producer => "MySQL");
 162   sub paranoid_producer {
 163       my ($tr, $data) = @_;
 164       validate($data) or die "You gave me crap!"
 165
 166       # Load real producer, and execute it
 167       $tr->producer($tr->producer_args->{'real_producer'});
 168       return $tr->produce($data);
 169   }
 170
 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
 175 (MySQL format):
 176
 177   CREATE TABLE random (
 178     id  int(11) not null default 1,
 179     seed char(32) not null default 1
 180   );
 181
 182   CREATE TABLE session (
 183     foo char(255),
 184     id int(11) not null default 1 primary key
 185   ) TYPE=HEAP;
 186
 187 Produces the following summary:
 188
 189     Contains 2 tables.
 190     Table 1: random
 191             Type: not defined
 192             Indices: none defined
 193             Fields:
 194                     id int (11)
 195                             Default: 1
 196                             Null: no
 197                     seed char (32)
 198                             Default: 1
 199                             Null: no
 200     Table 2: session
 201             Type: HEAP
 202             Indices:
 203                     (unnamed) on id
 204             Fields:
 205                     foo char (255)
 206                             Null: yes
 207                     id int (11)
 208                             Default: 1
 209                             Null: no
 210
 211
 212 =head1 EXPORTED FUNCTIONS
 213
 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
 221 structure).
 222
 223 =head1 TODO
 224
 225 =over 4
 226
 227 =item *
 228
 229 color, either via Term::ANSI, or something along those lines, or just
 230 plain $RED = "\033[31m" type stuff.
 231
 232 =back
 233
 234 =head1 AUTHOR
 235
 236 darren chamberlain E<lt>darren@cpan.orgE<gt>