Subversion Repositories DevTools

########################################################################

# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.

#

# Module name   : ToolsetFiles.pm

# Module type   : JATS Utility

# Compiler(s)   : Perl

# Environment(s): jats

#

# Description   : Provide access to the file GbeFiles.cfg

#                 Provides methods to create, maintain and read the file

#                 

#                 ToolsetFiles::AddFile

#                 ToolsetFiles::AddDir

#                 ToolsetFiles::GetFiles

#                 ToolsetFiles::GetBuildDirs

#                 ToolsetFiles::GetSubTrees

#                 ToolsetFiles::GetDataFile

#                 

#           Internal Use Only

#                 readData

#                 writeData

#                 rebuildSubdirList

#                 rebuildParentDirList

#

#......................................................................#

require 5.008_002;

use strict;

use warnings;

#===============================================================================

package ToolsetFiles;

use JatsError;

use FileUtils;

use ConfigurationFile;

# automatically export what we need into namespace of caller.

use Exporter();

our (@ISA, @EXPORT, %EXPORT_TAGS, @EXPORT_OK);

@ISA         = qw(Exporter);

@EXPORT      = qw();

@EXPORT_OK   = qw();

%EXPORT_TAGS = (All => [@EXPORT, @EXPORT_OK]);

#

#   Global variables

#

our %GBE_TOOLSETFiles;          # Needs to be 'our'. Data store

my $dataDir;                    # Path to the interface directory

my $dataFile;                   # Path to GbeFiles.cfg 

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

# Function        : ToolsetFiles::AddFile

#

# Description     : Maintain a data structure of files that are created

#                   by the makefile creation process.

#

#                   Used to simplify the clobber process

#                   All files 'added' will be deleted as a part of a clobber

#

#                   Maintains an on-disk data structure

#

# Inputs          : fileList        - Files to add to the list

#

# Returns         : Nothing

#

sub AddFile

{

    my (@fileList) = @_;

    Verbose2 ("ToolsetFile:", @fileList);

    #

    #   Read in the existing data

    #

    readData();

    # Capture the package root directory

    $GBE_TOOLSETFiles{Root} = FullPath($::ScmRoot)

        unless defined $GBE_TOOLSETFiles{Root};

    #

    # Save to disk if

    #   Target directory exists - creation may be delayed

    #   We have added entries

    #

    if ( @fileList )

    {

        #

        #   Add files

        #       Need to be full paths

        #       Paths are store relative to the Root

        #

        foreach ( @fileList )

        {

            $GBE_TOOLSETFiles{Files}{RelPath(FullPath($_), $GBE_TOOLSETFiles{Root} )} = 1;

        }

        #   Save file

        writeData();

    }

}

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

# Function        : GetFiles 

#

# Description     : Return an array of files from the stored data structure

#

# Inputs          : $interface  - (Optional) Path to the interface directory

#                   $abs        - (Optional) True: Return Abs paths

#

# Returns         : An array of files

#

sub GetFiles

{

    my ($interface, $abs) = @_;

    readData($interface) || Error ("Internal: ToolsetFiles::GetFiles - GbeFiles not found");

    unless ($abs) {

        return keys %{$GBE_TOOLSETFiles{Files}};

    }

    my @newList;

    foreach my $dir (keys %{$GBE_TOOLSETFiles{Files}} ) {

        push @newList,CleanPath(catdir($GBE_TOOLSETFiles{Root}, $dir)); 

    }

    return @newList;

}

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

# Function        : GetBuildDirs

#

# Description     : Return an array the internal directories from the stored data structure

#

# Inputs          : $interface  - (Optional) Path to the interface directory

#

# Returns         : An array of files

#

sub GetBuildDirs

{

    my ($interface) = @_;

    readData($interface) || Error ("Internal: ToolsetFiles::GetBuildDirs - GbeFiles not found");

    my @newList;

    foreach my $dir (@{$GBE_TOOLSETFiles{Dirs}{Internal}} ) {

        push @newList,CleanPath(catdir($GBE_TOOLSETFiles{Root}, $dir)); 

    }

    return @newList;

}

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

# Function        : ToolsetFiles::AddDir

#

# Description     : Maintain a data structure of directories that are used

#                   by the makefile creation process.

#

#                   Used to track directories used by the build. These are used

