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
155
156
157
158
159
|
#!/usr/bin/perl
use strict;
use JSON;
use File::Spec::Functions qw/ canonpath /;
my $usage = "This is from WL#5257 \"first API for optimizer trace\".
Usage:
%s [-q] <a_file> <another_file> <etc>
-q quiet mode: only display errors and warnings.
It will verify that all optimizer traces of files (usually a_file
is a .result or .reject file which contains
SELECT * FROM OPTIMIZER_TRACE; ) are JSON-compliant, and that
they contain no duplicates keys.
Exit code is 0 if all ok.";
my $retcode = 0;
my @ignored;
my @input = @ARGV;
# Filter out "-q" options
@input = grep {!/-q/} @input;
if (!@input)
{
print "$usage\n";
exit 1;
}
# If command line contains at least one "-q" option, it is quiet mode
my $quiet= scalar(@input) <= scalar(@ARGV) -1;
# On Windows, command line arguments specified using wildcards need to be evaluated.
# On Unix too if the arguments are passed with single quotes.
my $need_parse = grep(/\*/,@input);
if ($need_parse)
{
my $platform_independent_dir;
$platform_independent_dir= canonpath "@input";
@input= glob "$platform_independent_dir";
}
foreach my $input_file (@input)
{
handle_one_file($input_file);
print "\n";
}
if ( @ignored )
{
print STDERR "These files have been ignored:\n";
foreach my $ig ( @ignored )
{
print "$ig\n";
}
print "\n";
}
if ( $retcode )
{
print STDERR "There are errors\n";
}
else
{
print "\n";
print "ALL OK\n";
}
exit $retcode;
sub handle_one_file {
my ( $input_file ) = @_;
if ( $input_file =~ /^.*(ctype_.*|mysqldump)\.result/ )
{
push @ignored ,$input_file;
return;
}
print "FILE $input_file\n";
print "\n";
open(DATA,"<$input_file") or die "Can't open file";
my @lines = <DATA>;
close(DATA);
my $first_trace_line = 0;
my $trace_line = 0;
my @trace = undef;
label_to: foreach my $i ( @lines )
{
$trace_line = $trace_line + 1;
if (( grep(/^.*(\t)?{\n/,$i) ) and ( $first_trace_line == 0 ))
{
@trace = undef;
$first_trace_line = $trace_line;
push @trace, "{\n";
next label_to;
}
if (( $i =~ /^}/ ) and ( $first_trace_line != 0))
{
push @trace, "}";
check($first_trace_line,@trace);
$first_trace_line = 0;
}
if ( $first_trace_line != 0 )
{
# Eliminate /* */ from end_marker=on (not valid JSON)
$i =~ s/\/\*.*\*\// /g;
push @trace, $i;
}
}
}
sub check {
my ( $first_trace_line, @trace ) = @_;
my $string = join("", @trace);
my $parsed;
eval { $parsed = decode_json($string); };
unless ( $parsed )
{
print "Parse error at line: $first_trace_line\n";
my $error = $@;
print "Error: $@\n";
# If there is a character position specified, put a mark ('&') in front of this character
if ($error =~ /invalid character.*at character offset (\d+)/)
{
substr($string,$1,0) = "&";
print "$string\n";
}
else
{
print "$string\n";
}
$retcode = 1;
print "\n";
return;
}
# Detect non-unique keys in one object, by counting
# number of quote symbols ("): the json module outputs only
# one of the non-unique keys, making the number of "
# smaller compared to the input string.
my $before = $string =~ tr/'"'//;
my $re_json;
$re_json= to_json($parsed);
my $after = $re_json =~ tr/'"'//;
if ( $before != $after )
{
print "Non-unique keys at line $first_trace_line ( $before vs $after )\n";
print "$string\n";
$retcode = 1;
print "\n";
return;
}
if ( !$quiet )
{
print "OK at line $first_trace_line\n";
}
}
|
