metrixpp/lib/SWI/Processor.pm

#
#    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 <http://www.gnu.org/licenses/>.
#

use strict;
use Data::Dumper;
use FileHandle;
use IPC::Open3;

use XML::Simple;
use String::CRC::Cksum;

#
# Export section
#
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $PREFERRED_PARSER);
@ISA              = qw(Exporter);
@EXPORT           = qw(swiProcess);
@EXPORT_OK        = qw();
$VERSION          = '1.0';
$PREFERRED_PARSER = undef;

#
# Subroutine for troubleshooting purposes
#
use Internal::Output;

#
# Global variables
#
my @crctab = (
    0x00000000, 0x04c11db7, 0x09823b6e, 0x0d4326d9, 0x130476dc, 0x17c56b6b,
    0x1a864db2, 0x1e475005, 0x2608edb8, 0x22c9f00f, 0x2f8ad6d6, 0x2b4bcb61,
    0x350c9b64, 0x31cd86d3, 0x3c8ea00a, 0x384fbdbd, 0x4c11db70, 0x48d0c6c7,
    0x4593e01e, 0x4152fda9, 0x5f15adac, 0x5bd4b01b, 0x569796c2, 0x52568b75,
    0x6a1936c8, 0x6ed82b7f, 0x639b0da6, 0x675a1011, 0x791d4014, 0x7ddc5da3,
    0x709f7b7a, 0x745e66cd, 0x9823b6e0, 0x9ce2ab57, 0x91a18d8e, 0x95609039,
    0x8b27c03c, 0x8fe6dd8b, 0x82a5fb52, 0x8664e6e5, 0xbe2b5b58, 0xbaea46ef,
    0xb7a96036, 0xb3687d81, 0xad2f2d84, 0xa9ee3033, 0xa4ad16ea, 0xa06c0b5d,
    0xd4326d90, 0xd0f37027, 0xddb056fe, 0xd9714b49, 0xc7361b4c, 0xc3f706fb,
    0xceb42022, 0xca753d95, 0xf23a8028, 0xf6fb9d9f, 0xfbb8bb46, 0xff79a6f1,
    0xe13ef6f4, 0xe5ffeb43, 0xe8bccd9a, 0xec7dd02d, 0x34867077, 0x30476dc0,
    0x3d044b19, 0x39c556ae, 0x278206ab, 0x23431b1c, 0x2e003dc5, 0x2ac12072,
    0x128e9dcf, 0x164f8078, 0x1b0ca6a1, 0x1fcdbb16, 0x018aeb13, 0x054bf6a4,
    0x0808d07d, 0x0cc9cdca, 0x7897ab07, 0x7c56b6b0, 0x71159069, 0x75d48dde,
    0x6b93dddb, 0x6f52c06c, 0x6211e6b5, 0x66d0fb02, 0x5e9f46bf, 0x5a5e5b08,
    0x571d7dd1, 0x53dc6066, 0x4d9b3063, 0x495a2dd4, 0x44190b0d, 0x40d816ba,
    0xaca5c697, 0xa864db20, 0xa527fdf9, 0xa1e6e04e, 0xbfa1b04b, 0xbb60adfc,
    0xb6238b25, 0xb2e29692, 0x8aad2b2f, 0x8e6c3698, 0x832f1041, 0x87ee0df6,
    0x99a95df3, 0x9d684044, 0x902b669d, 0x94ea7b2a, 0xe0b41de7, 0xe4750050,
    0xe9362689, 0xedf73b3e, 0xf3b06b3b, 0xf771768c, 0xfa325055, 0xfef34de2,
    0xc6bcf05f, 0xc27dede8, 0xcf3ecb31, 0xcbffd686, 0xd5b88683, 0xd1799b34,
    0xdc3abded, 0xd8fba05a, 0x690ce0ee, 0x6dcdfd59, 0x608edb80, 0x644fc637,
    0x7a089632, 0x7ec98b85, 0x738aad5c, 0x774bb0eb, 0x4f040d56, 0x4bc510e1,
    0x46863638, 0x42472b8f, 0x5c007b8a, 0x58c1663d, 0x558240e4, 0x51435d53,
    0x251d3b9e, 0x21dc2629, 0x2c9f00f0, 0x285e1d47, 0x36194d42, 0x32d850f5,
    0x3f9b762c, 0x3b5a6b9b, 0x0315d626, 0x07d4cb91, 0x0a97ed48, 0x0e56f0ff,
    0x1011a0fa, 0x14d0bd4d, 0x19939b94, 0x1d528623, 0xf12f560e, 0xf5ee4bb9,
    0xf8ad6d60, 0xfc6c70d7, 0xe22b20d2, 0xe6ea3d65, 0xeba91bbc, 0xef68060b,
    0xd727bbb6, 0xd3e6a601, 0xdea580d8, 0xda649d6f, 0xc423cd6a, 0xc0e2d0dd,
    0xcda1f604, 0xc960ebb3, 0xbd3e8d7e, 0xb9ff90c9, 0xb4bcb610, 0xb07daba7,
    0xae3afba2, 0xaafbe615, 0xa7b8c0cc, 0xa379dd7b, 0x9b3660c6, 0x9ff77d71,
    0x92b45ba8, 0x9675461f, 0x8832161a, 0x8cf30bad, 0x81b02d74, 0x857130c3,
    0x5d8a9099, 0x594b8d2e, 0x5408abf7, 0x50c9b640, 0x4e8ee645, 0x4a4ffbf2,
    0x470cdd2b, 0x43cdc09c, 0x7b827d21, 0x7f436096, 0x7200464f, 0x76c15bf8,
    0x68860bfd, 0x6c47164a, 0x61043093, 0x65c52d24, 0x119b4be9, 0x155a565e,
    0x18197087, 0x1cd86d30, 0x029f3d35, 0x065e2082, 0x0b1d065b, 0x0fdc1bec,
    0x3793a651, 0x3352bbe6, 0x3e119d3f, 0x3ad08088, 0x2497d08d, 0x2056cd3a,
    0x2d15ebe3, 0x29d4f654, 0xc5a92679, 0xc1683bce, 0xcc2b1d17, 0xc8ea00a0,
    0xd6ad50a5, 0xd26c4d12, 0xdf2f6bcb, 0xdbee767c, 0xe3a1cbc1, 0xe760d676,
    0xea23f0af, 0xeee2ed18, 0xf0a5bd1d, 0xf464a0aa, 0xf9278673, 0xfde69bc4,
    0x89b8fd09, 0x8d79e0be, 0x803ac667, 0x84fbdbd0, 0x9abc8bd5, 0x9e7d9662,
    0x933eb0bb, 0x97ffad0c, 0xafb010b1, 0xab710d06, 0xa6322bdf, 0xa2f33668,
    0xbcb4666d, 0xb8757bda, 0xb5365d03, 0xb1f740b4
);

