1#!/usr/bin/perl
2
3# use module
4use strict;
5use XML::Simple;
6use Data::Dumper;
7use Getopt::Long qw(GetOptions);
8
9my %errors = ();
10my %warnings = ();
11
12sub LogError {
13    if (CheckSuppression($_[0], $_[1])) {
14        return;
15    }
16
17    my $errordetail;
18    $errordetail->{'file'} = $_[0];
19    $errordetail->{'code'} = $_[1];
20    $errordetail->{'description'} = $_[2];
21    #print Dumper($errordetail);
22    push(@{$errors{$_[0]}}, $errordetail);
23}
24
25sub LogWarning {
26    if (CheckSuppression($_[0], $_[1])) {
27        return;
28    }
29
30    my $warningdetail;
31    $warningdetail->{'file'} = $_[0];
32    $warningdetail->{'code'} = $_[1];
33    $warningdetail->{'description'} = $_[2];
34    push(@{$warnings{$_[0]}}, $warningdetail);
35
36}
37
38# check common config file mistakes
39sub CheckConfig {
40    use strict;
41    use warnings;
42    my $file = $_[0];
43    my $count = 1;
44    open my $info, $file or die "Could not open $file: $!";
45    while( my $line = <$info>)  {
46        if ($line =~ /[[:^ascii:]]/) {
47            LogError($file, 5, "Line $count, contains non ASCII characters");
48        }
49        ++$count;
50    }
51    close $info;
52
53    # create object
54    my $xml = new XML::Simple;
55    # read XML file
56    my $data = $xml->XMLin($_[0], ForceArray => [ 'Group' ]);
57    # print output
58    #print Dumper($data->{CommandClass}->{133});
59    foreach my $group ($data->{CommandClass}->{133}->{Associations}->{Group}) {
60        if (defined($group)) {
61            my $arrSize = @{$group};
62            if ($arrSize != $data->{CommandClass}->{133}->{Associations}->{num_groups}) {
63                LogError($_[0], 4, "Number of Groups does not equal Group Entries");
64            }
65            foreach my $entry (@{$group}) {
66                if ((defined($entry->{auto}))
67                 && ($entry->{index} == 1)
68                  && (lc $entry->{auto} eq "true")) {
69                    LogError($_[0], 1,"Association Group 1 has auto equal to true");
70                }
71                if ((defined($entry->{auto}))
72                && ($entry->{index} != 1)
73                && (lc $entry->{auto} eq "false")) {
74                    LogError($_[0], 2, "Association Group $entry->{index} has auto set to False");
75                }
76            }
77        } else {
78            LogWarning($_[0], 3, "No Association Groups Defined for device");
79        }
80    }
81    $data = $xml->XMLin($_[0], ForceArray => [ 'Value' ]);
82    # print output
83    foreach my $valueItem ($data->{CommandClass}->{112}->{Value}) {
84        if (defined($valueItem)) {
85            foreach my $configuration (@{$valueItem}) {
86                if ((defined($configuration->{type})) && (lc $configuration->{type} eq "list") && (not defined($configuration->{size}))) {
87                    LogError($_[0], 2, "Parameter: $configuration->{index} The size must be set for a list");
88                }
89                if ((defined($configuration->{type})) && (lc $configuration->{type} eq "byte") && (defined($configuration->{size}) && ($configuration->{size} != 1 ))) {
90                    LogError($_[0], 2, "Parameter: $configuration->{index} The size is wrong for a byte");
91                }
92                if ((defined($configuration->{type})) && (lc $configuration->{type} eq "short") && (defined($configuration->{size}) && ($configuration->{size} != 2 ))) {
93                    LogError($_[0], 2, "Parameter: $configuration->{index} The size is wrong for a short");
94                }
95                if ((defined($configuration->{type})) && (lc $configuration->{type} eq "int") && (defined($configuration->{size}) && ($configuration->{size} != 3 && $configuration->{size} != 4 ))) {
96                    LogError($_[0], 2, "Parameter: $configuration->{index} The size is wrong for a int");
97                }
98             }
99        }
100    }
101}
102
103# check files match entries in manufacture_specific.xml
104
105sub CheckFileExists {
106    my %configfiles = map { lc $_ => 1} @{$_[0]};
107    # create object
108    my $xml = new XML::Simple;
109
110    # read XML file
111    my $data = $xml->XMLin("config/manufacturer_specific.xml", KeyAttr => "", ForceArray => [ 'Product' ] );
112    foreach my $manu (@{$data->{Manufacturer}}) {
113        if (defined($manu->{Product})) {
114            foreach my $config (@{$manu->{Product}}) {
115                if (defined($config->{config})) {
116                    #print Dumper($config->{config});
117                    if (!-e "config/$config->{config}") {
118                        LogError("manufacturer_specific.xml", 5, "Config File config/$config->{config} Specified in manufacturer_specific.xml doesn't exist");
119                    } else {
120                        delete $configfiles{lc "config/$config->{config}"};
121                    }
122                }
123            }
124        }
125    }
126    #anything left in $configfiles hasn't been specified in manufacturer_specific.xml
127    #print Dumper(%configfiles);
128    foreach my $unreffile (keys %configfiles) {
129        LogWarning("manufacturer_specific.xml", 7, "Unreferenced Config File $unreffile present on file system");
130    }
131}
132
133sub PrettyPrintErrors() {
134    if (length(%errors) > 1) {
135        print "\n\nErrors: (Please Correct before Submitting to OZW)\n";
136        while ((my $key, my $value) = each %errors) {
137            foreach my $detail (@{$value}) {
138                print $key.": ".$detail->{description}." - Error Code $detail->{code}\n";
139            }
140            print "\n";
141        }
142    }
143    else {
144        print "\n\nNo errors detected (You can submit your changes to OZW)\n";
145    }
146}
147
148sub PrettyPrintWarnings() {
149	print "\n\nWarnings: (Can be Ignored)\n";
150	while ((my $key, my $value) = each %warnings) {
151		foreach my $detail (@{$value}) {
152			print $key.": ".$detail->{description}." - Warning Code $detail->{code}\n";
153		}
154		print "\n";
155	}
156}
157
158sub XMLPrintErrors() {
159	my $numerrs  = 0;
160	while ((my $key, my $value) = each %errors)	{
161		foreach my $detail (@{$value}) {
162			$numerrs++;
163		}
164	}
165	open(my $fh, '>', 'results/OZW_CheckConfig.xml') or die "Could not open file results\OZW_CheckConfig.xml $!";
166	print $fh "<testsuite failures=\"0\" assertions=\"\" name=\"OZW_CheckConfig\" tests=\"1\" errors=\"$numerrs\" time=\"\">\n";
167	while ((my $key, my $value) = each %errors)	{
168		foreach my $detail (@{$value}) {
169			print $fh "\t<testcase assertions=\"1\" name=\"$detail->{code}-$detail->{file}\" time=\"\">\n";
170			print $fh "\t\t<failure type=\"ScriptError\" message=\"$detail->{description}\"></failure>\n";
171			print $fh "\t\t<system-out>\n";
172			print $fh "\t\t<![CDATA[File: $detail->{file}\nDescription: $detail->{description}\nError Code: $detail->{code}]]>\n";
173			print $fh "\t\t</system-out>\n";
174			print $fh "\t</testcase>\n";
175		}
176	}
177	print $fh "</testsuite>\n";
178	close $fh;
179}
180
181sub XMLPrintWarnings() {
182	my $numerrs  = 0;
183	while ((my $key, my $value) = each %warnings) {
184		foreach my $detail (@{$value}) {
185			$numerrs++;
186		}
187	}
188	open(my $fh, '>', 'results/OZW_CheckConfigWarnings.xml') or die "Could not open file results\OZW_CheckConfig.xml $!";
189	print $fh "<testsuite failures=\"0\" assertions=\"\" name=\"OZW_CheckConfigWarnings\" tests=\"1\" errors=\"$numerrs\" time=\"\">\n";
190	while ((my $key, my $value) = each %warnings) {
191		foreach my $detail (@{$value}) {
192			print $fh "\t<testcase assertions=\"1\" name=\"$detail->{code}-$detail->{file}\" time=\"\">\n";
193			print $fh "\t\t<failure type=\"ScriptError\" message=\"$detail->{description}\"></failure>\n";
194			print $fh "\t\t<system-out>\n";
195			print $fh "\t\t<![CDATA[File: $detail->{file}\nDescription: $detail->{description}\nError Code: $detail->{code}]]>\n";
196			print $fh "\t\t</system-out>\n";
197			print $fh "\t</testcase>\n";
198		}
199	}
200	print $fh "</testsuite>\n";
201	close $fh;
202}
203
204# Read a configuration file
205#   The arg can be a relative or full path, or
206#   it can be a file located somewhere in @INC.
207sub ReadCfg {
208    my $file = "./cpp/build/testconfigsuppressions.cfg";
209    our $err;
210    {   # Put config data into a separate namespace
211        package CFG;
212        # Process the contents of the config file
213        my $rc = do($file);
214        # Check for errors
215        if ($@) {
216            $::err = "ERROR: Failure compiling '$file' - $@";
217        } elsif (! defined($rc)) {
218            $::err = "ERROR: Failure reading '$file' - $!";
219        } elsif (! $rc) {
220            $::err = "ERROR: Failure processing '$file'";
221        }
222    }
223    return ($err);
224}
225
226sub CheckSuppression {
227	my $file = $_[0];
228	my $code = $_[1];
229	if (defined($CFG::CFG{$file}) && $CFG::CFG{$file}{'code'} == $code) {
230		return 1
231	}
232	return;
233}
234
235my $doxml;
236my $printwarnings;
237GetOptions(	"printwarnings" => \$printwarnings,
238			"outputxml" => \$doxml
239			) or die("Error in Command Line arguements\n");
240
241if (my $err = ReadCfg()) {
242    print(STDERR $err, "\n");
243    exit(1);
244}
245
246print "Checking Config Files... Please Wait\n";
247my $dirname="config";
248opendir(DIR, $dirname);
249my @dirs = readdir(DIR);
250closedir DIR;
251my @filelist;
252foreach my $key (@dirs) {
253 	next if ($key eq ".");
254  	next if ($key eq "..");
255  	if(-d "$dirname/$key") {
256  		my @files = glob("$dirname/$key/*.xml");
257   		foreach my $file (@files) {
258    		next if ($file eq ".");
259    		next if ($file eq "..");
260			push(@filelist, $file);
261    		#print "Checking $file\n";
262    		CheckConfig("$file");
263   		}
264  	}
265}
266
267CheckFileExists(\@filelist);
268
269if ($doxml == 0) {
270	PrettyPrintErrors();
271}
272if ($doxml == 0 && $printwarnings == 1) {
273	PrettyPrintWarnings();
274}
275if ($doxml == 1) {
276	XMLPrintErrors();
277}
278if ($doxml == 1 && $printwarnings == 1) {
279	XMLPrintWarnings();
280}