#                   to calculate package signatures and fingerprints

#

#                   Maintains an on-disk data structure

#

# Inputs          : $dir        - Files to add to the list

#                   $mode       - 'Internal', Include SubDir

#                   

#                   $mode=Internal 

#                       directories are ignored

#                           

#                   $mode=Include and SubDir

#                       Are processed to remove subdirectories

#                       Needing a list of distinct directory trees that are a 

#                       part of the build. Used to calculate signatures.

#                            

#

# Returns         : Nothing

#

sub AddDir

{

    my ($dir, $mode) = @_;

    Verbose2 ("ToolsetDir:", $dir, $mode);

    #

    #   Only track directories that exist

    return unless -d $dir;

    #

    #   Read in the existing data

    #

    readData();

    #

    #   Need to know the current directory in order to calculate the

    #   FullPath and others

    #

    Error ("Internal: ToolsetFiles. Cwd not defined")

        unless ( defined $::Cwd );

    # Capture the package root directory

    $GBE_TOOLSETFiles{Root} = FullPath($::ScmRoot)

        unless defined $GBE_TOOLSETFiles{Root};

    #

    # Save to disk if

    #   Target directory exists - creation may be delayed

    #   We have added entries

    #

    my $dirList = ($mode =~ m/Internal/i) ? 'Internal' : 'Src';

    if ( $dir )

    {

        #

        #   Add files - Need to be full paths

        #

        my $relDir = RelPath(FullPath($dir), $GBE_TOOLSETFiles{Root} );

        #

        #   Ignore Src directories that are a subdirectory of the current root dir

        #

        if (($relDir =~ m~^\.\.(/|$)~) || ($dirList eq 'Internal'))

        {

            #

            #   Maintain @{$GBE_TOOLSETFiles{Dirs}} as a list of parent directories

            #       The Root directory is assumed

            #

            # Add the new item and rebuild the list

            @{$GBE_TOOLSETFiles{Dirs}{$dirList}} = rebuildParentDirList($relDir, @{$GBE_TOOLSETFiles{Dirs}{$dirList}});

            #   Save file

            writeData();

        }

    }

}

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

# Function        : ToolsetFiles::GetSubTrees 

#

# Description     : Return an ordered list of directory subtrees used by the build

#                   These will be absolute paths

#                   

#                   This contains a list of all directories used by the build/make 

#                   as discovered when creating files. 

#                       IFF all source was below the build.pl dir, then we wouldn't need

#                       to do this and life would be much simpler (and faster)

#                       

#                   Used by the 'sandbox':

#                       To create a fingerprint over all files in a package.

#                   Used by 'buildlib':

#                       To create a signature of the package

#

# Inputs          : $interface  - (Optional) Path to the interface directory

#

# Returns         : Ordered list of absolute paths of all subdirectory trees discovered

#                   during the build phase.

#                   

#                   Needs to be the same order on all machines

#

sub GetSubTrees

{

    my ($interface) = @_;

    my @dirList;

    #

    #   Read in GbeFiles.cfg

    #   It must exist

    #

    readData($interface) || Error ("Internal: ToolsetFiles::GetSubTrees - GbeFiles not found");

    #

    #   Generate a list of directories in the package

    #   This is the root directory and all other Src directories discovered

    #

    push @dirList, $GBE_TOOLSETFiles{Root};

    if (exists $GBE_TOOLSETFiles{Dirs}{Src})

    {

        foreach my $dir ( sort {uc($a) cmp uc($b) } @{$GBE_TOOLSETFiles{Dirs}{Src}})

        {

            push @dirList,CleanPath(catdir($GBE_TOOLSETFiles{Root}, $dir)); 

        }

    }

    # Process the complete list to remove subdirectories

    #   The paths are absolute

    @dirList = rebuildSubdirList(@dirList);

#DebugDumpData("GetSubTrees", \@dirList);

    return @dirList;

}

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

# Function        : rebuildSubdirList 

#

# Description     : Internal function - not intended to be used externally

#                   Only work when the @dirlist contains absolute paths

# 

#                   Rebuild the subdirectory list

#                   Remove items that are subdirectories of other items

#                   We only want the parents, not children

#

# Inputs          : @dirList        - List of items to process 

#

# Returns         : Rebuild list

#

sub rebuildSubdirList

