Release 0.09005
[dbsrgits/SQL-Translator.git] / t / 29html.t
CommitLineData
45e4da22 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
9use strict;
10use vars qw(%HANDLERS);
11use Test::More;
2d691ec1 12use Test::SQL::Translator qw(maybe_plan);
45e4da22 13use SQL::Translator;
45e4da22 14
2d691ec1 15BEGIN {
16 maybe_plan(5,
17 'HTML::Parser',
18 'SQL::Translator::Parser::MySQL',
19 'SQL::Translator::Producer::HTML');
45e4da22 20}
21
2d691ec1 22my ($p, $tables, $classes);
23$p = HTML::Parser->new(api_version => 3);
24$p->strict_names(1);
25
45e4da22 26my $create = q|
27CREATE TABLE foo (
28 int id PRIMARY KEY AUTO_INCREMENT NOT NULL,
29 name VARCHAR(255)
30);
31|;
32
33my $tr = SQL::Translator->new(parser => 'MySQL', producer => 'HTML');
f9c96971 34my $parsed = $tr->translate(data => $create) or die $tr->error;
45e4da22 35my $status;
36
37eval {
38 $status = $p->parse($parsed);
39};
40if ($@) {
f9c96971 41 daig $@;
45e4da22 42 fail("Unable to parse the output!");
45e4da22 43}
44
45e4da22 45# General
46ok($parsed, "Parsed table OK");
47ok($status, "Parsed HTML OK");
48
49$p->handler(start => @{$HANDLERS{count_tables}});
50$p->parse($parsed);
51
8e8f4959 52is($tables, 3, "One table in the SQL produces 3 <table> tags");
45e4da22 53$tables = $classes = 0;
54
55$p->handler(start => @{$HANDLERS{count_classes}});
56$p->parse($parsed);
57
58is($classes, 1, "One 'LinkTable' class");
59$tables = $classes = 0;
60
61$p->handler(start => @{$HANDLERS{sqlfairy}});
62$p->parse($parsed);
63
64is($classes, 1, "SQLfairy plug is alive and well ");
65$tables = $classes = 0;
66
67# Handler functions for the parser
68BEGIN {
69 %HANDLERS = (
70 count_tables => [
71 sub {
72 my $tagname = shift;
73 $tables++ if ($tagname eq 'table');
74 }, 'tagname',
75 ],
76
77 count_classes => [
78 sub {
79 my ($tagname, $attr) = @_;
80 if ($tagname eq 'table' &&
81 $attr->{'class'} &&
82 $attr->{'class'} eq 'LinkTable') {
83 $classes++;
84 }
85 }, 'tagname,attr',
86 ],
87
88 sqlfairy => [
89 sub {
90 my ($tagname, $attr) = @_;
91 if ($tagname eq 'a' &&
92 $attr->{'href'} &&
93 $attr->{'href'} =~ /sqlfairy/i) {
94 $classes++;
95 }
96 }, 'tagname,attr',
97 ],
98 );
99}