Appraiser.pm 34 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906
  1. #
  2. # Software Index, Copyright 2010, Software Index Project Team
  3. # Link: http://swi.sourceforge.net
  4. #
  5. # This file is part of Software Index Tool.
  6. #
  7. # Software Index is free software: you can redistribute it and/or modify
  8. # it under the terms of the GNU General Public License as published by
  9. # the Free Software Foundation, version 3 of the License.
  10. #
  11. # Software Index is distributed in the hope that it will be useful,
  12. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. # GNU General Public License for more details.
  15. #
  16. # You should have received a copy of the GNU General Public License
  17. # along with Software Index. If not, see <http://www.gnu.org/licenses/>.
  18. #
  19. use strict;
  20. use XML::Simple;
  21. use Internal::Output;
  22. use FileHandle;
  23. use Data::Dumper;
  24. #
  25. # Export section
  26. #
  27. require Exporter;
  28. use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $PREFERRED_PARSER);
  29. @ISA = qw(Exporter);
  30. @EXPORT = qw(swiAppraise);
  31. @EXPORT_OK = qw();
  32. $VERSION = '1.0';
  33. $PREFERRED_PARSER = undef;
  34. #
  35. # Subroutine for troubleshooting purposes
  36. #
  37. use Internal::Output;
  38. #
  39. # Global variables
  40. #
  41. my $config = undef;
  42. my $report = undef;
  43. #
  44. # Enter point
  45. #
  46. sub swiAppraise
  47. {
  48. $config = shift();
  49. my $reportBase = undef;
  50. $report = XMLin(
  51. $config->{"swi:report"}->{"swi:destination"} . "/"
  52. . $config->{"swi:report"}->{"swi:xml"}->{"swi:name"} . ".x",
  53. ForceArray =>
  54. [ "swi:module", "swi:file", "swi:function", "swi:reference" ]
  55. );
  56. if ( defined( $config->{"swi:report"}->{"swi:xml"}->{"swi:baseline"} )
  57. && $config->{"swi:report"}->{"swi:xml"}->{"swi:baseline"} ne "" )
  58. {
  59. $reportBase = XMLin(
  60. $config->{"swi:report"}->{"swi:destination"} . "/"
  61. . $config->{"swi:report"}->{"swi:xml"}->{"swi:baseline"},
  62. ForceArray =>
  63. [ "swi:module", "swi:file", "swi:function", "swi:reference" ]
  64. );
  65. }
  66. my $projectStat = $report->{"swi:statistic"};
  67. for (
  68. my $moduleId = 0 ;
  69. $moduleId <= $#{ $report->{"swi:module"} } ;
  70. $moduleId++
  71. )
  72. {
  73. my $moduleStat = $report->{"swi:module"}[$moduleId]->{"swi:statistic"};
  74. for (
  75. my $fileId = 0 ;
  76. $fileId <= $#{ $report->{"swi:module"}[$moduleId]->{"swi:file"} } ;
  77. $fileId++
  78. )
  79. {
  80. my $fileStat =
  81. $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId]
  82. ->{"swi:statistic"};
  83. for (
  84. my $functionId = 0 ;
  85. $functionId <= $#{
  86. $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId]
  87. ->{"swi:function"}
  88. } ;
  89. $functionId++
  90. )
  91. {
  92. my $functionStat =
  93. $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId]
  94. ->{"swi:function"}[$functionId]->{"swi:statistic"};
  95. foreach my $keyStat ( keys %$functionStat )
  96. {
  97. my $subStat = $functionStat->{$keyStat};
  98. foreach my $keySubStat ( keys %$subStat )
  99. {
  100. # add total per file
  101. $fileStat->{$keyStat}->{$keySubStat}->{"swi:total"} +=
  102. $subStat->{$keySubStat}->{'swi:exact'};
  103. $fileStat->{$keyStat}->{$keySubStat}->{"swi:average"} =
  104. $fileStat->{$keyStat}->{$keySubStat}->{"swi:total"} /
  105. $fileStat->{"swi:count"}->{"swi:functions"};
  106. # add total per module
  107. $moduleStat->{$keyStat}->{$keySubStat}->{"swi:total"} +=
  108. $subStat->{$keySubStat}->{'swi:exact'};
  109. $moduleStat->{$keyStat}->{$keySubStat}
  110. ->{"swi:average"} =
  111. $moduleStat->{$keyStat}->{$keySubStat}
  112. ->{"swi:total"} /
  113. $moduleStat->{"swi:count"}->{"swi:functions"};
  114. # add total per project
  115. $projectStat->{$keyStat}->{$keySubStat}
  116. ->{"swi:total"} +=
  117. $subStat->{$keySubStat}->{'swi:exact'};
  118. $projectStat->{$keyStat}->{$keySubStat}
  119. ->{"swi:average"} =
  120. $projectStat->{$keyStat}->{$keySubStat}
  121. ->{"swi:total"} /
  122. $projectStat->{"swi:count"}->{"swi:functions"};
  123. # add minimum per file
  124. if (
  125. !defined(
  126. $fileStat->{$keyStat}->{$keySubStat}
  127. ->{"swi:min"}
  128. )
  129. || $fileStat->{$keyStat}->{$keySubStat}
  130. ->{"swi:min"} >
  131. $subStat->{$keySubStat}->{'swi:exact'}
  132. )
  133. {
  134. $fileStat->{$keyStat}->{$keySubStat}->{"swi:min"} =
  135. $subStat->{$keySubStat}->{'swi:exact'};
  136. }
  137. # add minimum per module
  138. if (
  139. !defined(
  140. $moduleStat->{$keyStat}->{$keySubStat}
  141. ->{"swi:min"}
  142. )
  143. || $moduleStat->{$keyStat}->{$keySubStat}
  144. ->{"swi:min"} >
  145. $subStat->{$keySubStat}->{'swi:exact'}
  146. )
  147. {
  148. $moduleStat->{$keyStat}->{$keySubStat}
  149. ->{"swi:min"} =
  150. $subStat->{$keySubStat}->{'swi:exact'};
  151. }
  152. # add minimum per project
  153. if (
  154. !defined(
  155. $projectStat->{$keyStat}->{$keySubStat}
  156. ->{"swi:min"}
  157. )
  158. || $projectStat->{$keyStat}->{$keySubStat}
  159. ->{"swi:min"} >
  160. $subStat->{$keySubStat}->{'swi:exact'}
  161. )
  162. {
  163. $projectStat->{$keyStat}->{$keySubStat}
  164. ->{"swi:min"} =
  165. $subStat->{$keySubStat}->{'swi:exact'};
  166. }
  167. # add maximum per file
  168. if (
  169. !defined(
  170. $fileStat->{$keyStat}->{$keySubStat}
  171. ->{"swi:max"}
  172. )
  173. || $fileStat->{$keyStat}->{$keySubStat}
  174. ->{"swi:max"} <
  175. $subStat->{$keySubStat}->{'swi:exact'}
  176. )
  177. {
  178. $fileStat->{$keyStat}->{$keySubStat}->{"swi:max"} =
  179. $subStat->{$keySubStat}->{'swi:exact'};
  180. }
  181. # add maximum per module
  182. if (
  183. !defined(
  184. $moduleStat->{$keyStat}->{$keySubStat}
  185. ->{"swi:max"}
  186. )
  187. || $moduleStat->{$keyStat}->{$keySubStat}
  188. ->{"swi:max"} <
  189. $subStat->{$keySubStat}->{'swi:exact'}
  190. )
  191. {
  192. $moduleStat->{$keyStat}->{$keySubStat}
  193. ->{"swi:max"} =
  194. $subStat->{$keySubStat}->{'swi:exact'};
  195. }
  196. # add maximum per project
  197. if (
  198. !defined(
  199. $projectStat->{$keyStat}->{$keySubStat}
  200. ->{"swi:max"}
  201. )
  202. || $projectStat->{$keyStat}->{$keySubStat}
  203. ->{"swi:max"} <
  204. $subStat->{$keySubStat}->{'swi:exact'}
  205. )
  206. {
  207. $projectStat->{$keyStat}->{$keySubStat}
  208. ->{"swi:max"} =
  209. $subStat->{$keySubStat}->{'swi:exact'};
  210. }
  211. }
  212. }
  213. }
  214. }
  215. }
  216. # generate full XML report
  217. my $outputFile =
  218. $config->{"swi:report"}->{"swi:destination"} . "/"
  219. . $config->{"swi:report"}->{"swi:xml"}->{"swi:name"};
  220. my $fh = new FileHandle( $outputFile, "w" )
  221. or die("Can not open output file '$outputFile'!");
  222. print $fh "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";
  223. print $fh "<swi:report>\n";
  224. print $fh "\n";
  225. print $fh " <swi:info>\n";
  226. print $fh " <swi:version>1.0</swi:version>\n";
  227. if ( defined( $ENV{USER} ) )
  228. {
  229. print $fh " <swi:user>" . $ENV{USER} . "</swi:user>\n";
  230. }
  231. print $fh " <swi:generator>SWI/APPRAISER</swi:generator>\n";
  232. print $fh " </swi:info>\n";
  233. print $fh "\n";
  234. $projectStat = $report->{"swi:statistic"};
  235. my $projectName = $config->{"swi:info"}->{"swi:project"}->{"swi:name"};
  236. my $projectDiff =
  237. swiReportModificationGet( $reportBase, $report, "swi:total" );
  238. for (
  239. my $moduleId = 0 ;
  240. $moduleId <= $#{ $report->{"swi:module"} } ;
  241. $moduleId++
  242. )
  243. {
  244. my $moduleStat = $report->{"swi:module"}[$moduleId]->{"swi:statistic"};
  245. my $moduleName = $report->{"swi:module"}[$moduleId]->{"swi:name"};
  246. my $moduleBase =
  247. swiReportObjectFind( $reportBase->{"swi:module"}, $moduleName );
  248. my $moduleDiff =
  249. swiReportModificationGet( $moduleBase,
  250. $report->{"swi:module"}[$moduleId], "swi:total" );
  251. print $fh " <swi:module>\n";
  252. print $fh " <swi:name>" . $moduleName . "</swi:name>\n";
  253. print $fh " <swi:location>"
  254. . $report->{"swi:module"}[$moduleId]->{"swi:location"}
  255. . "</swi:location>\n";
  256. print $fh " <swi:modification>"
  257. . $moduleDiff
  258. . "</swi:modification>\n";
  259. print $fh "\n";
  260. for (
  261. my $fileId = 0 ;
  262. $fileId <= $#{ $report->{"swi:module"}[$moduleId]->{"swi:file"} } ;
  263. $fileId++
  264. )
  265. {
  266. my $fileStat =
  267. $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId]
  268. ->{"swi:statistic"};
  269. my $fileName =
  270. $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId]
  271. ->{"swi:name"};
  272. my $fileBase =
  273. ( $moduleDiff eq "added" )
  274. ? undef
  275. : swiReportObjectFind( $moduleBase->{"swi:file"}, $fileName );
  276. my $fileDiff =
  277. swiReportModificationGet( $fileBase,
  278. $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId],
  279. "swi:total" );
  280. print $fh " <swi:file>\n";
  281. print $fh " <swi:name>" . $fileName . "</swi:name>\n";
  282. print $fh " <swi:location>"
  283. . $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId]
  284. ->{"swi:location"} . "</swi:location>\n";
  285. print $fh " <swi:modification>"
  286. . $fileDiff
  287. . "</swi:modification>\n";
  288. print $fh "\n";
  289. for (
  290. my $functionId = 0 ;
  291. $functionId <= $#{
  292. $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId]
  293. ->{"swi:function"}
  294. } ;
  295. $functionId++
  296. )
  297. {
  298. my $functionStat =
  299. $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId]
  300. ->{"swi:function"}[$functionId]->{"swi:statistic"};
  301. my $functionName =
  302. $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId]
  303. ->{"swi:function"}[$functionId]->{"swi:name"};
  304. my $functionBase =
  305. ( $fileDiff eq "added" )
  306. ? undef
  307. : swiReportObjectFind( $fileBase->{"swi:function"},
  308. $functionName );
  309. my $functionDiff = swiReportModificationGet(
  310. $functionBase,
  311. $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId]
  312. ->{"swi:function"}[$functionId],
  313. "swi:exact"
  314. );
  315. print $fh " <swi:function>\n";
  316. print $fh " "
  317. . XMLout( $functionName, RootName => 'swi:name' );
  318. print $fh " "
  319. . XMLout(
  320. $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId]
  321. ->{"swi:function"}[$functionId]->{"swi:location"},
  322. RootName => 'swi:location'
  323. );
  324. print $fh " "
  325. . XMLout(
  326. $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId]
  327. ->{"swi:function"}[$functionId]->{"swi:modifier"},
  328. RootName => 'swi:modifier'
  329. );
  330. print $fh " "
  331. . XMLout(
  332. $report->{"swi:module"}[$moduleId]->{"swi:file"}[$fileId]
  333. ->{"swi:function"}[$functionId]->{"swi:pointer"},
  334. RootName => 'swi:pointer'
  335. );
  336. print $fh " <swi:modification>"
  337. . $functionDiff
  338. . "</swi:modification>\n";
  339. print $fh " <swi:statistic>\n";
  340. foreach my $keyStat ( keys %$functionStat )
  341. {
  342. print $fh " <" . $keyStat . ">\n";
  343. my $subStat = $functionStat->{$keyStat};
  344. foreach my $keySubStat ( keys %$subStat )
  345. {
  346. my ( $level, $suppress, $criteria ) =
  347. swiStatisticLevelGet(
  348. $keyStat,
  349. $keySubStat,
  350. "swi:exact",
  351. $projectName . "/"
  352. . $moduleName . "/"
  353. . $fileName . "/"
  354. . $functionName,
  355. $functionStat,
  356. "swi:function"
  357. );
  358. my $statDiff = swiStatisticDiffGet(
  359. $functionDiff,
  360. $functionStat->{$keyStat}->{$keySubStat}
  361. ->{'swi:exact'},
  362. $functionBase->{"swi:statistic"}->{$keyStat}
  363. ->{$keySubStat}->{"swi:exact"}
  364. );
  365. print $fh " <"
  366. . $keySubStat
  367. . "><swi:exact swi:change=\""
  368. . $statDiff
  369. . "\" swi:level=\""
  370. . $level
  371. . "\" swi:suppress=\""
  372. . $suppress
  373. . "\" swi:criteria=\""
  374. . $criteria . "\">"
  375. . $functionStat->{$keyStat}->{$keySubStat}
  376. ->{'swi:exact'}
  377. . "</swi:exact></"
  378. . $keySubStat . ">\n";
  379. }
  380. print $fh " </" . $keyStat . ">\n";
  381. }
  382. print $fh " </swi:statistic>\n";
  383. if (
  384. defined(
  385. $report->{"swi:module"}[$moduleId]
  386. ->{"swi:file"}[$fileId]->{"swi:function"}[$functionId]
  387. ->{'swi:reference'}
  388. )
  389. )
  390. {
  391. my $refStr = XMLout(
  392. $report->{"swi:module"}[$moduleId]
  393. ->{"swi:file"}[$fileId]->{"swi:function"}[$functionId]
  394. ->{'swi:reference'},
  395. RootName => ''
  396. );
  397. $refStr =~ s/\n/\n /g;
  398. $refStr =~ s/<anon /<swi:reference /g;
  399. print $fh " ";
  400. print $fh $refStr;
  401. print $fh "\n";
  402. }
  403. print $fh " </swi:function>\n";
  404. print $fh "\n";
  405. }
  406. for (
  407. my $functionId = 0 ;
  408. $functionId <= $#{ $fileBase->{"swi:function"} } ;
  409. $functionId++
  410. )
  411. {
  412. my $functionOld = $fileBase->{"swi:function"}[$functionId];
  413. if (
  414. swiReportObjectFind(
  415. $report->{"swi:module"}[$moduleId]
  416. ->{"swi:file"}[$fileId]->{"swi:function"},
  417. $functionOld->{"swi:name"}
  418. ) == undef
  419. )
  420. {
  421. print $fh " <swi:function>\n";
  422. print $fh " <swi:name>"
  423. . $functionOld->{"swi:name"}
  424. . "</swi:name>\n";
  425. print $fh " <swi:location>"
  426. . $functionOld->{"swi:location"}
  427. . "</swi:location>\n";
  428. print $fh
  429. " <swi:modification>removed</swi:modification>\n";
  430. print $fh " </swi:function>\n";
  431. print $fh "\n";
  432. }
  433. }
  434. print $fh " <swi:statistic>\n";
  435. foreach my $keyStat ( keys %$fileStat )
  436. {
  437. print $fh " <" . $keyStat . ">\n";
  438. my $subStat = $fileStat->{$keyStat};
  439. foreach my $keySubStat ( keys %$subStat )
  440. {
  441. my @types = (
  442. "swi:exact", "swi:average",
  443. "swi:min", "swi:max",
  444. "swi:total"
  445. );
  446. print $fh " <" . $keySubStat . ">\n";
  447. foreach my $type (@types)
  448. {
  449. if (
  450. defined(
  451. $fileStat->{$keyStat}->{$keySubStat}->{$type}
  452. )
  453. )
  454. {
  455. my ( $level, $suppress, $criteria ) =
  456. swiStatisticLevelGet(
  457. $keyStat,
  458. $keySubStat,
  459. $type,
  460. $projectName . "/"
  461. . $moduleName . "/"
  462. . $fileName,
  463. $fileStat,
  464. "swi:file"
  465. );
  466. my $statDiff = swiStatisticDiffGet(
  467. $fileDiff,
  468. $fileStat->{$keyStat}->{$keySubStat}->{$type},
  469. $fileBase->{"swi:statistic"}->{$keyStat}
  470. ->{$keySubStat}->{$type}
  471. );
  472. print $fh " <" . $type
  473. . " swi:change=\""
  474. . $statDiff
  475. . "\" swi:level=\""
  476. . $level
  477. . "\" swi:suppress=\""
  478. . $suppress
  479. . "\" swi:criteria=\""
  480. . $criteria . "\">"
  481. . sprintf( "%.2f",
  482. $fileStat->{$keyStat}->{$keySubStat}->{$type} )
  483. . "</"
  484. . $type . ">\n";
  485. }
  486. }
  487. print $fh " </" . $keySubStat . ">\n";
  488. }
  489. print $fh " </" . $keyStat . ">\n";
  490. }
  491. print $fh " </swi:statistic>\n";
  492. print $fh " </swi:file>\n";
  493. print $fh "\n";
  494. }
  495. for (
  496. my $fileId = 0 ;
  497. $fileId <= $#{ $moduleBase->{"swi:file"} } ;
  498. $fileId++
  499. )
  500. {
  501. my $fileOld = $moduleBase->{"swi:file"}[$fileId];
  502. if (
  503. swiReportObjectFind(
  504. $report->{"swi:module"}[$moduleId]->{"swi:file"},
  505. $fileOld->{"swi:name"} ) == undef
  506. )
  507. {
  508. print $fh " <swi:file>\n";
  509. print $fh " <swi:name>"
  510. . $fileOld->{"swi:name"}
  511. . "</swi:name>\n";
  512. print $fh " <swi:location>"
  513. . $fileOld->{"swi:location"}
  514. . "</swi:location>\n";
  515. print $fh
  516. " <swi:modification>removed</swi:modification>\n";
  517. print $fh " </swi:file>\n";
  518. print $fh "\n";
  519. }
  520. }
  521. print $fh " <swi:statistic>\n";
  522. foreach my $keyStat ( keys %$moduleStat )
  523. {
  524. print $fh " <" . $keyStat . ">\n";
  525. my $subStat = $moduleStat->{$keyStat};
  526. foreach my $keySubStat ( keys %$subStat )
  527. {
  528. my @types = (
  529. "swi:exact", "swi:average", "swi:min", "swi:max",
  530. "swi:total"
  531. );
  532. print $fh " <" . $keySubStat . ">\n";
  533. foreach my $type (@types)
  534. {
  535. if (
  536. defined(
  537. $moduleStat->{$keyStat}->{$keySubStat}->{$type}
  538. )
  539. )
  540. {
  541. my ( $level, $suppress, $criteria ) =
  542. swiStatisticLevelGet( $keyStat, $keySubStat, $type,
  543. $projectName . "/" . $moduleName,
  544. $moduleStat, "swi:module" );
  545. my $statDiff = swiStatisticDiffGet(
  546. $moduleDiff,
  547. $moduleStat->{$keyStat}->{$keySubStat}->{$type},
  548. $moduleBase->{"swi:statistic"}->{$keyStat}
  549. ->{$keySubStat}->{$type}
  550. );
  551. print $fh " <" . $type
  552. . " swi:change=\""
  553. . $statDiff
  554. . "\" swi:level=\""
  555. . $level
  556. . "\" swi:suppress=\""
  557. . $suppress
  558. . "\" swi:criteria=\""
  559. . $criteria . "\">"
  560. . sprintf( "%.2f",
  561. $moduleStat->{$keyStat}->{$keySubStat}->{$type} )
  562. . "</"
  563. . $type . ">\n";
  564. }
  565. }
  566. print $fh " </" . $keySubStat . ">\n";
  567. }
  568. print $fh " </" . $keyStat . ">\n";
  569. }
  570. print $fh " </swi:statistic>\n";
  571. print $fh " </swi:module>\n";
  572. print $fh "\n";
  573. }
  574. for (
  575. my $moduleId = 0 ;
  576. $moduleId <= $#{ $reportBase->{"swi:module"} } ;
  577. $moduleId++
  578. )
  579. {
  580. my $moduleOld = $reportBase->{"swi:module"}[$moduleId];
  581. if (
  582. swiReportObjectFind( $report->{"swi:module"},
  583. $moduleOld->{"swi:name"} ) == undef
  584. )
  585. {
  586. print $fh " <swi:module>\n";
  587. print $fh " <swi:name>"
  588. . $moduleOld->{"swi:name"}
  589. . "</swi:name>\n";
  590. print $fh " <swi:location>"
  591. . $moduleOld->{"swi:location"}
  592. . "</swi:location>\n";
  593. print $fh " <swi:modification>removed</swi:modification>\n";
  594. print $fh " </swi:module>\n";
  595. print $fh "\n";
  596. }
  597. }
  598. print $fh " <swi:statistic>\n";
  599. foreach my $keyStat ( keys %$projectStat )
  600. {
  601. print $fh " <" . $keyStat . ">\n";
  602. my $subStat = $projectStat->{$keyStat};
  603. foreach my $keySubStat ( keys %$subStat )
  604. {
  605. my @types =
  606. ( "swi:exact", "swi:average", "swi:min", "swi:max", "swi:total" );
  607. print $fh " <" . $keySubStat . ">\n";
  608. foreach my $type (@types)
  609. {
  610. if (
  611. defined( $projectStat->{$keyStat}->{$keySubStat}->{$type} )
  612. )
  613. {
  614. my ( $level, $suppress, $criteria ) = swiStatisticLevelGet(
  615. $keyStat, $keySubStat, $type,
  616. $projectName, $projectStat, "swi:project"
  617. );
  618. my $statDiff = swiStatisticDiffGet(
  619. $projectDiff,
  620. $projectStat->{$keyStat}->{$keySubStat}->{$type},
  621. $reportBase->{"swi:statistic"}->{$keyStat}
  622. ->{$keySubStat}->{$type}
  623. );
  624. print $fh " <" . $type
  625. . " swi:change=\""
  626. . $statDiff
  627. . "\" swi:level=\""
  628. . $level
  629. . "\" swi:suppress=\""
  630. . $suppress
  631. . "\" swi:criteria=\""
  632. . $criteria . "\">"
  633. . sprintf( "%.2f",
  634. $projectStat->{$keyStat}->{$keySubStat}->{$type} )
  635. . "</"
  636. . $type . ">\n";
  637. }
  638. }
  639. print $fh " </" . $keySubStat . ">\n";
  640. }
  641. print $fh " </" . $keyStat . ">\n";
  642. }
  643. print $fh " </swi:statistic>\n";
  644. print $fh "</swi:report>\n";
  645. return 0;
  646. }
  647. sub swiStatisticLevelGet
  648. {
  649. my $keyStat = shift();
  650. my $keySubStat = shift();
  651. my $type = shift();
  652. my $objName = shift();
  653. my $objStat = shift();
  654. my $objType = shift();
  655. my $statValue = undef;
  656. # Array of results: level, suppress level, criteria
  657. my @returnResult = ( "undefined", "undefined", "" );
  658. if (
  659. defined( $config->{"swi:limits"}->{$keyStat}->{$keySubStat}->{$type} ) )
  660. {
  661. my $limit = $config->{"swi:limits"}->{$keyStat}->{$keySubStat}->{$type};
  662. my $factor = 1;
  663. if ( defined( $limit->{"swi:relation"} ) )
  664. {
  665. my @relation = undef;
  666. @relation = split( /\//, $limit->{"swi:relation"} );
  667. $factor =
  668. $objStat->{ $relation[0] }->{ $relation[1] }->{ $relation[2] };
  669. if ( !defined($factor) || $factor == 0 )
  670. {
  671. STATUS(
  672. "Wrong configuration for the limit '$keyStat/$keySubStat/$type'. Relation "
  673. . $limit->{"swi:relation"}
  674. . " is not found or points to zero value for object '$objName'"
  675. );
  676. $factor = 1;
  677. }
  678. }
  679. $statValue = $objStat->{$keyStat}->{$keySubStat}->{$type} / $factor;
  680. $statValue = sprintf( "%.2f", $statValue );
  681. if ( $limit->{"swi:warning"} > $limit->{"swi:notice"}
  682. && $limit->{"swi:notice"} > $limit->{"swi:info"} )
  683. {
  684. if ( $statValue > $limit->{"swi:warning"} )
  685. {
  686. $returnResult[0] = "warning";
  687. $returnResult[2] = "["
  688. . $statValue
  689. . " greater than "
  690. . $limit->{"swi:warning"} . "]";
  691. }
  692. elsif ( $statValue > $limit->{"swi:notice"} )
  693. {
  694. $returnResult[0] = "notice";
  695. $returnResult[2] = "["
  696. . $statValue
  697. . " greater than "
  698. . $limit->{"swi:notice"} . "]";
  699. }
  700. elsif ( $statValue > $limit->{"swi:info"} )
  701. {
  702. $returnResult[0] = "info";
  703. $returnResult[2] = "["
  704. . $statValue
  705. . " greater than "
  706. . $limit->{"swi:info"} . "]";
  707. }
  708. else
  709. {
  710. $returnResult[0] = "regular";
  711. }
  712. }
  713. elsif ($limit->{"swi:warning"} < $limit->{"swi:notice"}
  714. && $limit->{"swi:notice"} < $limit->{"swi:info"} )
  715. {
  716. if ( $statValue < $limit->{"swi:warning"} )
  717. {
  718. $returnResult[0] = "warning";
  719. $returnResult[2] = "["
  720. . $statValue
  721. . " less than "
  722. . $limit->{"swi:warning"} . "]";
  723. }
  724. elsif ( $statValue < $limit->{"swi:notice"} )
  725. {
  726. $returnResult[0] = "notice";
  727. $returnResult[2] = "["
  728. . $statValue
  729. . " less than "
  730. . $limit->{"swi:notice"} . "]";
  731. }
  732. elsif ( $statValue < $limit->{"swi:info"} )
  733. {
  734. $returnResult[0] = "info";
  735. $returnResult[2] =
  736. "[" . $statValue . " less than " . $limit->{"swi:info"} . "]";
  737. }
  738. else
  739. {
  740. $returnResult[0] = "regular";
  741. }
  742. }
  743. else
  744. {
  745. STATUS(
  746. "Wrong settings in configuration file (<limits> section): swi:limit/$keyStat/$keySubStat/$type"
  747. );
  748. $returnResult[0] = "unresolved";
  749. }
  750. # check if suppressed
  751. my $isFound = 0;
  752. LOOPPATTERNS:
  753. foreach ( @{ $limit->{"swi:suppress"}->{"swi:pattern"} } )
  754. {
  755. my $pattern = $_;
  756. if ( ref($pattern) eq "HASH" && defined( $pattern->{"swi:level"} ) )
  757. {
  758. my $content = $pattern->{"content"};
  759. if ( $objName =~ m/$content/ )
  760. {
  761. if ( $isFound == 0 )
  762. {
  763. $returnResult[1] = $pattern->{"swi:level"};
  764. $isFound = 1;
  765. }
  766. else
  767. {
  768. # This object is matched by several patterns
  769. if ( $returnResult[1] ne $pattern->{"swi:level"} )
  770. {
  771. # and levels are not equal in different patterns
  772. STATUS(
  773. "Configuration is wrong: $objName is matched by several patterns"
  774. );
  775. $returnResult[1] = "unresolved";
  776. }
  777. }
  778. }
  779. }
  780. else
  781. {
  782. STATUS(
  783. "Wrong settings in configuration file (<limits/suppress> section): swi:limit/$keyStat/$keySubStat/$type: "
  784. . "Level is missed in pattern for the object '$objType'"
  785. );
  786. $returnResult[1] = "unresolved";
  787. $returnResult[2] = "[]";
  788. }
  789. }
  790. }
  791. return @returnResult;
  792. }
  793. sub swiStatisticDiffGet
  794. {
  795. my $objDiff = shift();
  796. my $newStat = shift();
  797. my $oldStat = shift();
  798. if ( $objDiff ne "added" )
  799. {
  800. return sprintf( "%.2f", $newStat - $oldStat );
  801. }
  802. return "";
  803. }
  804. sub swiReportObjectFind
  805. {
  806. my $objects = shift();
  807. my $objName = shift();
  808. foreach (@$objects)
  809. {
  810. if ( $_->{"swi:name"} eq $objName
  811. && $_->{"swi:modification"} ne "removed" )
  812. {
  813. return $_;
  814. }
  815. }
  816. return undef;
  817. }
  818. sub swiReportModificationGet
  819. {
  820. my $objBase = shift();
  821. my $objNew = shift();
  822. my $statType = shift();
  823. if ( !defined($objBase) )
  824. {
  825. return "added";
  826. }
  827. my $newCrc =
  828. $objNew->{"swi:statistic"}->{"swi:checksum"}->{"swi:source"}->{$statType};
  829. my $newLength =
  830. $objNew->{"swi:statistic"}->{"swi:length"}->{"swi:source"}->{$statType};
  831. my $newDup =
  832. $objNew->{"swi:statistic"}->{"swi:duplication"}->{"swi:executable"}
  833. ->{$statType};
  834. if ( $objBase->{"swi:statistic"}->{"swi:checksum"}->{"swi:source"}
  835. ->{$statType} != $newCrc ||
  836. $objBase->{"swi:statistic"}->{"swi:length"}->{"swi:source"}
  837. ->{$statType} != $newLength )
  838. {
  839. return "modified";
  840. }
  841. if ( $objBase->{"swi:statistic"}->{"swi:duplication"}->{"swi:executable"}
  842. ->{$statType} != $newDup )
  843. {
  844. return "cloned";
  845. }
  846. return "unmodified";
  847. }
  848. return 1;