Appraiser.pm 34 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908
  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. # TODO: apply suppress patterns here
  392. my $refStr = XMLout(
  393. $report->{"swi:module"}[$moduleId]
  394. ->{"swi:file"}[$fileId]->{"swi:function"}[$functionId]
  395. ->{'swi:reference'},
  396. RootName => ''
  397. );
  398. $refStr =~ s/\n/\n /g;
  399. $refStr =~ s/<anon /<swi:reference /g;
  400. print $fh " ";
  401. print $fh $refStr;
  402. print $fh "\n";
  403. }
  404. print $fh " </swi:function>\n";
  405. print $fh "\n";
  406. }
  407. for (
  408. my $functionId = 0 ;
  409. $functionId <= $#{ $fileBase->{"swi:function"} } ;
  410. $functionId++
  411. )
  412. {
  413. my $functionOld = $fileBase->{"swi:function"}[$functionId];
  414. if (
  415. swiReportObjectFind(
  416. $report->{"swi:module"}[$moduleId]
  417. ->{"swi:file"}[$fileId]->{"swi:function"},
  418. $functionOld->{"swi:name"}
  419. ) == undef
  420. )
  421. {
  422. print $fh " <swi:function>\n";
  423. print $fh " <swi:name>"
  424. . $functionOld->{"swi:name"}
  425. . "</swi:name>\n";
  426. print $fh " <swi:location>"
  427. . $functionOld->{"swi:location"}
  428. . "</swi:location>\n";
  429. print $fh
  430. " <swi:modification>removed</swi:modification>\n";
  431. print $fh " </swi:function>\n";
  432. print $fh "\n";
  433. }
  434. }
  435. print $fh " <swi:statistic>\n";
  436. foreach my $keyStat ( keys %$fileStat )
  437. {
  438. print $fh " <" . $keyStat . ">\n";
  439. my $subStat = $fileStat->{$keyStat};
  440. foreach my $keySubStat ( keys %$subStat )
  441. {
  442. my @types = (
  443. "swi:exact", "swi:average",
  444. "swi:min", "swi:max",
  445. "swi:total"
  446. );
  447. print $fh " <" . $keySubStat . ">\n";
  448. foreach my $type (@types)
  449. {
  450. if (
  451. defined(
  452. $fileStat->{$keyStat}->{$keySubStat}->{$type}
  453. )
  454. )
  455. {
  456. my ( $level, $suppress, $criteria ) =
  457. swiStatisticLevelGet(
  458. $keyStat,
  459. $keySubStat,
  460. $type,
  461. $projectName . "/"
  462. . $moduleName . "/"
  463. . $fileName,
  464. $fileStat,
  465. "swi:file"
  466. );
  467. my $statDiff = swiStatisticDiffGet(
  468. $fileDiff,
  469. $fileStat->{$keyStat}->{$keySubStat}->{$type},
  470. $fileBase->{"swi:statistic"}->{$keyStat}
  471. ->{$keySubStat}->{$type}
  472. );
  473. print $fh " <" . $type
  474. . " swi:change=\""
  475. . $statDiff
  476. . "\" swi:level=\""
  477. . $level
  478. . "\" swi:suppress=\""
  479. . $suppress
  480. . "\" swi:criteria=\""
  481. . $criteria . "\">"
  482. . sprintf( "%.2f",
  483. $fileStat->{$keyStat}->{$keySubStat}->{$type} )
  484. . "</"
  485. . $type . ">\n";
  486. }
  487. }
  488. print $fh " </" . $keySubStat . ">\n";
  489. }
  490. print $fh " </" . $keyStat . ">\n";
  491. }
  492. print $fh " </swi:statistic>\n";
  493. print $fh " </swi:file>\n";
  494. print $fh "\n";
  495. }
  496. for (
  497. my $fileId = 0 ;
  498. $fileId <= $#{ $moduleBase->{"swi:file"} } ;
  499. $fileId++
  500. )
  501. {
  502. my $fileOld = $moduleBase->{"swi:file"}[$fileId];
  503. if (
  504. swiReportObjectFind(
  505. $report->{"swi:module"}[$moduleId]->{"swi:file"},
  506. $fileOld->{"swi:name"} ) == undef
  507. )
  508. {
  509. print $fh " <swi:file>\n";
  510. print $fh " <swi:name>"
  511. . $fileOld->{"swi:name"}
  512. . "</swi:name>\n";
  513. print $fh " <swi:location>"
  514. . $fileOld->{"swi:location"}
  515. . "</swi:location>\n";
  516. print $fh
  517. " <swi:modification>removed</swi:modification>\n";
  518. print $fh " </swi:file>\n";
  519. print $fh "\n";
  520. }
  521. }
  522. print $fh " <swi:statistic>\n";
  523. foreach my $keyStat ( keys %$moduleStat )
  524. {
  525. print $fh " <" . $keyStat . ">\n";
  526. my $subStat = $moduleStat->{$keyStat};
  527. foreach my $keySubStat ( keys %$subStat )
  528. {
  529. my @types = (
  530. "swi:exact", "swi:average", "swi:min", "swi:max",
  531. "swi:total"
  532. );
  533. print $fh " <" . $keySubStat . ">\n";
  534. foreach my $type (@types)
  535. {
  536. if (
  537. defined(
  538. $moduleStat->{$keyStat}->{$keySubStat}->{$type}
  539. )
  540. )
  541. {
  542. my ( $level, $suppress, $criteria ) =
  543. swiStatisticLevelGet( $keyStat, $keySubStat, $type,
  544. $projectName . "/" . $moduleName,
  545. $moduleStat, "swi:module" );
  546. my $statDiff = swiStatisticDiffGet(
  547. $moduleDiff,
  548. $moduleStat->{$keyStat}->{$keySubStat}->{$type},
  549. $moduleBase->{"swi:statistic"}->{$keyStat}
  550. ->{$keySubStat}->{$type}
  551. );
  552. print $fh " <" . $type
  553. . " swi:change=\""
  554. . $statDiff
  555. . "\" swi:level=\""
  556. . $level
  557. . "\" swi:suppress=\""
  558. . $suppress
  559. . "\" swi:criteria=\""
  560. . $criteria . "\">"
  561. . sprintf( "%.2f",
  562. $moduleStat->{$keyStat}->{$keySubStat}->{$type} )
  563. . "</"
  564. . $type . ">\n";
  565. }
  566. }
  567. print $fh " </" . $keySubStat . ">\n";
  568. }
  569. print $fh " </" . $keyStat . ">\n";
  570. }
  571. print $fh " </swi:statistic>\n";
  572. print $fh " </swi:module>\n";
  573. print $fh "\n";
  574. }
  575. for (
  576. my $moduleId = 0 ;
  577. $moduleId <= $#{ $reportBase->{"swi:module"} } ;
  578. $moduleId++
  579. )
  580. {
  581. my $moduleOld = $reportBase->{"swi:module"}[$moduleId];
  582. if (
  583. swiReportObjectFind( $report->{"swi:module"},
  584. $moduleOld->{"swi:name"} ) == undef
  585. )
  586. {
  587. print $fh " <swi:module>\n";
  588. print $fh " <swi:name>"
  589. . $moduleOld->{"swi:name"}
  590. . "</swi:name>\n";
  591. print $fh " <swi:location>"
  592. . $moduleOld->{"swi:location"}
  593. . "</swi:location>\n";
  594. print $fh " <swi:modification>removed</swi:modification>\n";
  595. print $fh " </swi:module>\n";
  596. print $fh "\n";
  597. }
  598. }
  599. print $fh " <swi:statistic>\n";
  600. foreach my $keyStat ( keys %$projectStat )
  601. {
  602. print $fh " <" . $keyStat . ">\n";
  603. my $subStat = $projectStat->{$keyStat};
  604. foreach my $keySubStat ( keys %$subStat )
  605. {
  606. my @types =
  607. ( "swi:exact", "swi:average", "swi:min", "swi:max", "swi:total" );
  608. print $fh " <" . $keySubStat . ">\n";
  609. foreach my $type (@types)
  610. {
  611. if (
  612. defined( $projectStat->{$keyStat}->{$keySubStat}->{$type} )
  613. )
  614. {
  615. my ( $level, $suppress, $criteria ) = swiStatisticLevelGet(
  616. $keyStat, $keySubStat, $type,
  617. $projectName, $projectStat, "swi:project"
  618. );
  619. my $statDiff = swiStatisticDiffGet(
  620. $projectDiff,
  621. $projectStat->{$keyStat}->{$keySubStat}->{$type},
  622. $reportBase->{"swi:statistic"}->{$keyStat}
  623. ->{$keySubStat}->{$type}
  624. );
  625. print $fh " <" . $type
  626. . " swi:change=\""
  627. . $statDiff
  628. . "\" swi:level=\""
  629. . $level
  630. . "\" swi:suppress=\""
  631. . $suppress
  632. . "\" swi:criteria=\""
  633. . $criteria . "\">"
  634. . sprintf( "%.2f",
  635. $projectStat->{$keyStat}->{$keySubStat}->{$type} )
  636. . "</"
  637. . $type . ">\n";
  638. }
  639. }
  640. print $fh " </" . $keySubStat . ">\n";
  641. }
  642. print $fh " </" . $keyStat . ">\n";
  643. }
  644. print $fh " </swi:statistic>\n";
  645. print $fh "</swi:report>\n";
  646. return 0;
  647. }
  648. sub swiStatisticLevelGet
  649. {
  650. my $keyStat = shift();
  651. my $keySubStat = shift();
  652. my $type = shift();
  653. my $objName = shift();
  654. my $objStat = shift();
  655. my $objType = shift();
  656. my $statValue = undef;
  657. # Array of results: level, suppress level, criteria
  658. my @returnResult = ( "undefined", "undefined", "" );
  659. if (
  660. defined( $config->{"swi:limits"}->{$keyStat}->{$keySubStat}->{$type} ) )
  661. {
  662. my $limit = $config->{"swi:limits"}->{$keyStat}->{$keySubStat}->{$type};
  663. my $factor = 1;
  664. if ( defined( $limit->{"swi:relation"} ) )
  665. {
  666. my @relation = undef;
  667. @relation = split( /\//, $limit->{"swi:relation"} );
  668. $factor =
  669. $objStat->{ $relation[0] }->{ $relation[1] }->{ $relation[2] };
  670. if ( !defined($factor) || $factor == 0 )
  671. {
  672. STATUS(
  673. "Wrong configuration for the limit '$keyStat/$keySubStat/$type'. Relation "
  674. . $limit->{"swi:relation"}
  675. . " is not found or points to zero value for object '$objName'"
  676. );
  677. $factor = 1;
  678. }
  679. }
  680. $statValue = $objStat->{$keyStat}->{$keySubStat}->{$type} / $factor;
  681. $statValue = sprintf( "%.2f", $statValue );
  682. if ( $limit->{"swi:warning"} > $limit->{"swi:notice"}
  683. && $limit->{"swi:notice"} > $limit->{"swi:info"} )
  684. {
  685. if ( $statValue > $limit->{"swi:warning"} )
  686. {
  687. $returnResult[0] = "warning";
  688. $returnResult[2] = "["
  689. . $statValue
  690. . " greater than "
  691. . $limit->{"swi:warning"} . "]";
  692. }
  693. elsif ( $statValue > $limit->{"swi:notice"} )
  694. {
  695. $returnResult[0] = "notice";
  696. $returnResult[2] = "["
  697. . $statValue
  698. . " greater than "
  699. . $limit->{"swi:notice"} . "]";
  700. }
  701. elsif ( $statValue > $limit->{"swi:info"} )
  702. {
  703. $returnResult[0] = "info";
  704. $returnResult[2] = "["
  705. . $statValue
  706. . " greater than "
  707. . $limit->{"swi:info"} . "]";
  708. }
  709. else
  710. {
  711. $returnResult[0] = "regular";
  712. }
  713. }
  714. elsif ($limit->{"swi:warning"} < $limit->{"swi:notice"}
  715. && $limit->{"swi:notice"} < $limit->{"swi:info"} )
  716. {
  717. if ( $statValue < $limit->{"swi:warning"} )
  718. {
  719. $returnResult[0] = "warning";
  720. $returnResult[2] = "["
  721. . $statValue
  722. . " less than "
  723. . $limit->{"swi:warning"} . "]";
  724. }
  725. elsif ( $statValue < $limit->{"swi:notice"} )
  726. {
  727. $returnResult[0] = "notice";
  728. $returnResult[2] = "["
  729. . $statValue
  730. . " less than "
  731. . $limit->{"swi:notice"} . "]";
  732. }
  733. elsif ( $statValue < $limit->{"swi:info"} )
  734. {
  735. $returnResult[0] = "info";
  736. $returnResult[2] =
  737. "[" . $statValue . " less than " . $limit->{"swi:info"} . "]";
  738. }
  739. else
  740. {
  741. $returnResult[0] = "regular";
  742. }
  743. }
  744. else
  745. {
  746. STATUS(
  747. "Wrong settings in configuration file (<limits> section): swi:limit/$keyStat/$keySubStat/$type"
  748. );
  749. $returnResult[0] = "unresolved";
  750. }
  751. # check if suppressed
  752. my $isFound = 0;
  753. LOOPPATTERNS:
  754. foreach ( @{ $limit->{"swi:suppress"}->{"swi:pattern"} } )
  755. {
  756. my $pattern = $_;
  757. if ( ref($pattern) eq "HASH" && defined( $pattern->{"swi:level"} ) )
  758. {
  759. my $content = $pattern->{"content"};
  760. if ( $objName =~ m/$content/ )
  761. {
  762. if ( $isFound == 0 )
  763. {
  764. $returnResult[1] = $pattern->{"swi:level"};
  765. $isFound = 1;
  766. }
  767. else
  768. {
  769. # This object is matched by several patterns
  770. if ( $returnResult[1] ne $pattern->{"swi:level"} )
  771. {
  772. # and levels are not equal in different patterns
  773. STATUS(
  774. "Configuration is wrong: $objName is matched by several patterns"
  775. );
  776. $returnResult[1] = "unresolved";
  777. }
  778. }
  779. }
  780. }
  781. else
  782. {
  783. STATUS(
  784. "Wrong settings in configuration file (<limits/suppress> section): swi:limit/$keyStat/$keySubStat/$type: "
  785. . "Level is missed in pattern for the object '$objType'"
  786. );
  787. $returnResult[1] = "unresolved";
  788. $returnResult[2] = "[]";
  789. }
  790. }
  791. }
  792. return @returnResult;
  793. }
  794. sub swiStatisticDiffGet
  795. {
  796. my $objDiff = shift();
  797. my $newStat = shift();
  798. my $oldStat = shift();
  799. if ( $objDiff ne "added" )
  800. {
  801. return sprintf( "%.2f", $newStat - $oldStat );
  802. }
  803. return "";
  804. }
  805. sub swiReportObjectFind
  806. {
  807. my $objects = shift();
  808. my $objName = shift();
  809. foreach (@$objects)
  810. {
  811. if ( $_->{"swi:name"} eq $objName
  812. && $_->{"swi:modification"} ne "removed" )
  813. {
  814. return $_;
  815. }
  816. }
  817. return undef;
  818. }
  819. sub swiReportModificationGet
  820. {
  821. my $objBase = shift();
  822. my $objNew = shift();
  823. my $statType = shift();
  824. if ( !defined($objBase) )
  825. {
  826. return "added";
  827. }
  828. my $newCrc =
  829. $objNew->{"swi:statistic"}->{"swi:checksum"}->{"swi:source"}->{$statType};
  830. my $newLength =
  831. $objNew->{"swi:statistic"}->{"swi:length"}->{"swi:source"}->{$statType};
  832. my $newDup =
  833. $objNew->{"swi:statistic"}->{"swi:duplication"}->{"swi:executable"}
  834. ->{$statType};
  835. if ( $objBase->{"swi:statistic"}->{"swi:checksum"}->{"swi:source"}
  836. ->{$statType} != $newCrc ||
  837. $objBase->{"swi:statistic"}->{"swi:length"}->{"swi:source"}
  838. ->{$statType} != $newLength )
  839. {
  840. return "modified";
  841. }
  842. if ( $objBase->{"swi:statistic"}->{"swi:duplication"}->{"swi:executable"}
  843. ->{$statType} != $newDup )
  844. {
  845. return "cloned";
  846. }
  847. return "unmodified";
  848. }
  849. return 1;