t/29html.t

   1 #!/usr/local/bin/perl -w
   2 # vim: set ft=perl:
   3
   4 # This test creates an HTML::Parser instance and uses it to selectively
   5 # parse the output of the HTML producer.  Rather than try to ensure
   6 # that the produced HTML turns into a particular parse tree or anything
   7 # like that, it performs some heuristics on the output.
   8
   9 use strict;
  10 use vars qw(%HANDLERS);
  11 use Test::More;
  12 use SQL::Translator;
  13 use Data::Dump qw(dump);
  14
  15 my ($p, $tables, $classes);
  16 eval {
  17     require HTML::Parser;
  18     $p = HTML::Parser->new(api_version => 3);
  19     $p->strict_names(1);
  20 };
  21 if ($@) {
  22     plan skip_all => "Missing HTML::Parser";
  23 }
  24
  25 my $create = q|
  26 CREATE TABLE foo (
  27     int id PRIMARY KEY AUTO_INCREMENT NOT NULL,
  28     name VARCHAR(255)
  29 );
  30 |;
  31
  32 my $tr = SQL::Translator->new(parser => 'MySQL', producer => 'HTML');
  33 my $parsed = $tr->translate(data => $create);
  34 my $status;
  35
  36 eval {
  37     $status = $p->parse($parsed);
  38 };
  39 if ($@) {
  40     plan tests => 1;
  41     fail("Unable to parse the output!");
  42     exit 1;
  43 }
  44
  45 plan tests => 5;
  46
  47 # General
  48 ok($parsed, "Parsed table OK");
  49 ok($status, "Parsed HTML OK");
  50
  51 $p->handler(start => @{$HANDLERS{count_tables}});
  52 $p->parse($parsed);
  53
  54 is($tables, 2, "One table in the SQL produces 2 <table> tags");
  55 $tables = $classes = 0;
  56
  57 $p->handler(start => @{$HANDLERS{count_classes}});
  58 $p->parse($parsed);
  59
  60 is($classes, 1, "One 'LinkTable' class");
  61 $tables = $classes = 0;
  62
  63 $p->handler(start => @{$HANDLERS{sqlfairy}});
  64 $p->parse($parsed);
  65
  66 is($classes, 1, "SQLfairy plug is alive and well ");
  67 $tables = $classes = 0;
  68
  69 # Handler functions for the parser
  70 BEGIN {
  71     %HANDLERS = (
  72         count_tables => [
  73             sub {
  74                 my $tagname = shift;
  75                 $tables++ if ($tagname eq 'table');
  76             }, 'tagname',
  77         ],
  78
  79         count_classes => [
  80             sub {
  81                 my ($tagname, $attr) = @_;
  82                 if ($tagname eq 'table' &&
  83                     $attr->{'class'} &&
  84                     $attr->{'class'} eq 'LinkTable') {
  85                     $classes++;
  86                 }
  87             }, 'tagname,attr',
  88         ],
  89
  90         sqlfairy => [
  91             sub {
  92                 my ($tagname, $attr) = @_;
  93                 if ($tagname eq 'a' &&
  94                     $attr->{'href'} &&
  95                     $attr->{'href'} =~ /sqlfairy/i) {
  96                     $classes++;
  97                 }
  98             }, 'tagname,attr',
  99         ],
 100     );
 101 }