# # Software Index, Copyright 2010, Software Index Project Team # Link: http://swi.sourceforge.net # # This file is part of Software Index Tool. # # Software Index is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, version 3 of the License. # # Software Index is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Software Index. If not, see . # use strict; use XML::Simple; use Internal::Output; use FileHandle; use Data::Dumper; # # Export section # require Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $PREFERRED_PARSER); @ISA = qw(Exporter); @EXPORT = qw(swiAppraise); @EXPORT_OK = qw(); $VERSION = '1.0'; $PREFERRED_PARSER = undef; # # Subroutine for troubleshooting purposes # use Internal::Output; # # Global variables # my $config = undef; my $report = undef; # # Enter point # sub swiAppraise { $config = shift(); my $reportBase = undef; $report = XMLin( $config->{"swi:report"}->{"swi:destination"} . "/" . $config->{"swi:report"}->{"swi:xml"}->{"swi:name"} . ".x", ForceArray => [ "swi:module", "swi:file", "swi:function", "swi:reference" ] ); if ( defined( $config->{"swi:report"}->{"swi:xml"}->{"swi:baseline"} ) && $config->{"swi:report"}->{"swi:xml"}->{"swi:baseline"} ne "" ) { $reportBase = XMLin( $config->{"swi:report"}->{"swi:destination"} . "/" . $config->{"swi:report"}->{"swi:xml"}->{"swi:baseline"}, ForceArray => [ "swi:module", "swi:file", "swi:function", "swi:reference" ] ); } my $projectStat = $report->{"swi:statistic"}; for ( my $moduleId = 0 ; $moduleId <= $#{ $report->{"swi:module"} } ; $moduleId++ ) { my $moduleStat = $report->{"swi:module"}[$moduleId]->{"swi:statistic"}; for ( my $fileId = 0 ; $fileId <= $#{ $report->{"swi:module"}[$moduleId]->{"swi:file"} } ; $fileId++ ) { my $fileStat = $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId] ->{"swi:statistic"}; for ( my $functionId = 0 ; $functionId <= $#{ $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId] ->{"swi:function"} } ; $functionId++ ) { my $functionStat = $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId] ->{"swi:function"}[$functionId]->{"swi:statistic"}; foreach my $keyStat ( keys %$functionStat ) { my $subStat = $functionStat->{$keyStat}; foreach my $keySubStat ( keys %$subStat ) { # add total per file $fileStat->{$keyStat}->{$keySubStat}->{"swi:total"} += $subStat->{$keySubStat}->{'swi:exact'}; $fileStat->{$keyStat}->{$keySubStat}->{"swi:average"} = $fileStat->{$keyStat}->{$keySubStat}->{"swi:total"} / $fileStat->{"swi:count"}->{"swi:functions"} ->{'swi:exact'}; # add total per module $moduleStat->{$keyStat}->{$keySubStat}->{"swi:total"} += $subStat->{$keySubStat}->{'swi:exact'}; $moduleStat->{$keyStat}->{$keySubStat} ->{"swi:average"} = $moduleStat->{$keyStat}->{$keySubStat} ->{"swi:total"} / $moduleStat->{"swi:count"}->{"swi:functions"} ->{'swi:exact'}; # add total per project $projectStat->{$keyStat}->{$keySubStat} ->{"swi:total"} += $subStat->{$keySubStat}->{'swi:exact'}; $projectStat->{$keyStat}->{$keySubStat} ->{"swi:average"} = $projectStat->{$keyStat}->{$keySubStat} ->{"swi:total"} / $projectStat->{"swi:count"}->{"swi:functions"} ->{'swi:exact'}; # add minimum per file if ( !defined( $fileStat->{$keyStat}->{$keySubStat} ->{"swi:min"} ) || $fileStat->{$keyStat}->{$keySubStat} ->{"swi:min"} > $subStat->{$keySubStat}->{'swi:exact'} ) { $fileStat->{$keyStat}->{$keySubStat}->{"swi:min"} = $subStat->{$keySubStat}->{'swi:exact'}; } # add minimum per module if ( !defined( $moduleStat->{$keyStat}->{$keySubStat} ->{"swi:min"} ) || $moduleStat->{$keyStat}->{$keySubStat} ->{"swi:min"} > $subStat->{$keySubStat}->{'swi:exact'} ) { $moduleStat->{$keyStat}->{$keySubStat} ->{"swi:min"} = $subStat->{$keySubStat}->{'swi:exact'}; } # add minimum per project if ( !defined( $projectStat->{$keyStat}->{$keySubStat} ->{"swi:min"} ) || $projectStat->{$keyStat}->{$keySubStat} ->{"swi:min"} > $subStat->{$keySubStat}->{'swi:exact'} ) { $projectStat->{$keyStat}->{$keySubStat} ->{"swi:min"} = $subStat->{$keySubStat}->{'swi:exact'}; } # add maximum per file if ( !defined( $fileStat->{$keyStat}->{$keySubStat} ->{"swi:max"} ) || $fileStat->{$keyStat}->{$keySubStat} ->{"swi:max"} < $subStat->{$keySubStat}->{'swi:exact'} ) { $fileStat->{$keyStat}->{$keySubStat}->{"swi:max"} = $subStat->{$keySubStat}->{'swi:exact'}; } # add maximum per module if ( !defined( $moduleStat->{$keyStat}->{$keySubStat} ->{"swi:max"} ) || $moduleStat->{$keyStat}->{$keySubStat} ->{"swi:max"} < $subStat->{$keySubStat}->{'swi:exact'} ) { $moduleStat->{$keyStat}->{$keySubStat} ->{"swi:max"} = $subStat->{$keySubStat}->{'swi:exact'}; } # add maximum per project if ( !defined( $projectStat->{$keyStat}->{$keySubStat} ->{"swi:max"} ) || $projectStat->{$keyStat}->{$keySubStat} ->{"swi:max"} < $subStat->{$keySubStat}->{'swi:exact'} ) { $projectStat->{$keyStat}->{$keySubStat} ->{"swi:max"} = $subStat->{$keySubStat}->{'swi:exact'}; } } } } } } # generate full XML report my $outputFile = $config->{"swi:report"}->{"swi:destination"} . "/" . $config->{"swi:report"}->{"swi:xml"}->{"swi:name"}; my $fh = new FileHandle( $outputFile, "w" ) or die("Can not open output file '$outputFile'!"); print $fh "\n"; print $fh "\n"; print $fh "\n"; print $fh " \n"; print $fh " 1.0\n"; if ( defined( $ENV{USER} ) ) { print $fh " " . $ENV{USER} . "\n"; } print $fh " SWI/APPRAISER\n"; print $fh " \n"; print $fh "\n"; $projectStat = $report->{"swi:statistic"}; my $projectName = $config->{"swi:info"}->{"swi:project"}->{"swi:name"}; my $projectDiff = swiReportModificationGet( $reportBase, $report, "swi:total" ); for ( my $moduleId = 0 ; $moduleId <= $#{ $report->{"swi:module"} } ; $moduleId++ ) { my $moduleStat = $report->{"swi:module"}[$moduleId]->{"swi:statistic"}; my $moduleName = $report->{"swi:module"}[$moduleId]->{"swi:name"}; my $moduleBase = swiReportObjectFind( $reportBase->{"swi:module"}, $moduleName ); my $moduleDiff = swiReportModificationGet( $moduleBase, $report->{"swi:module"}[$moduleId], "swi:total" ); print $fh " \n"; print $fh " " . $moduleName . "\n"; print $fh " " . $report->{"swi:module"}[$moduleId]->{"swi:location"} . "\n"; print $fh " " . $moduleDiff . "\n"; print $fh "\n"; for ( my $fileId = 0 ; $fileId <= $#{ $report->{"swi:module"}[$moduleId]->{"swi:file"} } ; $fileId++ ) { my $fileStat = $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId] ->{"swi:statistic"}; my $fileName = $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId] ->{"swi:name"}; my $fileBase = ( $moduleDiff eq "added" ) ? undef : swiReportObjectFind( $moduleBase->{"swi:file"}, $fileName ); my $fileDiff = swiReportModificationGet( $fileBase, $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId], "swi:total" ); print $fh " \n"; print $fh " " . $fileName . "\n"; print $fh " " . $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId] ->{"swi:location"} . "\n"; print $fh " " . $fileDiff . "\n"; print $fh "\n"; for ( my $functionId = 0 ; $functionId <= $#{ $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId] ->{"swi:function"} } ; $functionId++ ) { my $functionStat = $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId] ->{"swi:function"}[$functionId]->{"swi:statistic"}; my $functionName = $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId] ->{"swi:function"}[$functionId]->{"swi:name"}; my $functionBase = ( $fileDiff eq "added" ) ? undef : swiReportObjectFind( $fileBase->{"swi:function"}, $functionName ); my $functionDiff = swiReportModificationGet( $functionBase, $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId] ->{"swi:function"}[$functionId], "swi:exact" ); print $fh " \n"; print $fh " " . XMLout( $functionName, RootName => 'swi:name' ); print $fh " " . XMLout( $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId] ->{"swi:function"}[$functionId]->{"swi:location"}, RootName => 'swi:location' ); print $fh " " . XMLout( $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId] ->{"swi:function"}[$functionId]->{"swi:modifier"}, RootName => 'swi:modifier' ); print $fh " " . XMLout( $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId] ->{"swi:function"}[$functionId]->{"swi:pointer"}, RootName => 'swi:pointer' ); print $fh " " . $functionDiff . "\n"; print $fh " \n"; foreach my $keyStat ( keys %$functionStat ) { print $fh " <" . $keyStat . ">\n"; my $subStat = $functionStat->{$keyStat}; foreach my $keySubStat ( keys %$subStat ) { my ( $level, $suppress, $criteria ) = swiStatisticLevelGet( $keyStat, $keySubStat, "swi:exact", $projectName . "/" . $moduleName . "/" . $fileName . "/" . $functionName, $functionStat, "swi:function" ); my $statDiff = swiStatisticDiffGet( $functionDiff, $functionStat->{$keyStat}->{$keySubStat} ->{'swi:exact'}, $functionBase->{"swi:statistic"}->{$keyStat} ->{$keySubStat}->{"swi:exact"}->{'content'} ); print $fh " <" . $keySubStat . ">" . $functionStat->{$keyStat}->{$keySubStat} ->{'swi:exact'} . "\n"; } print $fh " \n"; } print $fh " \n"; my $refers = $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId] ->{"swi:function"}[$functionId]->{'swi:reference'}; if ( defined($refers) ) { foreach my $refData ( @{$refers} ) { if ( $refData->{'swi:ref:type'} eq 'scan' ) { foreach my $pattern ( @{ $config->{'swi:modules'} ->{"swi:module"}[$moduleId] ->{'swi:scanner'}->{'swi:suppress'} ->{'swi:pattern'} } ) { my $msgPattern = $pattern->{'swi:message'}; my $objPattern = $pattern->{'content'}; if ( $refData->{'swi:scan:message'} =~ m/$msgPattern/ && "$projectName/$moduleName/$fileName/$functionName" =~ m/$objPattern/ ) { $refData->{'swi:scan:suppress'} = 'on'; $pattern->{'swi:used'} = 1; last; } } } } my $refStr = XMLout( $refers, RootName => '' ); $refStr =~ s/\n/\n /g; $refStr =~ s/\n"; print $fh "\n"; } for ( my $functionId = 0 ; $functionId <= $#{ $fileBase->{"swi:function"} } ; $functionId++ ) { my $functionOld = $fileBase->{"swi:function"}[$functionId]; if ( swiReportObjectFind( $report->{"swi:module"}[$moduleId] ->{"swi:file"}[$fileId]->{"swi:function"}, $functionOld->{"swi:name"} ) == undef ) { print $fh " \n"; print $fh " " . $functionOld->{"swi:name"} . "\n"; print $fh " " . $functionOld->{"swi:location"} . "\n"; print $fh " removed\n"; print $fh " \n"; print $fh "\n"; } } print $fh " \n"; foreach my $keyStat ( keys %$fileStat ) { print $fh " <" . $keyStat . ">\n"; my $subStat = $fileStat->{$keyStat}; foreach my $keySubStat ( keys %$subStat ) { my @types = ( "swi:exact", "swi:average", "swi:min", "swi:max", "swi:total" ); print $fh " <" . $keySubStat . ">\n"; foreach my $type (@types) { if ( defined( $fileStat->{$keyStat}->{$keySubStat}->{$type} ) ) { my ( $level, $suppress, $criteria ) = swiStatisticLevelGet( $keyStat, $keySubStat, $type, $projectName . "/" . $moduleName . "/" . $fileName, $fileStat, "swi:file" ); my $statDiff = swiStatisticDiffGet( $fileDiff, $fileStat->{$keyStat}->{$keySubStat}->{$type}, $fileBase->{"swi:statistic"}->{$keyStat} ->{$keySubStat}->{$type}->{'content'} ); print $fh " <" . $type . " swi:change=\"" . $statDiff . "\" swi:level=\"" . $level . "\" swi:suppress=\"" . $suppress . "\" swi:criteria=\"" . $criteria . "\">" . sprintf( "%.2f", $fileStat->{$keyStat}->{$keySubStat}->{$type} ) . "\n"; } } print $fh " \n"; } print $fh " \n"; } print $fh " \n"; print $fh " \n"; print $fh "\n"; } for ( my $fileId = 0 ; $fileId <= $#{ $moduleBase->{"swi:file"} } ; $fileId++ ) { my $fileOld = $moduleBase->{"swi:file"}[$fileId]; if ( swiReportObjectFind( $report->{"swi:module"}[$moduleId]->{"swi:file"}, $fileOld->{"swi:name"} ) == undef ) { print $fh " \n"; print $fh " " . $fileOld->{"swi:name"} . "\n"; print $fh " " . $fileOld->{"swi:location"} . "\n"; print $fh " removed\n"; print $fh " \n"; print $fh "\n"; } } print $fh " \n"; foreach my $keyStat ( keys %$moduleStat ) { print $fh " <" . $keyStat . ">\n"; my $subStat = $moduleStat->{$keyStat}; foreach my $keySubStat ( keys %$subStat ) { my @types = ( "swi:exact", "swi:average", "swi:min", "swi:max", "swi:total" ); print $fh " <" . $keySubStat . ">\n"; foreach my $type (@types) { if ( defined( $moduleStat->{$keyStat}->{$keySubStat}->{$type} ) ) { my ( $level, $suppress, $criteria ) = swiStatisticLevelGet( $keyStat, $keySubStat, $type, $projectName . "/" . $moduleName, $moduleStat, "swi:module" ); my $statDiff = swiStatisticDiffGet( $moduleDiff, $moduleStat->{$keyStat}->{$keySubStat}->{$type}, $moduleBase->{"swi:statistic"}->{$keyStat} ->{$keySubStat}->{$type}->{'content'} ); print $fh " <" . $type . " swi:change=\"" . $statDiff . "\" swi:level=\"" . $level . "\" swi:suppress=\"" . $suppress . "\" swi:criteria=\"" . $criteria . "\">" . sprintf( "%.2f", $moduleStat->{$keyStat}->{$keySubStat}->{$type} ) . "\n"; } } print $fh " \n"; } print $fh " \n"; } print $fh " \n"; print $fh " \n"; print $fh "\n"; } for ( my $moduleId = 0 ; $moduleId <= $#{ $reportBase->{"swi:module"} } ; $moduleId++ ) { my $moduleOld = $reportBase->{"swi:module"}[$moduleId]; if ( swiReportObjectFind( $report->{"swi:module"}, $moduleOld->{"swi:name"} ) == undef ) { print $fh " \n"; print $fh " " . $moduleOld->{"swi:name"} . "\n"; print $fh " " . $moduleOld->{"swi:location"} . "\n"; print $fh " removed\n"; print $fh " \n"; print $fh "\n"; } } print $fh " \n"; foreach my $keyStat ( keys %$projectStat ) { print $fh " <" . $keyStat . ">\n"; my $subStat = $projectStat->{$keyStat}; foreach my $keySubStat ( keys %$subStat ) { my @types = ( "swi:exact", "swi:average", "swi:min", "swi:max", "swi:total" ); print $fh " <" . $keySubStat . ">\n"; foreach my $type (@types) { if ( defined( $projectStat->{$keyStat}->{$keySubStat}->{$type} ) ) { my ( $level, $suppress, $criteria ) = swiStatisticLevelGet( $keyStat, $keySubStat, $type, $projectName, $projectStat, "swi:project" ); my $statDiff = swiStatisticDiffGet( $projectDiff, $projectStat->{$keyStat}->{$keySubStat}->{$type}, $reportBase->{"swi:statistic"}->{$keyStat} ->{$keySubStat}->{$type}->{'content'} ); print $fh " <" . $type . " swi:change=\"" . $statDiff . "\" swi:level=\"" . $level . "\" swi:suppress=\"" . $suppress . "\" swi:criteria=\"" . $criteria . "\">" . sprintf( "%.2f", $projectStat->{$keyStat}->{$keySubStat}->{$type} ) . "\n"; } } print $fh " \n"; } print $fh " \n"; } print $fh " \n"; print $fh "\n"; swiCheckUselessPatterns($config); return 0; } sub swiStatisticLevelGet { my $keyStat = shift(); my $keySubStat = shift(); my $type = shift(); my $objName = shift(); my $objStat = shift(); my $objType = shift(); my $statValue = undef; # Array of results: level, suppress level, criteria my @returnResult = ( "undefined", "undefined", "" ); if ( defined( $config->{"swi:limits"}->{$keyStat}->{$keySubStat}->{$type} ) ) { my $limit = $config->{"swi:limits"}->{$keyStat}->{$keySubStat}->{$type}; my $objectPattern = $limit->{"swi:objectpattern"}; if ( defined($objectPattern) && $objName !~ m/$objectPattern/ ) { $returnResult[2] = '[limit not applied]'; } else { if ( defined( $limit->{"swi:relation"} ) ) { my @relation = undef; @relation = split( /\//, $limit->{"swi:relation"} ); my $factor = $objStat->{ $relation[0] }->{ $relation[1] } ->{ $relation[2] }; if ( !defined($factor) ) { STATUS( "Wrong configuration for the limit '$keyStat/$keySubStat/$type'. Relation " . $limit->{"swi:relation"} . " is not found for the object '$objName'" ); $factor = 0; } if ($factor == 0) { # Devide zero by zero, equals to 1 if ($objStat->{$keyStat}->{$keySubStat}->{$type} == 0) { $statValue = "1.00"; } # Devide negative number by zero, equals to -infinity elsif ($objStat->{$keyStat}->{$keySubStat}->{$type} < 0) { $statValue = '(-)Infinity'; } # Devide positive number by zero, equals to infinity else { $statValue = '(+)Infinity'; } } else { $statValue = $objStat->{$keyStat}->{$keySubStat}->{$type} / $factor; $statValue = sprintf( "%.2f", $statValue ); } } else { $statValue = sprintf( "%.2f", $objStat->{$keyStat}->{$keySubStat}->{$type} ); } if ( $limit->{"swi:warning"} > $limit->{"swi:notice"} && $limit->{"swi:notice"} > $limit->{"swi:info"} ) { if ( $statValue eq '(-)Infinity' ) { $returnResult[0] = "regular"; $returnResult[2] = "[" . $statValue . " less than " . $limit->{"swi:info"} . "]"; } elsif ( $statValue eq '(+)Infinity' || $statValue > $limit->{"swi:warning"} ) { $returnResult[0] = "warning"; $returnResult[2] = "[" . $statValue . " greater than " . $limit->{"swi:warning"} . "]"; } elsif ( $statValue > $limit->{"swi:notice"} ) { $returnResult[0] = "notice"; $returnResult[2] = "[" . $statValue . " greater than " . $limit->{"swi:notice"} . "]"; } elsif ( $statValue > $limit->{"swi:info"} ) { $returnResult[0] = "info"; $returnResult[2] = "[" . $statValue . " greater than " . $limit->{"swi:info"} . "]"; } else { $returnResult[0] = "regular"; $returnResult[2] = "[" . $statValue . " less than " . $limit->{"swi:info"} . "]"; } } elsif ($limit->{"swi:warning"} < $limit->{"swi:notice"} && $limit->{"swi:notice"} < $limit->{"swi:info"} ) { if ( $statValue eq '(+)Infinity' ) { $returnResult[0] = "regular"; $returnResult[2] = "[" . $statValue . " greater than " . $limit->{"swi:info"} . "]"; } elsif ( $statValue eq '(-)Infinity' || $statValue < $limit->{"swi:warning"} ) { $returnResult[0] = "warning"; $returnResult[2] = "[" . $statValue . " less than " . $limit->{"swi:warning"} . "]"; } elsif ( $statValue < $limit->{"swi:notice"} ) { $returnResult[0] = "notice"; $returnResult[2] = "[" . $statValue . " less than " . $limit->{"swi:notice"} . "]"; } elsif ( $statValue < $limit->{"swi:info"} ) { $returnResult[0] = "info"; $returnResult[2] = "[" . $statValue . " less than " . $limit->{"swi:info"} . "]"; } else { $returnResult[0] = "regular"; $returnResult[2] = "[" . $statValue . " greater than " . $limit->{"swi:info"} . "]"; } } else { STATUS( "Wrong settings in configuration file (swi:limits section): swi:limit/$keyStat/$keySubStat/$type" ); $returnResult[0] = "unresolved"; } # check if suppressed my $isFound = 0; LOOPPATTERNS: foreach ( @{ $limit->{"swi:suppress"}->{"swi:pattern"} } ) { my $pattern = $_; if ( ref($pattern) eq "HASH" && defined( $pattern->{"swi:level"} ) ) { my $content = $pattern->{"content"}; if ( $objName =~ m/$content/ ) { if ( $isFound == 0 ) { $returnResult[1] = $pattern->{"swi:level"}; $pattern->{'swi:used'} = 1; $isFound = 1; } else { # This object is matched by several patterns if ( $returnResult[1] ne $pattern->{"swi:level"} ) { # and levels are not equal in different patterns STATUS( "Configuration is wrong: $objName is matched by several patterns" ); $returnResult[1] = "unresolved"; } } } } else { STATUS( "Wrong settings in configuration file (swi:limits section): swi:limits/$keyStat/$keySubStat/$type: " . "Level is missed in pattern for the object '$objType'" ); $returnResult[1] = "unresolved"; $returnResult[2] = "[]"; } } } } return @returnResult; } sub swiStatisticDiffGet { my $objDiff = shift(); my $newStat = shift(); my $oldStat = shift(); if ( $objDiff ne "added" ) { return sprintf( "%.2f", $newStat - $oldStat ); } return ""; } sub swiReportObjectFind { my $objects = shift(); my $objName = shift(); foreach (@$objects) { if ( $_->{"swi:name"} eq $objName && $_->{"swi:modification"} ne "removed" ) { return $_; } } return undef; } sub swiReportModificationGet { my $objBase = shift(); my $objNew = shift(); my $statType = shift(); if ( !defined($objBase) ) { return "added"; } my $newCrc = $objNew->{"swi:statistic"}->{"swi:checksum"}->{"swi:source"}->{$statType}; my $newLength = $objNew->{"swi:statistic"}->{"swi:length"}->{"swi:source"}->{$statType}; my $newDup = $objNew->{"swi:statistic"}->{"swi:duplication"}->{"swi:symbols"} ->{$statType}; if ( $objBase->{"swi:statistic"}->{"swi:checksum"}->{"swi:source"} ->{$statType}->{'content'} != $newCrc || $objBase->{"swi:statistic"}->{"swi:length"}->{"swi:source"} ->{$statType}->{'content'} != $newLength ) { return "modified"; } if ( $objBase->{"swi:statistic"}->{"swi:duplication"}->{"swi:symbols"} ->{$statType}->{'content'} != $newDup ) { return "cloned"; } return "unmodified"; } sub swiCheckUselessPatterns { my $root = shift(); if ( ref($root) eq "HASH" ) { foreach my $key ( keys %{$root} ) { if ( $key eq 'swi:pattern' ) { foreach my $pattern ( @{ $root->{'swi:pattern'} } ) { if ( !defined( $pattern->{'swi:used'} ) || $pattern->{'swi:used'} == 0 ) { my $data = Dumper($pattern); $data =~ s/\n/ /g; $data =~ s/\s+/ /g; STATUS( "Useless suppress option detected with the following content: $data" ); } } return; } swiCheckUselessPatterns( $root->{$key} ); } } elsif ( ref($root) eq "ARRAY" ) { foreach ( @{$root} ) { return swiCheckUselessPatterns($_); } } return; } return 1;