#
# Brackets/hooks '()' in regexp are not acceptable in declarations below
# TODO: configure individually for every language
#
my $regexpCommentSingle     = '//';
my $regexpCommentMultiStart = '/\\*';
my $regexpCommentMultiEnd   = '\\*/';
my $regexpCodeBlockStart    = '{';
my $regexpCodeBlockEnd      = '}';
my $regexpCodeKeyword       = 'case|do|else|if|for|switch|while';
my $regexpCodeStatements    =
'\s*[^;]*[;]\s*|\s*extern\s+["]{2}\s*|\s*protected\s*[:]\s*|\s*private\s*[:]\s*|\s*public\s*[:]\s*';
my $regexpCodeFunctionIdentifier =
'(([_a-zA-Z:~][_a-zA-Z0-9:~]*[:][:])*operator[^a-zA-Z0-9_][^(]*)|([_a-zA-Z:~][_a-zA-Z0-9:~]*)';
my $regexpCodeFunctionModifier    = '[_a-zA-Z0-9:*&><, \t\n]*\s+[*&]?[*&]?\s*';
my $regexpCodeFunctionArguments   = '\s*\([^;]+\s*';
my $regexpCodeContainerIdentifier = '[_a-zA-Z][_a-zA-Z0-9]*';
my $regexpCodeContainerModifier   =
'\s*class|\s*template\s*<[^;]+>\s*class|\s*namespace|\s*template\s*<[^;]+>\s*struct|\s*struct|\s*static\s+struct|\s*static\s+union|\s*static\s+class|\s*enum|\s*typedef|\s*typedef\s+struct|\s*typedef\s+enum|\s*union|\s*typedef\s+union';
my $regexpCodeContainerArguments = '\s*[^;]*\s*';
my $regexpCodeContainerDelimeter = '::';
my $regexpCodeBlockStartIgnore   =
  '=\s*|,\s*|\s*enum\s*|\s*union\s*|\s*struct\s*';
my $regexpCodeStringBorder_Escape =
  '(([^\\\](\\\\\\\\)*\\\\)|^([\\\](\\\\\\\\)*))';
my $regexpCodeStringBorder_Text          = '["\']';
my $regexpCodePreprocessorStart          = '^[ \t]*#';
my $regexpCodePreprocessorEnd            = '[^\\\\]\s*$';
my $regexpCodeMatch_ComplexityCyclomatic =
  '([^0-9A-Za-z_]((if)|(case)|(for)|(while))[^0-9A-Za-z_])|[&][&]|[|][|]|[?]"';
my $regexpCodeGlobalFunctionName = '>>>GLOBAL<<<';

#
# Handler for dupindex tool
#
my $dupindexHandler = undef;
my $dupindexIn      = undef;
my $dupindexOut     = undef;
my $dupindexErr     = undef;

#
# Errors counter, this global variable incremented if some inconsistency detected
#
my $exitCode = 0;

#
# Enter point
#
sub swiProcess
{
    my $returnCode = 0;

    my $config       = shift();
    my $moduleId     = shift();
    my $rootLocation = shift();

    my $swiGlobalDirectory =
      $config->{"swi:modules"}->{"swi:module"}[$moduleId]->{"swi:location"};
    my $swiGlobalReportLocation =
        $config->{"swi:report"}->{"swi:destination"} . "/"
      . $config->{"swi:report"}->{"swi:xml"}->{"swi:name"}
      . ".$moduleId";
    my $swiGlobalModuleName =
      $config->{"swi:modules"}->{"swi:module"}[$moduleId]->{"swi:name"};
    my $swiGlobalInclude =
      $config->{"swi:modules"}->{"swi:module"}[$moduleId]->{"swi:files"}
      ->{"swi:include"};
    my $swiGlobalExclude =
      $config->{"swi:modules"}->{"swi:module"}[$moduleId]->{"swi:files"}
      ->{"swi:exclude"};
    my $swiGlobalReportName =
      $config->{"swi:info"}->{"swi:project"}->{"swi:name"};
    my $swiGlobalPreprocessorRules =
      $config->{"swi:modules"}->{"swi:module"}[$moduleId]->{"swi:preprocessor"}
      ->{"swi:rule"};
    my $swiGlobalScanerRules =
      $config->{"swi:modules"}->{"swi:module"}[$moduleId]->{"swi:scanner"}
      ->{"swi:rule"};
    my $swiGlobalDupfinderEnabled =
      $config->{"swi:modules"}->{"swi:module"}[$moduleId]->{"swi:indexer:dup"}
      ->{"swi:enabled"};

    if ( $returnCode == 0 )
    {
        if ( $swiGlobalDirectory eq "" )
        {
            STATUS(
                "Wrong configuration: source directory should be specified!");
            $returnCode = -1;
        }
    }

    if ( $returnCode == 0 )
    {
        if ( $swiGlobalReportLocation eq "" )
        {
            STATUS(
                "Wrong configuiration: report location should be specified!");
            $returnCode = -2;
        }
    }

    if ( not defined($swiGlobalInclude) )
    {
        $swiGlobalInclude = '.*';
    }

    if ( $returnCode == 0 )
    {
        my $filesData = {};

        $dupindexHandler =
          open3( $dupindexIn, $dupindexOut, $dupindexErr,
            "$rootLocation/dupindex/bin/dupindex.exe" );
        if (   !defined($dupindexHandler)
            || !defined($dupindexIn)
            || !defined($dupindexOut) )
        {
            die(
"Can not start the internal platform native tool '$rootLocation/dupindex/bin/dupindex.exe'"
            );
        }

        my $dupfinderSettings =
          $config->{"swi:modules"}->{"swi:module"}[$moduleId]
          ->{"swi:indexer:dup"};
        if ( defined( $dupfinderSettings->{"swi:minlength"} ) )
        {
            print $dupindexIn "init_length\n";
            print $dupindexIn $dupfinderSettings->{"swi:minlength"} . "\n";
        }
        if ( defined( $dupfinderSettings->{"swi:proximity"} ) )
        {
            print $dupindexIn "init_proximity\n";
            print $dupindexIn $dupfinderSettings->{"swi:proximity"} . "\n";
        }

        # TODO: configure individually for every language
        # see for todos in dupindex.cpp file
        #print $dupindexIn "init_ignorable\n";
        #print $dupindexIn "\n";
        #print $dupindexIn "init_nonregular\n";
        #print $dupindexIn "\n";

        opendir( DIR, $swiGlobalDirectory )
          or die("Can not open source directory '$swiGlobalDirectory'!");
        while ( my $file = readdir(DIR) )
        {
            if ( $file =~ m/$swiGlobalInclude/ )
            {
                if (   $swiGlobalExclude ne ""
                    && $file =~ m/$swiGlobalExclude/ )
                {
                    next;
                }

                $filesData->{$file} = swiParse(
                    $swiGlobalDirectory,
                    $file,
                    $swiGlobalPreprocessorRules,
                    $swiGlobalScanerRules,
                    $config->{"swi:modules"}->{"swi:module"}[$moduleId]
                      ->{"swi:indexer:dup"},
                    $config->{"swi:modules"}->{"swi:module"}[$moduleId]
                      ->{"swi:indexer:gcov"}
                );
            }
        }
        closedir(DIR);

        # Add duplication statistics
        if ( defined($swiGlobalDupfinderEnabled)
            && $swiGlobalDupfinderEnabled eq 'on' )
        {
            $filesData = swiSourceIndexDuplicationAdd($filesData);
        }
        else
        {
            print $dupindexIn "exit\n";
        }

        # Prepare XML report
        STATUS("Generating the report '$swiGlobalReportLocation'...");

        swiXmlReportPrint(
            $filesData,               $swiGlobalDirectory,
            $swiGlobalReportLocation, $swiGlobalModuleName
        );

        $returnCode = $exitCode;
    }

    return $returnCode;
}