{

    #   Process the complete list to remove subdirectories

    #   Process is:

    #       Sort list. Will end up with shortest directories first, thus subdirs will follow parents

    #       Insert each item into a new list iff it is not a subdir of something already in the list

    #

    my @newList;

    my @dirList = sort {uc($a) cmp uc($b)} @_;

    foreach my $newItem ( @dirList )

    {

        my $match = 0;

        foreach my $item ( @newList )

        {

            if (index ($newItem, $item) == 0)

            {

                $match = 1;

                last;

            }

        }

        if (! $match)

        {

            push @newList, $newItem;

        }

   }

   return @newList;

}

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

# Function        : rebuildParentDirList 

#

#

# Description     : Internal function - not intended to be used externally

#                   Only work when with relative paths

#                   

#                   Given: .., ../.., ../../AA Result: ../..

#                   Given  .., ../AA, ../BB    Result: .., ../AA, ../BB

#                   

#                   Must handle both parent and child directoires

# 

#                   Rebuild the subdirectory list

#                   Remove items that are subdirectories of other items

#                   We only want the parents, not children

#

# Inputs          : @dirList        - List of items to process 

#

# Returns         : Rebuild list

sub rebuildParentDirList

{

    my (@dirlist) = @_;

    #

    #   Convert to absolute

    #   Use rebuildSubdirList

    #   Convert back to relative

    #

    my @newList;

    foreach my $dir ( @dirlist ) {

        push @newList,CleanPath(catdir($GBE_TOOLSETFiles{Root}, $dir)); 

    }

    # Process the complete list to remove subdirectories

    #   The paths are now absolute

    @newList = rebuildSubdirList(@newList);

    #

    #   Convert back to Relative

    #

    my @relList;

    foreach my $dir ( @newList ) {

        push @relList, RelPath(FullPath($dir), $GBE_TOOLSETFiles{Root} );

    }

    return @relList;

}

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

# Function        : GetDataFile 

#

# Description     : Return the full path to the data file

#                   May be used to test existence

#

# Inputs          : $interface - Path to the interface directory (Optional) 

#

# Returns         : Path to file, or undefined

#

sub GetDataFile

{

    my ($interface) = @_;

    #

    #   Use the global path to the interface directory

    #   unless specifically provided by the user

    #

    if ($interface) {

        $dataDir = $interface;

    } else {

        Error ("Internal: ToolsetFiles. ScmRoot or ScmInterface not defined")

            unless ( defined $::ScmRoot && defined $::ScmInterface );

        $dataDir = "$::ScmRoot/$::ScmInterface";

    }

    $dataFile = "$dataDir/GbeFiles.cfg";

    return $dataFile if (-f $dataFile );

    return undef;

}

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

# Function        : readData 

#

# Description     : Read the data file into memory

#                   Data may not be present

#

# Inputs          : $interface - Path to the interface directory (Optional) 

#

# Returns         : True - file found and read 

#

sub readData

{

    my ($interface) = @_;

    #

    #   Use the global path to the interface directory

    #   unless specifically provided by the user

    #

    if ($interface) {

        $dataDir = $interface;

    } else {

        Error ("Internal: ToolsetFiles. ScmRoot or ScmInterface not defined")

            unless ( defined $::ScmRoot && defined $::ScmInterface );

        $dataDir = "$::ScmRoot/$::ScmInterface";

    }

    $dataFile = "$dataDir/GbeFiles.cfg";

    #

    #   Read the file on every usage

    #   Its used in a nested program call structure so the data may be stale

    #

    if ( -f  $dataFile )

    {

        do $dataFile;

        return 1 if %GBE_TOOLSETFiles;

    }

    return 0;

}

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

# Function        : writeData 

#

# Description     : Write the data out to the physical file

#                   Simply rewrite the file - if the target directory exists

#                   Its creation may be after we have started accumulating files

#  

#

# Inputs          : 

#

# Returns         : 

#

sub writeData

{

    if ( -d $dataDir  ) {

        my $fh = ConfigurationFile::New( $dataFile );

        $fh->Header( "ToolsetFile", "Toolset Files" );

        $fh->Dump( [\%GBE_TOOLSETFiles], [qw(*GBE_TOOLSETFiles)] );

        $fh->Close();

    }

}

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

1;