~drizzle-trunk/drizzle/development

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
## Translator that translates some frequently used MySQL DML
## constructs to ANSI


package GenTest::Translator::MysqlDML2ANSI;

@ISA = qw(GenTest::Translator GenTest);

use strict;

use GenTest;

sub limit {
    my $dml = $_[1];
    $dml =~ s/\bLIMIT\s+(\d+)\s+OFFSET\s+(\d+)/OFFSET \2 ROWS FETCH NEXT \1 ROWS ONLY/;
    $dml =~ s/\bLIMIT\s+(\d+)\s*,\s*(\d+)/OFFSET \1 ROWS FETCH NEXT \2 ROWS ONLY/;
    $dml =~ s/\bLIMIT\s+(\d+)/FETCH FIRST \1 ROWS ONLY/gi;
    return $dml;
}

sub supported_join() {
    return 1;
}

sub join() {
    my $self = $_[0];
    my @p;
    $p[0]=$_[1];

    ## The subsitution in the while loop won't terminate if the number
    ## of parenthesises don't match, So we count them first:
    
    my $left = ($p[0] =~ tr/\(//);
    my $right = ($p[0] =~ tr/\)//);

    if ($left != $right) {
        ## Drop JOIN tranlation if parenthesises don't match
        return $p[0];
    }

    my $paren_rx;
    
    $paren_rx = qr{
  (?:
    \((??{$paren_rx})\) # either match another paren-set
    | [^()]+            # or match non-parens (or escaped parens
  )*
}x;
    
    my $n=0;
    my $m=-1;
    while ($m < $n)
    {
        $m++;
        my $str=$p[$m];
#        $str =~ s{(\(\s*SELECT\s+(??{$paren_rx})\))}{
        $str =~ s{(\(\s*(??{$paren_rx})\))}{
            my $hit = $1;
            $hit =~ s/^\((.*)\)$/\1/s;
            $n++;
            $p[$n] = $hit;
            " xxxx".$n."xxxx "
        }sgexi;
        $p[$m]=$str;
    };

    for (my $i=0; $i<=$n; $i++) {
        if (not $self->supported_join($p[$i])) {
            return 0;
        }
        my @c = split(/(\bCROSS\s+JOIN\b|\bINNER\s+JOIN\b|\bSTRAIGHT_JOIN\b|\bRIGHT\s+JOIN\b|\bLEFT\s+JOIN\b|\bFULL\s+JOIN\b|\bFULL\s+OUTER\s+JOIN\b|\bRIGHT\s+OUTER\s+JOIN\b|\bLEFT\s+OUTER\s+JOIN\b|\bJOIN\b|;)/,$p[$i]);
        for (my $j=0; $j<$#c; $j++) {
            if ($c[$j] =~ m/(RIGHT|FULL|LEFT|OUTER)\s+JOIN/i) {
                ### Do not fix OUTER JOINS. They're presumably ok
            } elsif ($c[$j] =~ m/\bSTRAIGHT_JOIN\b/) {
                ## 1. Fix STRAIGHT_JOIN
                if ($c[$j+1] =~ m/\bON\b/) {
                    $c[$j] =~ s/\bSTRAIGHT_JOIN\b/INNER JOIN/i;
                } else {
                    $c[$j] =~ s/\bSTRAIGHT_JOIN\b/CROSS JOIN/i;
                }
            } elsif ($c[$j] =~ m/\bCROSS\s+JOIN\b/) {
                ## 1. Fix CROSS JOIN with ON clause
                if ($c[$j+1] =~ m/\bON\b/) {
                    $c[$j] =~ s/\bCROSS\s+JOIN\b/INNER JOIN/i;
                }
            } elsif ($c[$j] =~ m/\bINNER\s+JOIN\b/) {
                ## 1. Fix INNER JOIN without ON clause
                if (not $c[$j+1] =~ m/\bON\b/) {
                    $c[$j] =~ s/\bINNER\s+JOIN\b/CROSS JOIN/i;
                }
            } elsif ($c[$j] =~ m/\bJOIN\b/) {
                ## Fix JOIN without ON clause
                if (not $c[$j+1] =~ m/\bON\b/) {
                    $c[$j] =~ s/\bJOIN\b/CROSS JOIN/i;
                }
            }
            ### Fix ON expression to ON (expression <> 0). This is a
            ### bad hack, but will work in a lot of the cases
            #if ($c[$j] =~ m/\bJOIN\b/i) {
            #    $c[$j+1] =~ s/\bON\s*([a-z0-9_`"]+\s*\.\s*[a-z0-9_\`"]+)/ON (\1 <> 0)/gi;
            #}

        }
        $p[$i] = join("",@c);
    }

    ## Final stuff
    for (my $i=0; $i<=$n; $i++) {
        ## Change all CROSS JOIN to ,-syntax
        $p[$i] =~ s/\bCROSS JOIN\b/,/gi;
    }
    
    for (my $i=$n; $i>=0; $i--) {
        while ($p[$i] =~ m/ xxxx(\d+)xxxx /) {
            my $no=$1;
            my $pattern = " xxxx".$no."xxxx ";
            $p[$i] =~ s/$pattern/\($p[$no]\)/;
        }
    }
    
    return $p[0];
}


my $lineno;
my @result;
sub translate {

    my $self = $_[0];

    my $dml = $_[1];

    # print ">>>>>>>>>>>>>>>>>>", $dml;
    
    $dml =~ s/\bSQL_SMALL_RESULT\b//gsi;

    ## SELECT STRAIGHT_JOIN is just translated to SELECT
    $dml =~ s/\bSELECT\s*STRAIGHT_JOIN\b/SELECT/gsi;

    $dml =~ s/CONCAT\s*\(([^,]+),([^)]+)\)/\(\1 || \2 \)/gsi;
    
    ## Translate LIMIT semantics into ANSI
    $dml = $self->limit($dml);

    ## Translate JOINS
    $dml = $self->join($dml);

    # print "<<<<<<<<<<<<<<<<<<", $dml;

    return $dml;
}

1;