Subversion Repositories DevTools

my $opt_ignoreMakeProjectErrors;

    'ddu_app_manager'       => 'SetProjectBase,',

my $workDir;

        if ( index( $data, 'IgnoreMakeProject,' ) >= 0) {

            $opt_ignoreMakeProjectErrors = 1;

            Message ("Ignore MakeProject Usage");

        }

    #

    #   Some really ugly packages make use of a Jats feature called 'SetProjectBase'

    #   Detect such packages as we will need to handle them differently

    #   Can't really handle it on the fly

    #   All we can do is detect it and report it - at the moment

    #

    if (detectProjectBaseUsage($data, $cc_path) )

    {

        unless ( $opt_ignoreProjectBaseErrors )

        {

            $data->{BadProjectBase}++;

            $data->{errStr} = 'Bad usage of ProjectBase detected';

            return 4;           # Lets see what the others look like too

#            return 14;

        }

    }

    #

    #   Some really really ugly packgaes make use of the MakeProject directive

    #   and then use an 'include.txt file to access paths all over the VOB

    #   The problem is with lines like

    #           /I ..\..\..\..\..\..\DPG_SWCode\projects\seattle\ddu\component\DTIApp\dsi\inc

    #   Two problems:

    #       Vob Name is not a part of the migration

    #       If we 'SuckUp' empty directories then this may break

    #       the pathing.

    #   All we can do is detect it and report it - at the moment

    #

    if (detectMakeProjectUsage($data, $cc_path) )

    {

        unless ( $opt_ignoreMakeProjectErrors )

        {

            $data->{BadMakeProject}++;

            $data->{errStr} = 'Use of MakeProject detected';

            return 4;           # Lets see what the others look like too

#            return 14;

        }

    }

# Function        : detectMakeProjectUsage

#

# Description     : etect and report usage of the MakeProject directive

#

# Inputs          : $data               - Ref to a hash of bits

#                   $cc_path            - Packages cc_path

#

# Returns         : true    - Bad usage (Really good usage not detected)

#                   false   - Good usage detected

#

sub detectMakeProjectUsage

{

    my ($data, $cc_path) = @_;

    my $retval = 0;

    my $eSuf = $opt_ignoreMakeProjectErrors ? '' : 'Error';

    #

    #   Find makefile.pl

    #

    Message ("Locate JATS makefiles");

    my $usesMakeProject = 0;

    my $badIncludeFile = 0;

    my $search = JatsLocateFiles->new("--Recurse=1",

                                       "--FilterIn=makefile.pl",

                                       );

    my @makefiles = $search->search($data->{ViewRoot});

    foreach my $file ( @makefiles )

    {

#print "---Reading: $workDir/$data->{ViewRoot}/$file\n";

        if ( open( my $fh, '<', "$data->{ViewRoot}/$file" ) )

        {

            my $eof = 0;

            my $line = '';

            until ( $eof )

            {

                my $in = <$fh>;

                unless ( defined $in )

                {

                    $eof = 1;

                }

                else

                {

                $in =~ s~\s+$~~;

                $in =~ s~^\s+~~;

                $in =~ s~^#.*$~~;

                $in =~ s~\s*[^\$]#.*$~~;

                $line .= ' ' if ( $line );

                $line .= $in;

                $line =~ s~\s+~ ~g;

#print "====== '$line'\n";

                redo unless ( $line =~ m~;$~  );

                }

#print "---- $line\n";

                if ( $line =~ m~^MakeProject~ )

                {

                    $usesMakeProject++;

                    $data->{UsesMakeProject}++;

                    Warning ("Package uses MakeProject:",

                             "Line: " . $line,

                             "Root: " . "$data->{ViewRoot}",

                             "File: " . "$data->{ViewRoot}/$file",

                            );

                    #

                    #   Extract out the project name

                    #

                    my @myArgs;

                    my $myProjectDir;

                    my $myProject = "$data->{ViewRoot}/$file";

                    $myProject =~ s~/[^/]+$~~;

                    $line =~ s~MakeProject~push \@myArgs,~;

                    eval $line;

                    Error("Line did not compiler: $line", "Err: $@" ) if ($@);

                    shift @myArgs;

                    foreach ( @myArgs )

                    {

                        next if ( m~^--~ );

                        $myProject .= '/' . $_;

                        $myProjectDir = $myProject;

                        $myProjectDir =~ s~/[^/]+$~~;

                        last;

                    }

                    Error ("No project Found") unless ( defined $myProjectDir);

                    if ( -f "$myProjectDir/include.txt" )

                    {

                        Warning ("Co-located 'include.txt' file also found");

                    }

                    # The only problem is if the include.txt file

                    # escapes from the VOB - or even uses the vob root

                    #

                    # Examine the include file

                    # Expect it to look like

                    #   /I Path

                    #

                    #

                    #   Determine safe level

                    #   Relative to the include file

                    #

                    my $depthPath = $myProjectDir;

                    my $depth = 0;

                    Error ("Expect this to work") unless ( $depthPath =~ s~^$data->{ViewRoot}/~~ );

                    foreach ( split('/', $depthPath) )

                    {

                        if ( $_ eq '..' ) {

                            $depth--;

                        } else {

                            $depth++;

                        }

                    }

#print "Depth: $depth, $depthPath\n";

                    if ( open( my $if, '<', "$myProjectDir/include.txt" ) )

                    {

                        while ( <$if> )

                        {

                            s~\s+$~~;

                            s~^\s+~~;

                            next unless ( $_ );

                            if ( m~/I\s+(.*)~ )

                            {

                                my $path = $1;

                                $path =~ tr~\\/~/~s;

                                $path =~ s~\\~/~g;

#print "Examine: $path\n";

                                my $minLevel = 0;

                                my $level = 0;

                                foreach ( split('/', $path) )

                                {

                                    if ( $_ eq '..' )

                                    {

                                        $level--;

                                        $minLevel = $level if ($level < $minLevel);

                                    }

                                    else

                                    {

                                        $level++;

                                    }

                                }

#print "Min: $minLevel, $level, ($depth + $minLevel)\n";

                                if ( $depth + $minLevel <= 0)

                                {

                                    $badIncludeFile++;

                                    Warning ("Included path escapes package:",

                                             "Line: " . $_,

                                             "File: " . "$myProjectDir/include.txt",

                                            );

                                    last;

                                }

                            }

                        }

                        close $if;

                    }

                }

                $line = '';

            }

            close $fh;

        }

        else

        {

            Warning ("MakeProject$eSuf - Cannot open makefile: $file");

            $retval = 1;

        }

    }

    #

    #   Used

    #   May be improved latter

    #

    if ( $usesMakeProject && $badIncludeFile)

    {

        Warning ("MakeProject$eSuf - Problem detected");

        $retval = 1;

    }

    #

    #   Until we have more faith in the detection algorithm

    #

    if ( $usesMakeProject )

    {

        Warning ("MakeProject$eSuf - Makeproject used. Must check manually");

        $retval = 1;

    }

    return $retval;

}

#-------------------------------------------------------------------------------