sub swiXmlReportPrint()
{
    my $filesData      = shift();
    my $curDir         = shift();
    my $reportLocation = shift();
    my $moduleName     = shift();

    $curDir =~ s/\n$//;

    my $fh = new FileHandle( "$reportLocation", "w" )
      or die("Can not open output file: $reportLocation!");

    print $fh "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";
    print $fh "<swi:report>\n";
    print $fh "\n";

    print $fh "  <swi:module>\n";
    print $fh "    <swi:name>" . $moduleName . "</swi:name>\n";
    print $fh "    <swi:location>" . $curDir . "</swi:location>\n";
    print $fh "\n";

    print $fh "    <swi:info>\n";
    print $fh "      <swi:version>1</swi:version>\n";
    if ( defined( $ENV{USER} ) )
    {
        print $fh "      <swi:user>" . $ENV{USER} . "</swi:user>\n";
    }
    print $fh "      <swi:generator>SWI/PROCESSOR</swi:generator>\n";
    print $fh "    </swi:info>\n";
    print $fh "\n";

    my $filesCount     = 0;
    my $functionsCount = 0;
    foreach my $file ( keys %{$filesData} )
    {
        $filesCount++;

        print $fh "    <swi:file>\n";
        print $fh "      <swi:name>" . $file . "</swi:name>\n";
        print $fh "      <swi:location>" . $file . "</swi:location>\n";
        print $fh "\n";

        my $functions           = $filesData->{$file};
        my $localFunctionsCount = 0;
        foreach my $function ( keys %$functions )
        {
            $functionsCount++;
            $localFunctionsCount++;

            print $fh "      <swi:function>\n";
            print $fh "        " . XMLout( $function, RootName => 'swi:name' );
            print $fh "        "
              . XMLout(
                $file . ":"
                  . ( $functions->{$function}->{'swi:line:headerstart'} + 1 ),
                RootName => 'swi:location'
              );
            print $fh "        "
              . XMLout( $functions->{$function}->{'swi:modifier'},
                RootName => 'swi:modifier' );
            print $fh "        <swi:pointer"
              . " swi:headerstart=\""
              . ( $functions->{$function}->{'swi:line:headerstart'} + 1 ) . "\""
              . " swi:commentstart=\""
              . ( $functions->{$function}->{'swi:line:commentstart'} + 1 )
              . "\""
              . " swi:blockstart=\""
              . ( $functions->{$function}->{'swi:line:blockstart'} + 1 ) . "\""
              . " swi:blockend=\""
              . ( $functions->{$function}->{'swi:line:blockend'} + 1 ) . "\""
              . " />\n";

            my $statStr = XMLout(
                $functions->{$function}->{'swi:statistic'},
                RootName  => 'swi:statistic',
                GroupTags => {
                    'swi:complexity'  => '__REMOVE__',
                    'swi:duplication' => '__REMOVE__',
                    'swi:length'      => '__REMOVE__',
                    'swi:lines'       => '__REMOVE__',
                    'swi:checksum'    => '__REMOVE__'
                }
            );
            $statStr =~ s/\n/\n        /g;
            $statStr =~ s/ name="__REMOVE__"//g;
            print $fh "        ";
            print $fh $statStr;
            print $fh "\n";
            my $refStr = XMLout( $functions->{$function}->{'swi:reference'},
                RootName => '' );
            $refStr =~ s/\n/\n      /g;
            $refStr =~ s/<anon /<swi:reference /g;
            print $fh "      ";
            print $fh $refStr;
            print $fh "      </swi:function>\n";
            print $fh "\n";
        }

        print $fh "      <swi:statistic>\n";
        print $fh "        <swi:count>\n";
        print $fh "          <swi:functions swi:exact=\""
          . $localFunctionsCount
          . "\" />\n";
        print $fh "        </swi:count>\n";
        print $fh "      </swi:statistic>\n";
        print $fh "\n";

        print $fh "    </swi:file>\n";
        print $fh "\n";
    }

    print $fh "    <swi:statistic>\n";
    print $fh "      <swi:count>\n";

# Warning: swi_merger requires to have counter of files before counters of functions
    print $fh "        <swi:files swi:exact=\"" . $filesCount . "\" />\n";
    print $fh "        <swi:functions swi:exact=\""
      . $functionsCount
      . "\" />\n";
    print $fh "      </swi:count>\n";
    print $fh "    </swi:statistic>\n";
    print $fh "\n";

    print $fh "  </swi:module>\n";
    print $fh "\n";
    print $fh "</swi:report>\n";

    $fh->close();
}

#
# Parser enter point
#
sub swiParse
{
    my $location          = shift();
    my $file              = shift();
    my $preprocessorRules = shift();
    my $scanerRules       = shift();
    my $dupfinderSettings = shift();
    my $gcovSettings      = shift();

    STATUS("Parsing file: '$location/$file'.");

    my $fh = new FileHandle( $location . "/" . $file, "r" )
      or die("Can not open input file '$location/$file'!");
    my @fileLines = <$fh>;

    # Get all types of strings
    my ( $globalBlock_Initial, $globalBlock_Code, $globalBlock_Comment ) =
      swiSourceCommentsDeattach(@fileLines);
    my $globalBlock_NoStr  = swiSourceCodeStringsRemove($globalBlock_Code);
    my $globalBlock_NoPrep = swiSourceCodePreprocessorRemove($globalBlock_Code);
    my $globalBlock_Purified = swiSourceCodeStringsRemove($globalBlock_NoPrep);

    # Preprocess purified code
    foreach my $rule ( @{$preprocessorRules} )
    {
        my $pattern = $rule->{'swi:filepattern'};
        if ( $file =~ m/$pattern/ )
        {
            $globalBlock_Purified = swiSourceCodePreprocess(
                $globalBlock_Purified,
                $rule->{'swi:searchpattern'},
                $rule->{'swi:replacepattern'}
            );
        }
    }

    # Parse source code
    my $functionsData =
      swiSourceCodeParse( $file, $globalBlock_Purified, $globalBlock_Comment );

    # Adjusting scaner rules (for performance purposes)
    my $scanerRulesFiltered = [];
    foreach my $rule ( @{$scanerRules} )
    {
        my $pattern = $rule->{'swi:filepattern'};
        if ( $file =~ m/$pattern/ )
        {
            push( @{$scanerRulesFiltered}, $rule );
        }
    }

    # Add statistics
    $functionsData = swiSourceIndexAdd(
        $file,                $functionsData,       $scanerRulesFiltered,
        $dupfinderSettings,   $globalBlock_Initial, $globalBlock_Code,
        $globalBlock_Comment, $globalBlock_NoPrep,  $globalBlock_NoStr,
        $globalBlock_Purified
    );

    if ( $gcovSettings->{'swi:enabled'} eq 'on' )
    {
        my $filePattern = $gcovSettings->{'swi:filepattern'};
        if ( $file =~ m/$filePattern/ )
        {
            swiSourceIndexGcovAdd(
                $location, $file, $functionsData,
                $gcovSettings->{'swi:sourcefile'},
                $gcovSettings->{'swi:gcdafile'}
            );
        }
    }

    return $functionsData;
}

