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