HTML producer test. Uses HTML::Parser.
[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;
12use SQL::Translator;
13use Data::Dump qw(dump);
14
15my ($p, $tables, $classes);
16eval {
17 require HTML::Parser;
18 $p = HTML::Parser->new(api_version => 3);
19 $p->strict_names(1);
20};
21if ($@) {
22 plan skip_all => "Missing HTML::Parser";
23}
24
25my $create = q|
26CREATE TABLE foo (
27 int id PRIMARY KEY AUTO_INCREMENT NOT NULL,
28 name VARCHAR(255)
29);
30|;
31
32my $tr = SQL::Translator->new(parser => 'MySQL', producer => 'HTML');
33my $parsed = $tr->translate(data => $create);
34my $status;
35
36eval {
37 $status = $p->parse($parsed);
38};
39if ($@) {
40 plan tests => 1;
41 fail("Unable to parse the output!");
42 exit 1;
43}
44
45plan tests => 5;
46
47# General
48ok($parsed, "Parsed table OK");
49ok($status, "Parsed HTML OK");
50
51$p->handler(start => @{$HANDLERS{count_tables}});
52$p->parse($parsed);
53
54is($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
60is($classes, 1, "One 'LinkTable' class");
61$tables = $classes = 0;
62
63$p->handler(start => @{$HANDLERS{sqlfairy}});
64$p->parse($parsed);
65
66is($classes, 1, "SQLfairy plug is alive and well ");
67$tables = $classes = 0;
68
69# Handler functions for the parser
70BEGIN {
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}