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}