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;