sub swiSourceCodePreprocess
{
    my $code     = shift();
    my $search   = shift();
    my $replace  = shift();
    my $lastPart = $code;
    my $result   = "";

    my $posPrev    = 0;
    my $posCurrent = 0;

    while ( $code =~ m/$search/g )
    {

        $posPrev    = $posCurrent;
        $posCurrent = pos($code);

        my $matchStr = $&;
        $lastPart = $';

        my $replaceString = eval( 'my $tmp = "' . $replace . '";' );

        if ( swiMatchPatternCount( $matchStr, '\n' ) !=
            swiMatchPatternCount( $replaceString, '\n' ) )
        {
            die(
"Wrong preprocessor rule detected in the configuration file: it changes number of lines replacing the text\n>>>\n"
                  . $matchStr
                  . "\n<<<\nby\n>>>\n"
                  . $replaceString
                  . "\n<<<\n" );
        }

        my $blockFrag =
          substr( $code, $posPrev, $posCurrent - $posPrev - length($matchStr) );
        $result .= ( $blockFrag . $replaceString );
    }

    $result .= $lastPart;

    return $result;
}

sub swiSourceCodeScan
{
    my $file    = shift();
    my $offset  = shift();
    my $code    = shift();
    my $search  = shift();
    my $message = shift();
    my @result  = [];

    while ( $code =~ m/$search/g )
    {

        my $matchPre = $`;
        my $matchStr = $&;

        my $linePos = swiMatchPatternCount( $matchPre . $matchStr, '\n' ) + 1;
        my $messageString = eval( 'my $tmp = "' . $message . '";' );

        push(
            @result,
            {
                'swi:ref:type'     => 'scan',
                'swi:scan:file'    => $file,
                'swi:scan:line'    => $linePos + $offset,
                'swi:scan:message' => $messageString
            }
        );
    }

    return @result;
}

sub swiSourceCodeGlobalGet
{
    my $functionsData = shift();
    my $endLine       = shift();
    my @blockCodeAgr  = @_;
    my @blockCode;

    if ( $#blockCodeAgr == 0 )
    {

        # Continues code string provided
        @blockCode = split( "\n", $blockCodeAgr[0] );
    }
    else
    {

        # Array of lines provided
        @blockCode = @blockCodeAgr;
    }

    if ( !defined($endLine) )
    {
        $endLine = $#blockCode + 100;    # Just with overhead
    }

    foreach my $function ( values %{$functionsData} )
    {
        for (
            my $i = $function->{'swi:line:commentstart'} ;
            $i <= $function->{'swi:line:blockend'} ;
            $i++
          )
        {

            # Clear line if it is inside function
            $blockCode[$i] = "";
        }
    }

    my $result = "";
    foreach (@blockCode)
    {
        $endLine--;
        if ( $endLine < 0 )
        {
            last;
        }
        $result .= $_ . "\n";
    }

    return $result;
}

sub swiDupindexFunctionAdd
{
    my $fileName     = shift();
    my $functionName = shift();
    my $functionCode = shift();

    print $dupindexIn "init_file\n";
    print $dupindexIn length($fileName) . "\n";
    print $dupindexIn length($functionName) . "\n";
    print $dupindexIn length($functionCode) . "\n";
    print $dupindexIn $fileName . $functionName . $functionCode . "\n";
}

sub swiSourceIndexAdd
{
    my $file              = shift();
    my $functionsData     = shift();
    my $scanerRules       = shift();
    my $dupfinderSettings = shift();
    my @block_Initial     = split( "\n", shift() );
    my @block_Code        = split( "\n", shift() );
    my @block_Comment     = split( "\n", shift() );
    my @block_NoPrep      = split( "\n", shift() );
    my @block_NoStr       = split( "\n", shift() );
    my $block_Purified    = shift();

    # Extend arrays in order to remove warnings
    my $finalLinesNum = swiMatchPatternCount( $block_Purified, '\n' ) + 1;
    @block_Initial = swiUtilArrayExtend( [@block_Initial], $finalLinesNum, "" );
    @block_Code    = swiUtilArrayExtend( [@block_Code],    $finalLinesNum, "" );
    @block_Comment = swiUtilArrayExtend( [@block_Comment], $finalLinesNum, "" );
    @block_NoPrep  = swiUtilArrayExtend( [@block_NoPrep],  $finalLinesNum, "" );
    @block_NoStr   = swiUtilArrayExtend( [@block_NoStr],   $finalLinesNum, "" );

    foreach my $functionName ( keys %{$functionsData} )
    {
        my $function = $functionsData->{$functionName};

        my $block       = {};
        my $blockOffset = {};

        # Initialize function name
        $block->{'functionname'} = $functionName;
        $block->{'functionname'} =~
s/($regexpCodeContainerDelimeter)?($regexpCodeContainerIdentifier$regexpCodeContainerDelimeter)*($regexpCodeFunctionIdentifier)/$3/;
        $blockOffset->{'functionname'} = $function->{'swi:line:headerstart'};

        if ( $functionName ne $regexpCodeGlobalFunctionName )
        {

            # Get content
            $block->{'initial'}       = "";
            $blockOffset->{'initial'} = $function->{'swi:line:commentstart'};
            for (
                my $i = $function->{'swi:line:commentstart'} ;
                $i <= $function->{'swi:line:blockend'} ;
                $i++
              )
            {
                $block->{'initial'} .= $block_Initial[$i] . "\n";
            }
            $block->{'code'}       = "";
            $blockOffset->{'code'} = $function->{'swi:line:commentstart'};
            for (
                my $i = $function->{'swi:line:commentstart'} ;
                $i <= $function->{'swi:line:blockend'} ;
                $i++
              )
            {
                $block->{'code'} .= $block_Code[$i] . "\n";
            }
            $block->{'comments'}       = "";
            $blockOffset->{'comments'} = $function->{'swi:line:commentstart'};
            for (
                my $i = $function->{'swi:line:commentstart'} ;
                $i <= $function->{'swi:line:blockend'} ;
                $i++
              )
            {
                $block->{'comments'} .= $block_Comment[$i] . "\n";
            }
            $block->{'nopreprocessor'}       = "";
            $blockOffset->{'nopreprocessor'} =
              $function->{'swi:line:commentstart'};
            for (
                my $i = $function->{'swi:line:commentstart'} ;
                $i <= $function->{'swi:line:blockend'} ;
                $i++
              )
            {
                $block->{'nopreprocessor'} .= $block_NoPrep[$i] . "\n";
            }
            $block->{'nostrings'}       = "";
            $blockOffset->{'nostrings'} = $function->{'swi:line:commentstart'};
            for (
                my $i = $function->{'swi:line:commentstart'} ;
                $i <= $function->{'swi:line:blockend'} ;
                $i++
              )
            {
                $block->{'nostrings'} .= $block_NoStr[$i] . "\n";
            }
            $block->{'purified'} = substr(
                $block_Purified,
                $function->{'swi:pos:headerstart'},
                $function->{'swi:pos:blockend'} -
                  $function->{'swi:pos:headerstart'}
              )
              . "\n";
            $blockOffset->{'purified'} = $function->{'swi:line:headerstart'};
            $block->{'commentshead'}   = "";
            $blockOffset->{'commentshead'} =
              $function->{'swi:line:commentstart'};
            for (
                my $i = $function->{'swi:line:commentstart'} ;
                $i < $function->{'swi:line:headerstart'} ;
                $i++
              )
            {
                $block->{'commentshead'} .= $block_Comment[$i] . "\n";
            }

            $block->{'functionhead'} = substr(
                $block_Purified,
                $function->{'swi:pos:headerstart'},
                $function->{'swi:pos:blockstart'} -
                  $function->{'swi:pos:headerstart'}
              )
              . "\n";
            $blockOffset->{'functionhead'} =
              $function->{'swi:line:headerstart'};
            $block->{'functionbody'} = substr(
                $block_Purified,
                $function->{'swi:pos:blockstart'},
                $function->{'swi:pos:blockend'} -
                  $function->{'swi:pos:blockstart'}
              )
              . "\n";
            $blockOffset->{'functionbody'} = $function->{'swi:line:blockstart'};
        }
        else
        {
            $block->{'initial'} =
              swiSourceCodeGlobalGet( $functionsData, undef, @block_Initial );
            $blockOffset->{'initial'} = 0;
            $block->{'code'}          =
              swiSourceCodeGlobalGet( $functionsData, undef, @block_Code );
            $blockOffset->{'code'} = 0;
            $block->{'comments'}   =
              swiSourceCodeGlobalGet( $functionsData, undef, @block_Comment );
            $blockOffset->{'comments'} = 0;
            $block->{'nopreprocessor'} =
              swiSourceCodeGlobalGet( $functionsData, undef, @block_NoPrep );
            $blockOffset->{'nopreprocessor'} = 0;
            $block->{'nostrings'}            =
              swiSourceCodeGlobalGet( $functionsData, undef, @block_NoStr );
            $blockOffset->{'nostrings'} = 0;
            $block->{'purified'}        =
              swiSourceCodeGlobalGet( $functionsData, undef, $block_Purified );
            $blockOffset->{'purified'} = 0;
            $block->{'commentshead'}   =
              swiSourceCodeGlobalGet( $functionsData,
                $function->{'swi:line:headerstart'},
                @block_Comment );
            $blockOffset->{'commentshead'} = 0;
            $block->{'functionhead'}       = "";    # N/A
            $blockOffset->{'functionhead'} = 0;
            $block->{'functionbody'}       = "";    # N/A
            $blockOffset->{'functionbody'} = 0;
        }

        # Initialize container
        $function->{'swi:statistic'} = {
            'swi:length' => {
                'swi:source'        => {},
                'swi:executable'    => {},
                'swi:comment'       => {},
                'swi:blank'         => {},
                'swi:function:name' => {}
            },
            'swi:lines' => {
                'swi:source'         => {},
                'swi:executable'     => {},
                'swi:comment'        => {},
                'swi:blank'          => {},
                'swi:comment:header' => {}
            },
            'swi:complexity' => {
                'swi:cyclomatic' => {},
                'swi:blocks'     => {},
                'swi:maxdepth'   => {}
            },
            'swi:duplication' => { 'swi:symbols' => { 'swi:exact' => 0 }, },
            'swi:checksum'    => { 'swi:source'  => { 'swi:exact' => 0 }, }
        };

        $function->{'swi:reference'} = [];

        # Calculate swi:length->swi:source
        # Note: this statistic is used to detect differences
        # Global code is compared without new lines
        my $initialContent = $block->{'initial'};
        if ( $functionName eq $regexpCodeGlobalFunctionName )
        {
            $initialContent =~ s/\n+//g;
        }
        $function->{'swi:statistic'}->{'swi:length'}->{'swi:source'}
          ->{'swi:exact'} = length($initialContent);

        # Calculate swi:length->swi:executable
        $function->{'swi:statistic'}->{'swi:length'}->{'swi:executable'}
          ->{'swi:exact'} = length( $block->{'purified'} );

        # Calculate swi:length->swi:comment
        $function->{'swi:statistic'}->{'swi:length'}->{'swi:comment'}
          ->{'swi:exact'} = length( $block->{'comments'} );

        # Calculate swi:length->swi:blank
        $function->{'swi:statistic'}->{'swi:length'}->{'swi:blank'}
          ->{'swi:exact'} = swiMatchPatternCount( $block->{'initial'}, '\s' );

        # Calculate swi:length->swi:function-name
        $function->{'swi:statistic'}->{'swi:length'}->{'swi:function:name'}
          ->{'swi:exact'} = length( $block->{'functionname'} );

        # Calculate swi:lines->swi:source
        $function->{'swi:statistic'}->{'swi:lines'}->{'swi:source'}
          ->{'swi:exact'} = swiMatchPatternCount( $block->{'initial'}, '\n' );

        # Calculate swi:lines->swi:executable
        $function->{'swi:statistic'}->{'swi:lines'}->{'swi:executable'}
          ->{'swi:exact'} =
          swiMatchLinesCount( $block->{'purified'}, '[^ \t]' );

        # Calculate swi:lines->swi:comment
        $function->{'swi:statistic'}->{'swi:lines'}->{'swi:comment'}
          ->{'swi:exact'} =
          swiMatchLinesCount( $block->{'comments'}, '[^ \t]' );

        # Calculate swi:lines->swi:blank
        $function->{'swi:statistic'}->{'swi:lines'}->{'swi:blank'}
          ->{'swi:exact'} = swiMatchLinesCount( $block->{'initial'}, '^\s*$' );

        # Calculate swi:lines->swi:comment:header
        $function->{'swi:statistic'}->{'swi:lines'}->{'swi:comment:header'}
          ->{'swi:exact'} =
          $function->{'swi:line:headerstart'} -
          $function->{'swi:line:commentstart'};

        # Calculate swi:complexity->swi:cyclomatic
        $function->{'swi:statistic'}->{'swi:complexity'}->{'swi:cyclomatic'}
          ->{'swi:exact'} =
          swiMatchPatternCount(
            swiSourceCodeStringsRemove( $block->{'purified'} ),
            $regexpCodeMatch_ComplexityCyclomatic );

        # Calculate swi:complexity->swi:blocks
        # -1 in order not to count main function's block
        $function->{'swi:statistic'}->{'swi:complexity'}->{'swi:blocks'}
          ->{'swi:exact'} =
          swiMatchPatternCount( $block->{'purified'}, $regexpCodeBlockStart ) -
          1;

        # Calculate swi:complexity->swi:maxdepth
        $function->{'swi:statistic'}->{'swi:complexity'}->{'swi:maxdepth'}
          ->{'swi:exact'} = $function->{'swi:depth'};

        # Calculate swi:checksum->swi:index
        # Note: this statistic is used to detect differences
        # Global code is compared without new lines
        my @symbols = split( //, $initialContent );
        my $crcSumTotal = 0;
        for ( my $pos = 0 ; $pos <= $#symbols ; $pos++ )
        {
            $crcSumTotal =
              ( $crcSumTotal << 8 )
              ^ $crctab[ ( $crcSumTotal >> 24 ) ^ ( unpack 'C', $symbols[$pos] )
              ];
        }
        $function->{'swi:statistic'}->{'swi:checksum'}->{'swi:source'}
          ->{'swi:exact'} = $crcSumTotal;

        # Scan function by scaner tool
        foreach my $rule ( @{$scanerRules} )
        {
            if ( defined( $block->{ $rule->{'swi:codecontent'} } ) )
            {
                push(
                    @{ $function->{'swi:reference'} },
                    swiSourceCodeScan(
                        $file,
                        $blockOffset->{ $rule->{'swi:codecontent'} },
                        $block->{ $rule->{'swi:codecontent'} },
                        $rule->{'swi:searchpattern'},
                        $rule->{'swi:messagepattern'}
                    )
                );
            }
            else
            {
                STATUS(
"Wrong configuiration: 'swi:scaner/swi:rule/swi:codecontent' property is not from the acceptable set of values!"
                );
                $exitCode++;
            }

        }

        # Add to dupindexer for further processing
        if ( defined( $block->{ $dupfinderSettings->{'swi:codecontent'} } ) )
        {
            if (
                $functionName ne $regexpCodeGlobalFunctionName
                || ( defined( $dupfinderSettings->{'swi:globalcode'} )
                    && $dupfinderSettings->{'swi:globalcode'} eq 'on' )
              )
            {
                swiDupindexFunctionAdd( $file, $functionName,
                    $block->{ $dupfinderSettings->{'swi:codecontent'} } );
            }
        }
        else
        {
            STATUS(
"Wrong configuiration: 'swi:indexer:dup/swi:codecontent' property is not from the acceptable set of values!"
            );
            $exitCode++;
        }
    }

    return $functionsData;
}

#
# This function uses external tool for duplication collection
#
sub swiSourceIndexDuplicationAdd
{
    my $filesData = shift();

    STATUS("Searching for duplication...");
    print $dupindexIn "start\n";

    my $outStream = "";
    while ( defined($dupindexOut) && ( my $line = <$dupindexOut> ) )
    {
        $outStream .= $line;
    }

    my @dupdataGoups = split( /info: group_start/, $outStream );

    foreach (@dupdataGoups)
    {
        my @parsedData;
        my @dupdataSplit = split( /\n/, $_ );
        foreach (@dupdataSplit)
        {
            if ( $_ =~
m/duplication: file: '(.*)' function: '(.*)' possition: '(.*)' size: '(.*)'/
              )
            {
                $filesData->{$1}->{$2}->{'swi:statistic'}->{'swi:duplication'}
                  ->{'swi:symbols'}->{'swi:exact'} += $4;

                push(
                    @parsedData,
                    {
                        'swi:ref:type'     => 'dup',
                        'swi:dup:file'     => $1,
                        'swi:dup:function' => $2,
                        'swi:dup:line'     => $3 +
                          $filesData->{$1}->{$2}->{'swi:line:headerstart'},
                        'swi:dup:size' => $4
                    }
                );
            }
        }

        foreach my $dupData (@parsedData)
        {
            push(
                @{
                    $filesData->{ $dupData->{'swi:dup:file'} }
                      ->{ $dupData->{'swi:dup:function'} }->{'swi:reference'}
                  },
                @parsedData
            );
        }
    }

    my $errStream = "";
    while ( defined($dupindexErr) && ( my $line = <$dupindexErr> ) )
    {
        STATUS("Internal dupindex tool detected the error.");
        STATUS($line);
        STATUS("    1. Check 'swi:indexer:dup' section in configuration.");
        STATUS(
"    2. Check that swi/dupindex tool is runable on your system/platform."
        );
        STATUS("    3. Recompile swi/dupindex tool for your system/platform.");
        STATUS("    4. Report the problem to developers.");

# The final return code is unsuccessful
# It means that these errors/warnings should be fixed before the next processing
        $exitCode++;
    }

    return $filesData;
}

sub swiSourceIndexGcovAdd
{
    my $location      = shift();
    my $file          = shift();
    my $functionsData = shift();
    my $filePattern   = shift();
    my @listTmp       = $file =~ m/$filePattern/;
    my $gcdaFile      = eval( 'my $tmp = "' . shift() . '";' );

    # Add coverage statistic
    my $fh = new FileHandle( $location . "/" . $gcdaFile, "r" );
    if ( !defined($fh) )
    {
        STATUS("gcda file '$location/$gcdaFile' is not found  for the '$file' source.");
    }
    else
    {
        my $gcovCommand = 'gcov -f -b $location/$gcdaFile';
        
        my $gcovData = `$gcovCommand`;
        $gcovData =~ s/No executable lines/Lines executed:100.OO% of O/g; 
        $gcovData =~ s/No calls/Calls executed:100.00% of O/g; 
        $gcovData =~ s/No branches/Branches executed:100.O0% of O\nTaken at least once:100.O0% of O/g; 
        my @covData  = split( "\n\n", $gcovData );

        foreach (@covData)
        {
            next if ( $_ =~ m/^File/ );
            my (
                $functionName,  $linesExec, $linesTotal, $branchesExec,
                $branchesTotal, $takenOnce, $callsExec,  $callsTotal
              )
              = ( $_ =~
m/^Function\s+\'(.*)\'\s+Lines\s+executed:(.*)%\s+of\s+(.*)\s+Branches\s+executed:(.*)%\s+of\s+(.*)\s+Taken\s+at\s+least\s+once:(.*)%\s+of\s+.*\s+Calls\s+executed:(.*)%\s+of\s+(.*)/
              );

            if ( defined( $functionsData->{$functionName} ) )
            {
                $functionsData->{$functionName}->{'swi:statistic'}
                  ->{'swi:coverage'} = {
                    'swi:gsum:lines'    => { 'swi:exact' => $linesTotal },
                    'swi:gsum:branches' => { 'swi:exact' => $branchesTotal },
                    'swi:gsum:calls'    => { 'swi:exact' => $callsTotal },
                    'swi:gcov:lines'    => {
                        'swi:exact' =>
                          swiUtil_Round( $linesExec * $linesTotal / 100 )
                    },
                    'swi:gcov:branches' => {
                        'swi:exact' =>
                          swiUtil_Round( $branchesExec * $branchesTotal / 100 )
                    },
                    'swi:gcov:takenonce' => {
                        'swi:exact' =>
                          swiUtil_Round( $takenOnce * $branchesTotal / 100 )
                    },
                    'swi:gcov:calls' => {
                        'swi:exact' =>
                          swiUtil_Round( $callsExec * $callsTotal / 100 )
                    }
                  };
            }
            else
            {
                STATUS(
"gcov reports the data for '$functionName' function but SWI parser did not detect it"
                );
                $exitCode++;
            }
        }
    }
}

sub swiSourceCodeParse
{
    my $file         = shift();
    my $blockCode    = shift();
    my @blockComment = split( "\n", shift() );

    @blockComment =
      swiUtilArrayExtend( [@blockComment],
        swiMatchPatternCount( $blockCode, '\n' ) + 1, "" );

    my $result    = {};
    my $deepLevel = 0;

    if ( swiMatchPatternCount( $blockCode, $regexpCodeBlockStart ) !=
        swiMatchPatternCount( $blockCode, $regexpCodeBlockEnd ) )
    {
        PRINT( $file, 0, "error",
            "Mismatch in number of start/end of blocks delimeters!\n" );
        DEBUG("The code before parsing:\n$blockCode");
        return $result;
    }

    my $posPrev      = 0;
    my $posCurrent   = 0;
    my $isInFunction = 0;
    my $currentFunc  = undef;
    my $currentLine  = 0;
    my $currentPos   = 0;
    my $currentDepth = 0;
    my @containers;

    while ( $blockCode =~ m/($regexpCodeBlockStart)|($regexpCodeBlockEnd)/g )
    {
        $posPrev    = $posCurrent;
        $posCurrent = pos($blockCode);

        my $matchPre  = $`;
        my $matchStr  = $&;
        my $matchPost = $';

        my $blockFragFull =
          substr( $blockCode, $posPrev, $posCurrent - $posPrev );
        $currentLine += swiMatchPatternCount( $blockFragFull, "\n" );
        $currentPos  += length($blockFragFull);

        if ( $matchStr =~ m/^$regexpCodeBlockStart$/ )
        {
            my $blockFragLast = $blockFragFull;
            $blockFragLast =~ s/^($regexpCodeStatements)*\s*//;

            # opened block detected
            $deepLevel++;

            if ( $isInFunction == 0 )
            {

                # Check whether it is a function start
                if ( $blockFragLast =~
m/^($regexpCodeFunctionModifier)*($regexpCodeFunctionIdentifier)($regexpCodeFunctionArguments)($regexpCodeBlockStart)$/
                  )
                {
                    my $matchedHeader = $&;
                    my $mod           = $1;
                    my $word          = $2;

                    if ( !defined($mod) )
                    {
                        $mod = "";
                    }

                    # Remove empty symbols in header
                    $matchedHeader =~ s/^\s*//;

                    # Check if modifier consumes something from identifier
                    # and return back the last part from modifier to identifier
                    ( $mod . $word ) =~ m/$regexpCodeFunctionIdentifier$/;
                    $mod  = $`;
                    $word = $&;

                    # Remove empty symbols in identifier
                    $word =~ s/\s+$//;
                    $word =~ s/[\n\t ]+/ /g;
                    $word =~
s/\s*$regexpCodeContainerDelimeter\s*/$regexpCodeContainerDelimeter/;

                    # Remove empty symbols in modifier
                    $mod =~ s/^\s*//;
                    $mod =~ s/\s*$//;
                    $mod =~ s/[\n\t ]+/ /g;

                    if ( $word !~ m/^($regexpCodeKeyword)$/ )
                    {
                        $isInFunction = $deepLevel;

                        # Attach containers to the name of function
                        foreach my $container ( reverse @containers )
                        {
                            if ( defined($container) )
                            {
                                $word = $container
                                  . $regexpCodeContainerDelimeter
                                  . $word;
                            }
                        }

                        # Add the code before the block start
                        # (name of function, arguments, ..)
                        my $matchedHeaderLinesNum =
                          swiMatchPatternCount( $matchedHeader, "\n" );

                        # Check if there are comments before the header
                        my $consumedTopLines = 1;
                        while (
                            $currentLine - $matchedHeaderLinesNum -
                            $consumedTopLines >= 0
                            && $blockComment[
                            $currentLine - $matchedHeaderLinesNum -
                            $consumedTopLines
                            ] !~ m/^\s*$/
                          )
                        {
                            $consumedTopLines++;
                        }

                        if ( defined( $result->{$word} ) )
                        {
                            PRINT( $file, $currentLine + 1, 'debug',
"The same function detected more than once: '$word'"
                            );
                            my $counter = 2;
                            while (
                                defined(
                                    $result->{ $word . " (" . $counter . ")" }
                                )
                              )
                            {
                                $counter++;
                            }
                            $word .= " (" . $counter . ")";
                        }

                        # Store data in result
                        $currentFunc = $word;
                        $result->{$word} = {
                            'swi:pos:blockstart'  => $currentPos,
                            'swi:pos:headerstart' => $currentPos -
                              length($matchedHeader),
                            'swi:pos:blockend'     => undef,
                            'swi:line:blockstart'  => $currentLine,
                            'swi:line:headerstart' => $currentLine -
                              $matchedHeaderLinesNum,
                            'swi:line:commentstart' => $currentLine -
                              $matchedHeaderLinesNum -
                              ( $consumedTopLines - 1 ),
                            'swi:line:blockend' => undef,
                            'swi:modifier'      => $mod,
                            'swi:indent'        => $deepLevel
                        };

                        PRINT( $file, $currentLine + 1, 'debug',
                            "Function detected: '$word', with modifier: '$mod'"
                        );
                    }
                }

                # Check whether it is a container start
                elsif ( $blockFragLast =~
m/^($regexpCodeContainerModifier)\s+($regexpCodeContainerIdentifier)($regexpCodeContainerArguments)($regexpCodeBlockStart)$/
                  )
                {
                    my $mod  = $1;
                    my $word = $2;
                    $mod =~ s/^\s*//;
                    $mod =~ s/\s*$//;
                    $mod =~ s/[\n\t ]+/ /g;
                    if ( $word !~ m/^$regexpCodeKeyword$/ )
                    {
                        PRINT( $file, $currentLine + 1, 'debug',
                            "Container detected: '$word', with modifier: '$mod'"
                        );
                        $containers[ $deepLevel - 1 ] = $word;
                    }
                }

                # Check if block start should be ignored
                elsif ( $blockFragLast =~
                    m/($regexpCodeBlockStartIgnore)($regexpCodeBlockStart)$/ )
                {
                    PRINT( $file, $currentLine + 1,
                        'debug', "Block start delimeter ignored/missed: '$&'" );
                }
                elsif ( $blockFragLast =~ m/^\s*($regexpCodeBlockStart)$/ )
                {
                    PRINT( $file, $currentLine + 1, 'debug',
                        "Empty code before block start delimeter detected: '$&'"
                    );
                }
                else
                {
                    $blockFragLast =~ s/^\s*//;
                    PRINT( $file, $currentLine + 1,
                        'error',
                        "Unknown type of started block: '$blockFragLast'" );
                    $exitCode++;
                }
            }
            else
            {

                # Calculate maximum indent level
                if ( $currentDepth < $deepLevel - $isInFunction )
                {
                    $currentDepth = $deepLevel - $isInFunction;
                }
            }
        }
        else
        {

            # block closer detected
            if ( $deepLevel == $isInFunction )
            {
                $isInFunction                                  = 0;
                $result->{$currentFunc}->{'swi:pos:blockend'}  = $currentPos;
                $result->{$currentFunc}->{'swi:line:blockend'} = $currentLine;
                $result->{$currentFunc}->{'swi:depth'}         = $currentDepth;
                $currentDepth                                  = 0;
                $currentFunc                                   = undef;
            }
            $containers[ $deepLevel - 1 ] = undef;
            $deepLevel--;
        }
    }

    # Initialize GLOBAL function
    $result->{$regexpCodeGlobalFunctionName} = {
        'swi:pos:blockstart'    => 0,    # not used
        'swi:pos:headerstart'   => 0,    # not used
        'swi:pos:blockend'      => 0,    # not used,
        'swi:line:blockstart'   => 0,    # not used
        'swi:line:headerstart'  => 0,    # used to deattach header with comments
        'swi:line:commentstart' => 0,    # not used
        'swi:line:blockend'     => 0,    # not used
        'swi:modifier'          => "",   # not used
        'swi:indent'            => 0,    # not used
        'swi:depth'             => 0     # not used
    };
    for ( my $i = 0 ; $i <= $#blockComment ; ++$i )
    {
        $result->{$regexpCodeGlobalFunctionName}->{'swi:line:headerstart'} = $i;
        if ( $blockComment[$i] =~ m/^\s*$/ )
        {

            # Empty line detected => header end matched
            last;
        }
    }

    return $result;
}

sub swiSourceCodeStringsRemove
{
    my $code   = shift();
    my $result = "";

    my $posPrev              = 0;
    my $posCurrent           = 0;
    my $isInString           = 0;
    my $lastPart             = $code;
    my $borderPatternDynamic = $regexpCodeStringBorder_Text;

    while ( $code =~ m/$borderPatternDynamic/g )
    {
        $posPrev    = $posCurrent;
        $posCurrent = pos($code);

        my $matchPre  = $`;
        my $matchStr  = $&;
        my $matchPost = $';
        $lastPart = "";

        my $blockFrag =
          substr( $code, $posPrev, $posCurrent - $posPrev - length($matchStr) );

        if ( $isInString == 0 )
        {
            $result .= $blockFrag . $matchStr;
            $isInString           = 1;
            $borderPatternDynamic = $matchStr;
        }
        else
        {
            if ( ( $blockFrag . $matchStr ) =~
                m/($regexpCodeStringBorder_Escape)($borderPatternDynamic)$/ )
            {

                # This string border should be ignored
                $blockFrag =~ s/[^\n]//g;
                $result .= $blockFrag;
            }
            else
            {

                # Save last part only if string end detected;
                $lastPart = $matchPost;

                # Keep newlines in the code inside strings
                $blockFrag =~ s/[^\n]//g;
                $result .= $blockFrag;
                $result .= $matchStr;
                $isInString           = 0;
                $borderPatternDynamic = $regexpCodeStringBorder_Text;
            }
        }
    }

    return $result . $lastPart;
}

sub swiSourceCodePreprocessorRemove
{
    my $code      = shift();
    my $result    = "";
    my @codeLines = swiUtilArrayExtend( [ split( "\n", $code ) ],
        swiMatchPatternCount( $code, '\n' ) - 1, "" );

    my $isInPreprocessor = 0;

    foreach my $line (@codeLines)
    {

        if (   $isInPreprocessor == 1
            || $line =~ m/$regexpCodePreprocessorStart/ )
        {
            $isInPreprocessor = 1;

            # Just add empty line
            $result .= "\n";

            if ( $line =~ m/$regexpCodePreprocessorEnd/ )
            {
                $isInPreprocessor = 0;
            }
        }
        else
        {
            $line =~ s/\n//g;
            $result .= $line . "\n";
        }
    }

    return $result;
}

sub swiSourceCommentsDeattach
{
    my @fileLines = @_;

    my $blockAll          = "";
    my $blockCode         = "";
    my $blockComment      = "";
    my $countLinesAll     = 0;
    my $countLinesCode    = 0;
    my $countLinesComment = 0;
    my $isInCode          = 1;

    foreach my $line (@fileLines)
    {
        if ( $isInCode == 1 )
        {
            if ( $line =~
                m/(($regexpCommentMultiStart)|($regexpCommentSingle))/ )
            {
                my $matchPre  = $`;
                my $matchStr  = $&;
                my $matchPost = $';

                my $marker = "#@%" . int( rand(0xFF) ) . "%@#";
                if ( swiSourceCodeStringsRemove( $matchPre . $marker ) !~
                    m/$marker/ )
                {

                    # This block ends inside the string
                    # i.e. comment start marker detected inside the string
                    # Process again the string with removed comment start marker
                    $line =~
                      s/(($regexpCommentMultiStart)|($regexpCommentSingle))//;
                    $fileLines[$countLinesAll] = $line;
                    redo;
                }
                elsif ( $matchStr =~ m/^$regexpCommentMultiStart$/ )
                {

                    # Get the code before the comment
                    $blockCode .= $matchPre;
                    $blockAll  .= $matchPre;

                    $isInCode = 0;
                    $blockComment .= $matchStr;
                    $blockAll     .= $matchStr;

                    # Process again the last fragment
                    $fileLines[$countLinesAll] = $matchPost;
                    $line = $matchPost;
                    redo;
                }
                else
                {

                    # Get the code before the comment
                    $blockCode .= $matchPre;
                    $blockAll  .= $matchPre;

                    # Single line comment detected
                    $matchPost =~ s/\n//g;
                    $blockComment .= $matchStr . $matchPost;
                    $blockAll     .= $matchStr . $matchPost;
                }
            }
            else
            {
                $line =~ s/\n//g;
                $blockCode .= $line;
                $blockAll  .= $line;
            }
        }
        else
        {

            # Check multi line comment end
            if ( $line =~ m/$regexpCommentMultiEnd/ )
            {
                my $matchPre  = $`;
                my $matchStr  = $&;
                my $matchPost = $';

                # Get the code before the comment
                $blockComment .= $matchPre . $matchStr;
                $blockAll     .= $matchPre . $matchStr;

                $isInCode = 1;

                # Process again the last fragment
                $fileLines[$countLinesAll] = $matchPost;
                $line = $matchPost;
                redo;
            }
            else
            {
                $line =~ s/\n//g;
                $blockComment .= $line;
                $blockAll     .= $line;
            }
        }

        $blockCode    .= "\n";
        $blockComment .= "\n";
        $blockAll     .= "\n";
        $countLinesAll++;
    }

    return ( $blockAll, $blockCode, $blockComment );
}

sub swiMatchPatternCount
{
    my $text    = shift();
    my $pattern = shift();
    my $count   = 0;

    while ( $text =~ m/$pattern/g )
    {
        $count++;
    }
    return $count;
}

sub swiMatchLinesCount
{
    my @text    = split( "\n", shift() );
    my $pattern = shift();
    my $count   = 0;

    foreach (@text)
    {
        if ( $_ =~ m/$pattern/ )
        {
            $count++;
        }
    }
    return $count;
}

sub swiUtilArrayExtend
{
    my $array       = shift();
    my $finalLength = shift();
    my $emptySymbol = shift();

    if ( $#{$array} > $finalLength )
    {
        DEBUG( "Length of array: " . $#{$array} );
        DEBUG( "Requested final length: " . $finalLength );
        DEBUG( Dumper($array) );
        die('Internal Error occured!');
    }

    while ( $finalLength - $#{$array} > 0 )
    {
        push( @{$array}, $emptySymbol );
    }

    return @{$array};
}

sub swiUtilDirectoryCleanUp
{
    my $dir = shift();
    die("Internal error!") if not defined $dir;
    die("Internal error!") if $dir eq "";
    die("Internal error!") if $dir eq ".";
    die("Internal error!") if $dir eq "./";

    if ( opendir( DIR, $dir ) )
    {
        while ( my $file = readdir(DIR) )
        {
            unlink $dir . "/" . $file;
        }
        closedir(DIR);
    }
}

sub swiUtil_Round
{
    my $float = shift();
    if ( ( $float - int($float) ) > 0.5 )
    {
        return int( $float + 1.0 );
    }
    else
    {
        return int($float);
    }
}

return 1;